[system] / branches / rel-2-4-patches / webwork-modperl / bin / wwdb_addgw Repository:
ViewVC logotype

View of /branches/rel-2-4-patches/webwork-modperl/bin/wwdb_addgw

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5734 - (download) (annotate)
Tue Jun 24 00:44:59 2008 UTC (4 years, 11 months ago)
File size: 11553 byte(s)
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