Parent Directory
|
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-4-patches'.
1 #!/usr/bin/perl -w 2 ################################################################################ 3 # WeBWorK Online Homework Delivery System 4 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 5 # $CVSHeader: webwork2/bin/wwdb_addgw,v 1.3 2006/01/25 23:13:45 sh002i Exp $ 6 # 7 # This program is free software; you can redistribute it and/or modify it under 8 # the terms of either: (a) the GNU General Public License as published by the 9 # Free Software Foundation; either version 2, or (at your option) any later 10 # version, or (b) the "Artistic License" which comes with this package. 11 # 12 # This program is distributed in the hope that it will be useful, but WITHOUT 13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 14 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 15 # Artistic License for more details. 16 ################################################################################ 17 # 18 # wwdb_addgw 19 # update webwork database tables to add fields for the gateway module 20 # 21 # by Gavin LaRose <glarose@umich.edu> 22 # 23 =head1 NAME 24 25 wwdb_addgw - convert SQL databases for WeBWorK 2 to add gateway fields. 26 27 =head1 SYNOPSIS 28 29 wwdb_addgw [-h] [sql|sql_single] 30 31 =head1 DESCRIPTION 32 33 Adds fields to the set and set_user tables in the WeBWorK mysql databases 34 that are required for the gateway module. The script prompts for which 35 courses to modify. Adding gateway database fields to existing courses 36 should have no effect on those courses, even if they are running under a 37 non-gateway aware version of the WeBWorK system. 38 39 If C<-h> is provided, the script hides the mysql admin password. 40 41 C<sql> or C<sql_single> gives the default WeBWorK database format. If 42 omitted, the script assumes sql_single and prompts to be sure. 43 44 =cut 45 46 use strict; 47 use DBI; 48 49 # this is necessary on some systems 50 system("stty erase "); 51 52 my $source = 'DBI:mysql'; 53 54 # fields to add to the set and set_user tables 55 my %addFields = ( 'assignment_type' => 'text', 56 'attempts_per_version' => 'integer', 57 'time_interval' => 'integer', 58 'versions_per_interval' => 'integer', 59 'version_time_limit' => 'integer', 60 'version_creation_time' => 'bigint', 61 'problem_randorder' => 'integer', 62 'version_last_attempt_time' => 'bigint', ); 63 64 # process input data 65 my $hidepw = 0; 66 my $dbtype = 'sql_single'; 67 while ( $_ = shift(@ARGV) ) { 68 if ( /^-h$/ ) { 69 $hidepw = 1; 70 } elsif ( /^-/ ) { 71 die("Unknown input flag $_.\nUsage: wwdb_addgw [-h] sql|sql_single\n"); 72 } else { 73 if ( $_ eq 'sql' || $_ eq 'sql_single' ) { 74 $dbtype = $_; 75 } else { 76 die("Unknown argument $_.\nUsage: wwdb_addgw [-h] " . 77 "sql|sql_single\n"); 78 } 79 } 80 } 81 82 printHdr( $dbtype ); 83 84 # get database information 85 my ( $admin, $adminpw ); 86 ( $admin, $adminpw, $dbtype ) = getDBInfo( $hidepw, $dbtype ); 87 88 # connect to database, if we're in sql_single mode; this lets us easily 89 # get a list of courses to work with. in sql mode, it's harder b/c I can't 90 # get DBI->data_sources('mysql') to work on my system, so we prompt for 91 # those separately. if we're in sql single mode, $dbh is a place holder, 92 # because we have to do the database connects in the subroutines to connect 93 # to each different database 94 my $dbh = ''; 95 if ( $dbtype eq 'sql_single' ) { 96 $dbh = DBI->connect("$source:webwork", $admin, $adminpw) or 97 die( $DBI::errstr ); 98 } 99 100 # get courses list 101 my @courses = getCourses( $dbtype, $dbh ); 102 103 # now $course{coursename} = format (sql or sql_single) 104 105 # do update 106 my ( $doneRef, $skipRef ) = updateCourses( $dbtype, $dbh, \@courses, 107 $admin, $adminpw ); 108 $dbh->disconnect() if ( $dbh ); 109 110 # all done 111 confirmUpdate( $dbtype, $doneRef, $skipRef ); 112 113 # end of main 114 #------------------------------------------------------------------------------- 115 # subroutines 116 117 sub printHdr { 118 print <<eoh; 119 --------------------------------------------------------------------------- 120 wwdb_addgw: update WeBWorK SQL databases to include fields required for a 121 Gateway aware WeBWorK installation. 122 123 set default WeBWorK database type to $dbtype. 124 --------------------------------------------------------------------------- 125 eoh 126 return 1; 127 } 128 129 sub getDBInfo { 130 my $hide = shift(); 131 my $type = shift(); 132 133 print "mySQL administrator login name [root] > "; 134 my $admin = <STDIN>; 135 chomp( $admin ); 136 $admin = 'root' if ( ! $admin ); 137 138 print "mySQL login password for $admin > "; 139 system("stty -echo") if ( $hide ); 140 my $passwd = <STDIN>; 141 if ( $hide ) { system("stty echo"); print "\n"; } 142 chomp( $passwd ); 143 die("Error: no password provided\n") if ( ! $passwd ); 144 145 print "WeBWorK database type (sql or sql_single) [$type] > "; 146 my $dbtype = <STDIN>; 147 chomp( $dbtype ); 148 $dbtype = $type if ( ! $dbtype ); 149 150 return( $admin, $passwd, $dbtype ); 151 } 152 153 sub getCourses { 154 my ( $dbtype, $dbh ) = @_; 155 156 my %courses = (); 157 158 # get a course list 159 if ( $dbtype eq 'sql' ) { 160 print "courses to update (enter comma separated) > "; 161 my $crslist = <STDIN>; 162 chomp($crslist); 163 my @crslist = split(/,\s*/, $crslist); 164 die("Error: no courses specified\n") if ( ! @crslist ); 165 foreach ( @crslist ) { $courses{$_} = 1; } 166 167 } else { 168 my $cmd = 'show tables'; 169 my $st = $dbh->prepare( $cmd ) or die( $dbh->errstr() ); 170 $st->execute() or die( $st->errstr() ); 171 my $rowRef = $st->fetchall_arrayref(); 172 foreach my $r ( @$rowRef ) { 173 $_ = $r->[0]; 174 #my ($crs, $tbl) = ( /^([^_]+)_(.*)$/ ); # this fails on courses with underscores in their names 175 my ($crs) = (/^(.*)_key$/); # match the key table 176 $courses{$crs} = 1 if ( defined( $crs ) ); 177 } 178 die("Error: found now sql_single WeBWorK courses\n") if ( ! %courses ); 179 } 180 181 # confirm this is correct 182 print "\nList of courses to update:\n"; 183 my %nummap = orderedList( %courses ); 184 printclist( sort keys( %courses ) ); 185 print "Enter # to edit name, d# to delete from update list, or [cr] to " . 186 "continue.\n > "; 187 my $resp = <STDIN>; 188 chomp($resp); 189 while ( $resp ) { 190 if ( $resp =~ /^\d+$/ ) { 191 print " old course name $nummap{$resp}; new > "; 192 delete( $courses{$nummap{$resp}} ); 193 my $newname = <STDIN>; 194 chomp($newname); 195 $courses{ $newname } = 1; 196 } elsif ( $resp =~ /^d(\d+)$/ ) { 197 $resp = $1; 198 delete( $courses{$nummap{$resp}} ); 199 } else { 200 print "unrecognized response: $resp.\n"; 201 } 202 %nummap = orderedList( %courses ); 203 print "Current list of courses to update:\n"; 204 printclist( sort keys( %courses ) ); 205 print "Enter #, d# or [cr] > "; 206 chomp( $resp = <STDIN> ); 207 } 208 209 my @courses = sort( keys %courses ); 210 if ( @courses ) { 211 return @courses; 212 } else { 213 die("Error: no courses left to update.\n"); 214 } 215 } 216 217 sub orderedList { 218 my %hash = @_; 219 my $i=1; 220 my %nummap = (); 221 foreach ( sort( keys( %hash ) ) ) { 222 $nummap{ $i } = $_; 223 $i++; 224 } 225 return %nummap; 226 } 227 228 sub printclist { 229 my @list = @_; 230 231 # assumes a 75 column screen 232 233 my $i = 1; 234 if ( @list <= 3 ) { 235 foreach ( @list ) { print " $i. $_\n"; $i++ } 236 } else { 237 while ( @list >= $i ) { 238 printf(" %2d. %-19s", $i, $list[$i-1]); 239 printf(" %2d. %-19s", ($i+1), $list[$i]) if ( @list >= ($i+1) ); 240 printf(" %2d. %-19s", ($i+2), $list[$i+1]) if ( @list >= ($i+2) ); 241 print "\n"; 242 $i+=3; 243 } 244 } 245 return 1; 246 } 247 248 sub updateCourses { 249 my ( $dbtype, $dbh, $crsRef, $admin, $adminpw ) = @_; 250 251 my @done = (); 252 my @skipped = (); 253 254 # give some sense of progress 255 select STDOUT; $| = 1; # unbuffer output 256 print "doing update for $dbtype databases.\n"; 257 258 # list of added fields to check for classes that don't need updating 259 my @newFields = keys( %addFields ); 260 261 foreach my $crs ( @$crsRef ) { 262 print "updating $crs.\n"; 263 my $colRef; 264 265 if ( $dbtype eq 'sql' ) { 266 # we need to get a database handle first 267 $dbh = DBI->connect("$source:webwork_$crs", $admin, $adminpw) or 268 die( $DBI::errstr ); 269 270 # now get a list of columns from the set table to check to see if 271 # we need an update 272 my $cmd = "show columns from set_not_a_keyword"; 273 my $st = $dbh->prepare( $cmd ) or die( $dbh->errstr() ); 274 $st->execute(); 275 $colRef = $st->fetchall_arrayref(); 276 277 } else { 278 # for sql_single we already have a database handle; get the set table 279 # columns and proceed 280 my $cmd = "show columns from `${crs}_set`"; 281 print "$cmd\n"; 282 my $st = $dbh->prepare( $cmd ) or die( $dbh->errstr() ); 283 $st->execute(); 284 $colRef = $st->fetchall_arrayref(); 285 } 286 287 # now, do we have the columns we need already? 288 my $doneAlready = 0; 289 foreach my $cols ( @$colRef ) { 290 if ( inList( $cols->[0], @newFields ) ) { 291 $doneAlready = 1; 292 last; 293 } 294 } 295 if ( $doneAlready ) { 296 push( @skipped, $crs ); 297 next; 298 } else { 299 300 # do update for course 301 my ( $cmd1, $cmd2 ); 302 if ( $dbtype eq 'sql' ) { 303 $cmd1 = 'alter table set_not_a_keyword add column'; 304 $cmd2 = 'alter table set_user add column'; 305 } else { 306 $cmd1 = "alter table `${crs}_set` add column"; 307 $cmd2 = "alter table `${crs}_set_user` add column"; 308 } 309 310 foreach my $f ( keys %addFields ) { 311 print "$cmd1 $f $addFields{$f}\n"; 312 my $st = $dbh->prepare( "$cmd1 $f $addFields{$f}" ) or 313 die( $dbh->errstr() ); 314 $st->execute() or die( $st->errstr() ); 315 } 316 317 foreach my $f ( keys %addFields ) { 318 print "$cmd2 $f $addFields{$f}\n"; 319 my $st = $dbh->prepare( "$cmd2 $f $addFields{$f}" ) or 320 die( $dbh->errstr() ); 321 $st->execute() or die( $st->errstr() ); 322 } 323 324 push( @done, $crs ); 325 } 326 # if we're doing sql databases, disconnect from this courses' database 327 $dbh->disconnect() if ( $dbtype eq 'sql' ); 328 329 } # end loop through courses 330 print "\n"; 331 332 return( \@done, \@skipped ); 333 } 334 335 sub inList { 336 my $v = shift(); 337 foreach ( @_ ) { return 1 if ( $v eq $_ ); } 338 return 0; 339 } 340 341 sub confirmUpdate { 342 my ( $dbtype, $doneRef, $skipRef ) = @_; 343 344 my $s1 = "updated $dbtype courses: "; 345 my $s2 = "courses not needing updates were skipped: "; 346 my $l1 = length($s1); 347 my $l2 = length($s2); 348 349 my $crsList= (@$doneRef) ? join(', ', @$doneRef) : ''; 350 my $skpList= (@$skipRef) ? join(', ', @$skipRef) : ''; 351 my $crsString = ( $crsList ) ? 352 $s1 . hangIndent( $l1, 75, $l1, "$crsList.") . "\n" : ''; 353 my $skpString = ( $skpList ) ? 354 $s2 . hangIndent( $l1, 75, $l2, "$skpList." ) : ''; 355 356 print <<eot; 357 --------------------------------------------------------------------------- 358 done. 359 $crsString$skpString 360 361 eot 362 } 363 364 sub hangIndent { 365 my ( $hang, $width, $shorten, $text ) = @_; 366 # pre: $hang and $width are numbers, $hang < $width; $text is a string 367 # if $shorten, the first line is shortened by $shorten 368 # post: $text is reformatted to have maximum width $width and a hanging 369 # indent of $hang each line after the first; the reformatted text 370 # is returned 371 my $htext = ''; 372 my $line = ''; 373 my $indent = ($shorten ? $shorten : 0); 374 my $ldr = ' 'x$hang; 375 376 if ( $indent + length($text) < $width ) { 377 $htext = $text; 378 } else { 379 foreach ( split(/\s+/, $text ) ) { 380 if ( $indent + length($line) + length($_) >= $width ) { 381 $htext .= $line . "\n$ldr"; 382 $line = "$_ "; 383 $indent = $hang; 384 } else { 385 $line .= "$_ "; 386 } 387 } 388 $htext .= $line if ( $line ); 389 } 390 $htext =~ s/\n$ldr$//; 391 return $htext; 392 } 393 394 # end of script 395 #-------------------------------------------------------------------------------
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |