diff --git a/bin/old_scripts/timing b/bin/old_scripts/timing deleted file mode 100755 index 6f877e8a12..0000000000 --- a/bin/old_scripts/timing +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env perl -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2024 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -use strict; -use warnings; - -use constant ID => 0; -use constant TIME => 1; -use constant TASK => 2; -use constant DATA => 3; - -my %processes; - -while (<>) { - - my ($pid, $id, $time, $diff, $task, $data) = - m/^TIMING\s+(\d+)\s+(\d+)\s+([\d\.]+)\s+(\([\d\.]+\))\s+(.*)\s*:\s*(.*)$/; - push @{$processes{$pid}}, [$id, $time, $diff, $task, $data] if $pid; - -} - -foreach my $pid (keys %processes) { - my $indent = -1; - print "Timing data for PID $pid\n\n"; - my @events = sort { $a->[TIME] <=> $b->[TIME] } @{$processes{$pid}}; - foreach my $event (@events) { - $indent++ if $event->[DATA] eq "START"; - - print " "x$indent, join(" \t",@$event), "\n"; - $indent-- if $event->[DATA] eq "FINISH"; - - } - print "\n"; - -} diff --git a/bin/old_scripts/ww-update-config b/bin/old_scripts/ww-update-config deleted file mode 100755 index 9bb414417c..0000000000 --- a/bin/old_scripts/ww-update-config +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/env perl - -use strict; -use warnings; - -my $cvs_header_line = '\$' . 'CVSHeader'; - -foreach my $arg (@ARGV) { - my ($conf_file, $dist_file); - - if ($arg =~ /^(.*)\.dist$/) { - $conf_file = $1; - $dist_file = $arg; - } else { - $conf_file = $arg; - $dist_file = "$arg.dist"; - } - - my $conf_version = cvs_version($conf_file) - or die "couldn't find CVS version in $conf_file\n"; - my $dist_version = cvs_version($dist_file) - or die "couldn't find CVS version in $dist_file\n"; - - if ($conf_version eq $dist_version) { - print "$conf_file is up-to-date at version $conf_version.\n"; - next; - } - - #print "conf_version=$conf_version dist_version=$dist_version\n"; - system "cvs diff -r '$conf_version' -r '$dist_version' '$dist_file'" - . "| patch '$conf_file'"; -} - -sub cvs_version { - my ($file) = @_; - open my $fh, "<", $file or die "couldn't open $file for reading: $!\n"; - my $line; - while (my $line = <$fh>) { - if ($line =~ /$cvs_header_line.*?(1(?:\.\d+)+)/) { - return $1; - } - } -} diff --git a/bin/old_scripts/wwaddindexing b/bin/old_scripts/wwaddindexing deleted file mode 100755 index 2eeae8063d..0000000000 --- a/bin/old_scripts/wwaddindexing +++ /dev/null @@ -1,139 +0,0 @@ -#!/usr/bin/env perl -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2024 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -=head1 NAME - -wwaddindexing - add indices to an existing sql_single course. - -=head1 SYNOPSIS - - wwaddindexing COURSEID - -=head1 DESCRIPTION - -Adds indices to the course named COURSEID. The course must use the sql_single -database layout. - -=cut - -BEGIN { - # hide arguments (there could be passwords there!) - $0 = "$0"; -} - -use strict; -use warnings; -use DBI; - -my $pg_dir; -BEGIN { - die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; - $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; - die "The pg directory must be defined in PG_ROOT" unless (-e $pg_dir); -} - -use lib "$ENV{WEBWORK_ROOT}/lib"; -use lib "$pg_dir/lib"; -use WeBWorK::CourseEnvironment; -use WeBWorK::DB; -use WeBWorK::Utils qw/runtime_use/; -use WeBWorK::Utils::CourseManagement qw/dbLayoutSQLSources/; - -sub usage { - print STDERR "usage: $0 COURSEID \n"; - exit; -} - -sub usage_error { - print STDERR "$0: @_\n"; - usage(); -} - -# get command-line options -my ($courseID) = @ARGV; - -# perform sanity check -usage_error("must specify COURSEID.") unless $courseID and $courseID ne ""; - -# bring up a minimal course environment -my $ce = WeBWorK::CourseEnvironment->new({ - webwork_dir => $ENV{WEBWORK_ROOT}, - courseName => $courseID, -}); - -# make sure the course actually uses the 'sql_single' layout -usage_error("$courseID: does not use 'sql_single' database layout.") - unless $ce->{dbLayoutName} eq "sql_single"; - -# get database layout source data -my %sources = dbLayoutSQLSources($ce->{dbLayout}); - -foreach my $source (keys %sources) { - my %source = %{$sources{$source}}; - my @tables = @{$source{tables}}; - my $username = $source{username}; - my $password = $source{password}; - - my $dbh = DBI->connect($source, $username, $password); - - foreach my $table (@tables) { - # this stuff straight out of sql_single.pm - my %table = %{ $ce->{dbLayout}{$table} }; - my %params = %{ $table{params} }; - - my $source = $table{source}; - my $tableOverride = $params{tableOverride}; - my $recordClass = $table{record}; - - runtime_use($recordClass); - my @fields = $recordClass->FIELDS; - my @keyfields = $recordClass->KEYFIELDS; - - if (exists $params{fieldOverride}) { - my %fieldOverride = %{ $params{fieldOverride} }; - foreach my $field (@fields) { - $field = $fieldOverride{$field} if exists $fieldOverride{$field}; - } - } - - my @fieldList; - foreach my $start (0 .. $#keyfields) { - my $line = "ADD INDEX ( "; - $line .= join(", ", map { "`$_`(16)" } @keyfields[$start .. $#keyfields]); - $line .= " )"; - push @fieldList, $line; - } - my $fieldString = join(", ", @fieldList); - - my $tableName = $tableOverride || $table; - my $stmt = "ALTER TABLE `$tableName` $fieldString;"; - - unless ($dbh->do($stmt)) { - die "An error occurred while trying to modify the course database.\n", - "It is possible that the course database is in an inconsistent state.\n", - "The DBI error message was:\n\n", - $dbh->errstr, "\n"; - } - } - - $dbh->disconnect; -} - -=head1 AUTHOR - -Written by Sam Hathaway, hathaway at users.sourceforge.net. - -=cut diff --git a/bin/old_scripts/wwdb_addgw b/bin/old_scripts/wwdb_addgw deleted file mode 100755 index 137a8e466b..0000000000 --- a/bin/old_scripts/wwdb_addgw +++ /dev/null @@ -1,394 +0,0 @@ -#!/usr/bin/env perl -w -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2024 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ -# -# wwdb_addgw -# update webwork database tables to add fields for the gateway module -# -# by Gavin LaRose -# -=head1 NAME - -wwdb_addgw - convert SQL databases for WeBWorK 2 to add gateway fields. - -=head1 SYNOPSIS - - wwdb_addgw [-h] [sql|sql_single] - -=head1 DESCRIPTION - -Adds fields to the set and set_user tables in the WeBWorK mysql databases -that are required for the gateway module. The script prompts for which -courses to modify. Adding gateway database fields to existing courses -should have no effect on those courses, even if they are running under a -non-gateway aware version of the WeBWorK system. - -If C<-h> is provided, the script hides the mysql admin password. - -C or C gives the default WeBWorK database format. If -omitted, the script assumes sql_single and prompts to be sure. - -=cut - -use strict; -use DBI; - -# this is necessary on some systems -system("stty erase "); - -my $source = 'DBI:mysql'; - -# fields to add to the set and set_user tables -my %addFields = ( 'assignment_type' => 'text', - 'attempts_per_version' => 'integer', - 'time_interval' => 'integer', - 'versions_per_interval' => 'integer', - 'version_time_limit' => 'integer', - 'version_creation_time' => 'bigint', - 'problem_randorder' => 'integer', - 'version_last_attempt_time' => 'bigint', ); - -# process input data -my $hidepw = 0; -my $dbtype = 'sql_single'; -while ( $_ = shift(@ARGV) ) { - if ( /^-h$/ ) { - $hidepw = 1; - } elsif ( /^-/ ) { - die("Unknown input flag $_.\nUsage: wwdb_addgw [-h] sql|sql_single\n"); - } else { - if ( $_ eq 'sql' || $_ eq 'sql_single' ) { - $dbtype = $_; - } else { - die("Unknown argument $_.\nUsage: wwdb_addgw [-h] " . - "sql|sql_single\n"); - } - } -} - -printHdr( $dbtype ); - -# get database information -my ( $admin, $adminpw ); -( $admin, $adminpw, $dbtype ) = getDBInfo( $hidepw, $dbtype ); - -# connect to database, if we're in sql_single mode; this lets us easily -# get a list of courses to work with. in sql mode, it's harder b/c I can't -# get DBI->data_sources('mysql') to work on my system, so we prompt for -# those separately. if we're in sql single mode, $dbh is a place holder, -# because we have to do the database connects in the subroutines to connect -# to each different database -my $dbh = ''; -if ( $dbtype eq 'sql_single' ) { - $dbh = DBI->connect("$source:webwork", $admin, $adminpw) or - die( $DBI::errstr ); -} - -# get courses list -my @courses = getCourses( $dbtype, $dbh ); - -# now $course{coursename} = format (sql or sql_single) - -# do update -my ( $doneRef, $skipRef ) = updateCourses( $dbtype, $dbh, \@courses, - $admin, $adminpw ); -$dbh->disconnect() if ( $dbh ); - -# all done -confirmUpdate( $dbtype, $doneRef, $skipRef ); - -# end of main -#------------------------------------------------------------------------------- -# subroutines - -sub printHdr { - print < "; - my $admin = ; - chomp( $admin ); - $admin = 'root' if ( ! $admin ); - - print "mySQL login password for $admin > "; - system("stty -echo") if ( $hide ); - my $passwd = ; - if ( $hide ) { system("stty echo"); print "\n"; } - chomp( $passwd ); - die("Error: no password provided\n") if ( ! $passwd ); - - print "WeBWorK database type (sql or sql_single) [$type] > "; - my $dbtype = ; - chomp( $dbtype ); - $dbtype = $type if ( ! $dbtype ); - - return( $admin, $passwd, $dbtype ); -} - -sub getCourses { - my ( $dbtype, $dbh ) = @_; - - my %courses = (); - -# get a course list - if ( $dbtype eq 'sql' ) { - print "courses to update (enter comma separated) > "; - my $crslist = ; - chomp($crslist); - my @crslist = split(/,\s*/, $crslist); - die("Error: no courses specified\n") if ( ! @crslist ); - foreach ( @crslist ) { $courses{$_} = 1; } - - } else { - my $cmd = 'show tables'; - my $st = $dbh->prepare( $cmd ) or die( $dbh->errstr() ); - $st->execute() or die( $st->errstr() ); - my $rowRef = $st->fetchall_arrayref(); - foreach my $r ( @$rowRef ) { - $_ = $r->[0]; - #my ($crs, $tbl) = ( /^([^_]+)_(.*)$/ ); # this fails on courses with underscores in their names - my ($crs) = (/^(.*)_key$/); # match the key table - $courses{$crs} = 1 if ( defined( $crs ) ); - } - die("Error: found now sql_single WeBWorK courses\n") if ( ! %courses ); - } - -# confirm this is correct - print "\nList of courses to update:\n"; - my %nummap = orderedList( %courses ); - printclist( sort keys( %courses ) ); - print "Enter # to edit name, d# to delete from update list, or [cr] to " . - "continue.\n > "; - my $resp = ; - chomp($resp); - while ( $resp ) { - if ( $resp =~ /^\d+$/ ) { - print " old course name $nummap{$resp}; new > "; - delete( $courses{$nummap{$resp}} ); - my $newname = ; - chomp($newname); - $courses{ $newname } = 1; - } elsif ( $resp =~ /^d(\d+)$/ ) { - $resp = $1; - delete( $courses{$nummap{$resp}} ); - } else { - print "unrecognized response: $resp.\n"; - } - %nummap = orderedList( %courses ); - print "Current list of courses to update:\n"; - printclist( sort keys( %courses ) ); - print "Enter #, d# or [cr] > "; - chomp( $resp = ); - } - - my @courses = sort( keys %courses ); - if ( @courses ) { - return @courses; - } else { - die("Error: no courses left to update.\n"); - } -} - -sub orderedList { - my %hash = @_; - my $i=1; - my %nummap = (); - foreach ( sort( keys( %hash ) ) ) { - $nummap{ $i } = $_; - $i++; - } - return %nummap; -} - -sub printclist { - my @list = @_; - -# assumes a 75 column screen - - my $i = 1; - if ( @list <= 3 ) { - foreach ( @list ) { print " $i. $_\n"; $i++ } - } else { - while ( @list >= $i ) { - printf(" %2d. %-19s", $i, $list[$i-1]); - printf(" %2d. %-19s", ($i+1), $list[$i]) if ( @list >= ($i+1) ); - printf(" %2d. %-19s", ($i+2), $list[$i+1]) if ( @list >= ($i+2) ); - print "\n"; - $i+=3; - } - } - return 1; -} - -sub updateCourses { - my ( $dbtype, $dbh, $crsRef, $admin, $adminpw ) = @_; - - my @done = (); - my @skipped = (); - -# give some sense of progress - select STDOUT; $| = 1; # unbuffer output - print "doing update for $dbtype databases.\n"; - -# list of added fields to check for classes that don't need updating - my @newFields = keys( %addFields ); - - foreach my $crs ( @$crsRef ) { - print "updating $crs.\n"; - my $colRef; - - if ( $dbtype eq 'sql' ) { - # we need to get a database handle first - $dbh = DBI->connect("$source:webwork_$crs", $admin, $adminpw) or - die( $DBI::errstr ); - - # now get a list of columns from the set table to check to see if - # we need an update - my $cmd = "show columns from set_not_a_keyword"; - my $st = $dbh->prepare( $cmd ) or die( $dbh->errstr() ); - $st->execute(); - $colRef = $st->fetchall_arrayref(); - - } else { - # for sql_single we already have a database handle; get the set table - # columns and proceed - my $cmd = "show columns from `${crs}_set`"; - print "$cmd\n"; - my $st = $dbh->prepare( $cmd ) or die( $dbh->errstr() ); - $st->execute(); - $colRef = $st->fetchall_arrayref(); - } - - # now, do we have the columns we need already? - my $doneAlready = 0; - foreach my $cols ( @$colRef ) { - if ( inList( $cols->[0], @newFields ) ) { - $doneAlready = 1; - last; - } - } - if ( $doneAlready ) { - push( @skipped, $crs ); - next; - } else { - - # do update for course - my ( $cmd1, $cmd2 ); - if ( $dbtype eq 'sql' ) { - $cmd1 = 'alter table set_not_a_keyword add column'; - $cmd2 = 'alter table set_user add column'; - } else { - $cmd1 = "alter table `${crs}_set` add column"; - $cmd2 = "alter table `${crs}_set_user` add column"; - } - - foreach my $f ( keys %addFields ) { - print "$cmd1 $f $addFields{$f}\n"; - my $st = $dbh->prepare( "$cmd1 $f $addFields{$f}" ) or - die( $dbh->errstr() ); - $st->execute() or die( $st->errstr() ); - } - - foreach my $f ( keys %addFields ) { - print "$cmd2 $f $addFields{$f}\n"; - my $st = $dbh->prepare( "$cmd2 $f $addFields{$f}" ) or - die( $dbh->errstr() ); - $st->execute() or die( $st->errstr() ); - } - - push( @done, $crs ); - } - # if we're doing sql databases, disconnect from this courses' database - $dbh->disconnect() if ( $dbtype eq 'sql' ); - - } # end loop through courses - print "\n"; - - return( \@done, \@skipped ); -} - -sub inList { - my $v = shift(); - foreach ( @_ ) { return 1 if ( $v eq $_ ); } - return 0; -} - -sub confirmUpdate { - my ( $dbtype, $doneRef, $skipRef ) = @_; - - my $s1 = "updated $dbtype courses: "; - my $s2 = "courses not needing updates were skipped: "; - my $l1 = length($s1); - my $l2 = length($s2); - - my $crsList= (@$doneRef) ? join(', ', @$doneRef) : ''; - my $skpList= (@$skipRef) ? join(', ', @$skipRef) : ''; - my $crsString = ( $crsList ) ? - $s1 . hangIndent( $l1, 75, $l1, "$crsList.") . "\n" : ''; - my $skpString = ( $skpList ) ? - $s2 . hangIndent( $l1, 75, $l2, "$skpList." ) : ''; - - print <= $width ) { - $htext .= $line . "\n$ldr"; - $line = "$_ "; - $indent = $hang; - } else { - $line .= "$_ "; - } - } - $htext .= $line if ( $line ); - } - $htext =~ s/\n$ldr$//; - return $htext; -} - -# end of script -#------------------------------------------------------------------------------- diff --git a/bin/old_scripts/wwdb_check b/bin/old_scripts/wwdb_check deleted file mode 100755 index 67215fa767..0000000000 --- a/bin/old_scripts/wwdb_check +++ /dev/null @@ -1,1025 +0,0 @@ -#!/usr/bin/env perl -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2024 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -=head1 NAME - -wwdb_check - check the schema of an existing WeBWorK database - -=head1 SYNOPSIS - - wwdb_check [-nv] [ COURSE ... ] - -=head1 DESCRIPTION - -Scans an existing WeBWorK database to verify that its structure is correct for -version 0 of the database structure. Version 0 refers to the last version before -automatic database upgrading was added to WeBWorK. This utility should be run -once after upgrading webwork from version 2.2.x to version 2.3.0. - -Once any inconsistencies are fixed using this utility, F should be -run to affect automatic database upgrades to the database version appropriate -for the current version of WeBWorK. - -If no courses are listed on the command line, all courses are checked. Checks -for the following: - -=over - -=item * - -Make sure that the appropriate tables exist for each course. - -=item * - -Make sure that the proper columns exist in each table. - -=item * - -Verify that the proper column type is in use for each column. - -=back - -=head1 OPTIONS - -=over - -=item -n - -Don't offer to fix problems, just report them. - -=item -v - -Verbose output. - -=back - -=cut - -use strict; -use warnings; -use Getopt::Std; -use DBI; -use Data::Dumper; - -my $pg_dir; -BEGIN { - die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; - $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; - die "The pg directory must be defined in PG_ROOT" unless (-e $pg_dir); -} - -use lib "$ENV{WEBWORK_ROOT}/lib"; -use lib "$pg_dir/lib"; -use WeBWorK::CourseEnvironment; -use WeBWorK::Utils qw/runtime_use/; -use WeBWorK::Utils::CourseManagement qw/listCourses/; - -our ($opt_n, $opt_v); -getopts("nv"); - -my $noop = sub {}; - -if ($opt_n) { - *maybe_add_table = $noop; - *maybe_add_field = $noop; - *maybe_change_field = $noop; -} else { - *maybe_add_table = \&ask_add_table; - *maybe_add_field = \&ask_add_field; - *maybe_change_field = \&ask_change_field; -} - -if ($opt_v) { - $| = 1; - *verbose = sub { print STDERR @_ }; -} else { - *verbose = $noop; -} - -use constant DB_VERSION => 0; - -# a random coursename we can grab back out later -#my @chars = ('A'..'Z','a'..'z','0'..'9'); -#my $random_courseID = join("", map { $chars[rand(@chars)] } 1..16); -# fixed courseID for "version zero table data" -my $random_courseID = "6SC36NukknC3IT3M"; - -my $ce = WeBWorK::CourseEnvironment->new({ - webwork_dir => $ENV{WEBWORK_ROOT}, - courseName => $random_courseID, -}); - -my $dbh = DBI->connect( - $ce->{database_dsn}, - $ce->{database_username}, - $ce->{database_password}, - { - PrintError => 0, - RaiseError => 1, - }, -); - -=for comment - - %ww_table_data = ( - $table => { - sql_name => "SQL name for this field, probably contains $random_courseID", - field_order => [ ... ], - keyfield_order => [ ... ], - fields => { - $field => { - sql_name => "SQL name for this field, possibly overridden", - sql_type => "type for this field, from SQL_TYPES in record class", - is_keyfield => "boolean, whether or not this field is a keyfield", - }, - ... - }, - }, - ... - ); - -=cut - -# get table data for the current version of webwork -#my %ww_table_data = get_ww_table_data(); -#$Data::Dumper::Indent = 1; -#print Dumper(\%ww_table_data); -#exit; -# get static table data for version zero of the database -my %ww_table_data = get_version_zero_ww_table_data(); - -my %sql_tables = get_sql_tables(); - -if (exists $sql_tables{dbupgrade}) { - print "A 'dbupgrade' table exists in this database. This suggests that this database may already be upgraded beyond db_version 0. If this is the case, running this utility is not necessary. This utility is only needed to make sure that databases are set up correctly to enter into the automatic upgrade regimen.\n"; - exit unless ask_permission("Go ahead with table checks?", 0); - delete $sql_tables{dbupgrade}; -} - -my @ww_courses = @ARGV; -@ww_courses = listCourses($ce) if not @ww_courses; - -foreach my $ww_course_name (@ww_courses) { - my $ce2 = WeBWorK::CourseEnvironment->new({ - webwork_dir => $ENV{WEBWORK_ROOT}, - courseName => $ww_course_name, - }); - - my @diffs = compare_dbLayouts($ce, $ce2); - if (@diffs) { - print "\nThe database layout for course '$ww_course_name' differs from the generic database layout in global.conf. Here's how:\n\n"; - print map("* $_\n", @diffs), "\n"; - next unless ask_permission("Check course '$ww_course_name'?", 0); - } - - print "\nChecking tables for course '$ww_course_name'\n"; - - foreach my $ww_table_name (keys %ww_table_data) { - if ($ce2->{dbLayout}{$ww_table_name}{params}{non_native}) { - verbose("skipping table $ww_table_name for course $ww_course_name -- not a native table.\n"); - } else { - check_table($ww_course_name, $ww_table_name); - } - } -} - -my $qualifier = @ARGV ? " selected" : ""; -print "\nDone checking course tables.\n"; -print "The following tables exist in the database but are not associated with any$qualifier course:\n\n"; -print join("\n", sort keys %sql_tables), "\n\n"; - -exit; - -################################################################################ - -sub get_ww_table_data { - my %result; - - foreach my $table (keys %{$ce->{dbLayout}}) { - my $record_class = $ce->{dbLayout}{$table}{record}; - runtime_use $record_class; - - my @fields = $record_class->FIELDS; - my @types = $record_class->SQL_TYPES; - my @keyfields = $record_class->KEYFIELDS; - my %keyfields; @keyfields{@keyfields} = (); - - my %field_data; - - foreach my $i (0..$#fields) { - my $field = $fields[$i]; - my $field_sql = $ce->{dbLayout}{$table}{params}{fieldOverride}{$field}; - $field_data{$field}{sql_name} = $field_sql || $field; - - my $type = $types[$i]; - $field_data{$field}{sql_type} = $type; - - $field_data{$field}{is_keyfield} = exists $keyfields{$field}; - } - - $result{$table}{fields} = \%field_data; - $result{$table}{field_order} = \@fields; - $result{$table}{keyfield_order} = \@keyfields; - - my $table_sql = $ce->{dbLayout}{$table}{params}{tableOverride}; - $result{$table}{sql_name} = $table_sql || $table; - } - - return %result; -} - -sub get_sql_tables { - my $sql_tables_ref = $dbh->selectcol_arrayref("SHOW TABLES"); - my %sql_tables; @sql_tables{@$sql_tables_ref} = (); - - return %sql_tables; -} - -################################################################################ - -sub check_table { - my ($ww_course_name, $ww_table_name) = @_; - my $sql_table_name = get_sql_table_name($ww_table_data{$ww_table_name}{sql_name}, $ww_course_name); - - verbose("\nChecking '$ww_table_name' table (SQL table '$sql_table_name')\n"); - - if (exists $sql_tables{$sql_table_name}) { - check_fields($ww_course_name, $ww_table_name, $sql_table_name); - delete $sql_tables{$sql_table_name}; - } else { - print "$sql_table_name: table missing\n"; - my $ww_table_rec = $ww_table_data{$ww_table_name}; - if (maybe_add_table($ww_course_name, $ww_table_name)) { - check_fields($ww_course_name, $ww_table_name, $sql_table_name); - delete $sql_tables{$sql_table_name}; - } - } -} - -sub ask_add_table { - my ($ww_course_name, $ww_table_name) = @_; - my $ww_table_rec = $ww_table_data{$ww_table_name}; - my $sql_table_name = get_sql_table_name($ww_table_rec->{sql_name}, $ww_course_name); - - my $stmt = create_table_stmt($ww_table_rec, $sql_table_name); - - print "\nI can add this table to the database with the following SQL statement:\n"; - print "$stmt\n\n"; - print "If this is an upgraded installation, it is possible that '$ww_course_name' is an old GDBM course. If this is the case, you should probably not add this table, as it won't be used.\n"; - return 0 unless ask_permission("Add table '$sql_table_name'?"); - - return unless do_handle_error($dbh, $stmt); - print "Added table '$sql_table_name'.\n\n"; - - return 1; -} - -sub create_table_stmt { - my ($ww_table_rec, $sql_table_name) = @_; - - #print Dumper($ww_table_rec); - - my @field_list; - - # generate a column specification for each field - my @fields = @{$ww_table_rec->{field_order}}; - foreach my $field (@fields) { - my $ww_field_rec = $ww_table_rec->{fields}{$field}; - my $sql_field_name = $ww_field_rec->{sql_name}; - my $sql_field_type = $ww_field_rec->{sql_type}; - - push @field_list, "`$sql_field_name` $sql_field_type"; - } - - # generate an INDEX specification for each all possible sets of keyfields (i.e. 0+1+2, 1+2, 2) - my @keyfields = @{$ww_table_rec->{keyfield_order}}; - foreach my $start (0 .. $#keyfields) { - my @index_components; - - foreach my $component (@keyfields[$start .. $#keyfields]) { - my $ww_field_rec = $ww_table_rec->{fields}{$component}; - my $sql_field_name = $ww_field_rec->{sql_name}; - my $sql_field_type = $ww_field_rec->{sql_type}; - my $length_specifier = ($sql_field_type =~ /int/i) ? "" : "(16)"; - push @index_components, "`$sql_field_name`$length_specifier"; - } - - my $index_string = join(", ", @index_components); - push @field_list, "INDEX ( $index_string )"; - } - - my $field_string = join(", ", @field_list); - my $create_stmt = "CREATE TABLE `$sql_table_name` ( $field_string )"; - - return $create_stmt; -} - -################################################################################ - -sub check_fields { - my ($ww_course_name, $ww_table_name, $sql_table_name) = @_; - - my $describe_data = $dbh->selectall_hashref("DESCRIBE `$sql_table_name`", 1); - - foreach my $ww_field_name (@{$ww_table_data{$ww_table_name}{field_order}}) { - my $ww_field_rec = $ww_table_data{$ww_table_name}{fields}{$ww_field_name}; - my $sql_field_name = $ww_field_rec->{sql_name}; - my $sql_field_rec = $describe_data->{$sql_field_name}; - - verbose("Checking '$ww_field_name' field (SQL field '$sql_table_name.$sql_field_name')\n"); - - #print "$sql_table_name.$sql_field_name:\n"; - #print Dumper($ww_field_rec); - #print Dumper($sql_field_rec); - - if (defined $sql_field_rec) { - my ($sql_base_type) = $sql_field_rec->{Type} =~ /^([^(]*)/; - #print $sql_field_rec->{Type}, " => $sql_base_type\n"; - - my $needs_fixing = 0; - if ($ww_field_name eq "psvn") { - - unless ("int" eq lc($sql_base_type)) { - $needs_fixing = 1; - print "$sql_table_name.$sql_field_name: type should be 'int' but appears to be '", - lc($sql_base_type), "'\n"; - } - - unless (lc($sql_field_rec->{Extra}) =~ /\bauto_increment\b/) { - $needs_fixing = 1; - print "$sql_table_name.$sql_field_name: extra should contain 'auto_increment' but appears to be '", - lc($sql_field_rec->{Extra}), "'\n"; - } - - # FIXME instead of checking this, figure out how to use "SHOW INDEXES FROM `$sql_table_name`" - #unless ("pri" eq lc($sql_field_rec->{Key})) { - # $needs_fixing = 1; - # print "$sql_table_name.$sql_field_name: key should be 'pri' but appears to be '", - # lc($sql_field_rec->{Key}), "'\n"; - #} - - } else { - - unless (lc($ww_field_rec->{sql_type}) eq lc($sql_base_type)) { - $needs_fixing = 1; - print "$sql_table_name.$sql_field_name: type should be '", lc($ww_field_rec->{sql_type}), - "' but appears to be '", lc($sql_base_type), "'\n"; - } - - # FIXME instead of checking this, figure out how to use "SHOW INDEXES FROM `$sql_table_name`" - #unless ( $ww_field_rec->{is_keyfield} == (lc($sql_field_rec->{Key}) eq "mul") ) { - # $needs_fixing = 1; - # print "$sql_table_name.$sql_field_name: key should be '", - # ($ww_field_rec->{is_keyfield} ? "mul" : ""), "' but appears to be '", - # lc($sql_field_rec->{Key}), "'\n"; - #} - } - - $needs_fixing and maybe_change_field($ww_course_name, $ww_table_name, $ww_field_name, $sql_base_type); - - } else { - print "$sql_table_name.$sql_field_name: field missing\n"; - maybe_add_field($ww_course_name, $ww_table_name, $ww_field_name); - } - } -} - -sub ask_add_field { - my ($ww_course_name, $ww_table_name, $ww_field_name) = @_; - my $ww_table_rec = $ww_table_data{$ww_table_name}; - my $sql_table_name = get_sql_table_name($ww_table_rec->{sql_name}, $ww_course_name); - my $sql_field_name = $ww_table_rec->{fields}{$ww_field_name}{sql_name}; - - my $stmt = add_field_stmt($ww_table_rec, $ww_field_name, $sql_table_name); - - print "\nI can add this field to the database with the following SQL statement:\n"; - print "$stmt\n\n"; - return 0 unless ask_permission("Add field '$sql_table_name.$sql_field_name'?"); - - return unless do_handle_error($dbh, $stmt); - print "Added field '$sql_field_name'.\n\n"; - - return 0; -} - -sub add_field_stmt { - my ($ww_table_rec, $ww_field_name, $sql_table_name) = @_; - my $sql_field_name = $ww_table_rec->{fields}{$ww_field_name}{sql_name}; - my $sql_field_type = $ww_table_rec->{fields}{$ww_field_name}{sql_type}; - my $location_modifier = get_location_modifier($ww_table_rec, $ww_field_name); - - return "ALTER TABLE `$sql_table_name` ADD COLUMN `$sql_field_name` $sql_field_type $location_modifier"; -} - -sub get_location_modifier { - my ($ww_table_rec, $ww_field_name) = @_; - - my $field_index = -1; - - for (my $i = 0; $i < @{$ww_table_rec->{field_order}}; $i++) { - if ($ww_table_rec->{field_order}[$i] eq $ww_field_name) { - $field_index = $i; - last; - } - } - - if ($field_index < 0) { - die "field '$ww_field_name' not found in field_order (shouldn't happen!)"; - } elsif ($field_index > 0) { - my $ww_prev_field_name = $ww_table_rec->{field_order}[$field_index-1]; - my $sql_prev_field_name = $ww_table_rec->{fields}{$ww_prev_field_name}{sql_name}; - return "AFTER `$sql_prev_field_name`"; - } else { - return "FIRST"; - } -} - -sub ask_change_field { - my ($ww_course_name, $ww_table_name, $ww_field_name, $sql_curr_base_type) = @_; - my $ww_table_rec = $ww_table_data{$ww_table_name}; - my $sql_table_name = get_sql_table_name($ww_table_rec->{sql_name}, $ww_course_name); - my $sql_field_name = $ww_table_rec->{fields}{$ww_field_name}{sql_name}; - - my @stmts = change_field_stmts($ww_table_rec, $ww_field_name, $sql_table_name, $sql_curr_base_type); - - my $pl = @stmts == 1 ? "" : "s"; - print "\nI can change this field with the following SQL statement$pl:\n"; - print map("$_\n", @stmts), "\n"; - return 0 unless ask_permission("Change field '$sql_table_name.$sql_field_name'?"); - - foreach my $stmt (@stmts) { - return unless do_handle_error($dbh, $stmt); - } - print "Changed field '$sql_field_name'.\n\n"; - - return 0; -} - -sub change_field_stmts { - my ($ww_table_rec, $ww_field_name, $sql_table_name, $sql_curr_base_type) = @_; - my $sql_field_name = $ww_table_rec->{fields}{$ww_field_name}{sql_name}; - my $sql_field_type = $ww_table_rec->{fields}{$ww_field_name}{sql_type}; - - if ($sql_curr_base_type =~ /text/i and $sql_field_type =~ /int/i) { - return ( - "ALTER TABLE `$sql_table_name` CHANGE COLUMN `$sql_field_name` `$sql_field_name` VARCHAR(255)", - "ALTER TABLE `$sql_table_name` CHANGE COLUMN `$sql_field_name` `$sql_field_name` $sql_field_type", - ); - } else { - return "ALTER TABLE `$sql_table_name` CHANGE COLUMN `$sql_field_name` `$sql_field_name` $sql_field_type"; - } -} - -################################################################################ - -sub get_sql_table_name { - my ($template, $course_name) = @_; - - $template =~ s/$random_courseID/$course_name/g; - return $template; -} - -sub ask_permission { - my ($prompt, $default) = @_; - - $default = 1 if not defined $default; - my $options = $default ? "[Y/n]" : "[y/N]"; - - while (1) { - print "$prompt $options "; - my $resp = ; - chomp $resp; - return $default if $resp eq ""; - return 1 if lc $resp eq "y"; - return 0 if lc $resp eq "n"; - $prompt = 'Please enter "y" or "n".'; - } -} - -# no error => returns true -# error, user says continue => returns false -# error, user says don't continue => returns undef -# error, user says exit => exits -sub do_handle_error { - my ($dbh, $stmt) = @_; - - eval { $dbh->do($stmt) }; - if ($@) { - print "SQL statment failed. Here is the error message: $@\n"; - return ask_permission("Continue?", 1); - } else { - return 1; - } -} - -sub compare_dbLayouts { - my ($ce1, $ce2) = @_; - - my $dbLayout1 = $ce1->{dbLayoutName}; - my $dbLayout2 = $ce2->{dbLayoutName}; - #warn "Generic: '$dbLayout1' this course: '$dbLayout2'.\n"; - - # simplisic check for now - if ($dbLayout1 ne $dbLayout2) { - return "\$dbLayoutName differs. Generic: '$dbLayout1' this course: '$dbLayout2'. (If you've created" - . " a modified version of the '$dbLayout1' database layout for use with this course, it's probably" - . " OK to check this course anyway. Just be sure that any fixes this program proposes are" - . " appropriate given your modifications.)"; - } - - return (); -} - -################################################################################ - -sub get_version_zero_ww_table_data { - return ( - 'problem_user' => { - 'fields' => { - 'problem_seed' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'problem_seed' - }, - 'status' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'status' - }, - 'max_attempts' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'max_attempts' - }, - 'value' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'value' - }, - 'last_answer' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'last_answer' - }, - 'source_file' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'source_file' - }, - 'set_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'set_id' - }, - 'problem_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'INT', - 'sql_name' => 'problem_id' - }, - 'num_incorrect' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'num_incorrect' - }, - 'num_correct' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'num_correct' - }, - 'attempted' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'attempted' - }, - 'user_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'user_id' - } - }, - 'keyfield_order' => [ - 'user_id', - 'set_id', - 'problem_id' - ], - 'field_order' => [ - 'user_id', - 'set_id', - 'problem_id', - 'source_file', - 'value', - 'max_attempts', - 'problem_seed', - 'status', - 'attempted', - 'last_answer', - 'num_correct', - 'num_incorrect' - ], - 'sql_name' => '6SC36NukknC3IT3M_problem_user' - }, - 'permission' => { - 'fields' => { - 'permission' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'permission' - }, - 'user_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'user_id' - } - }, - 'keyfield_order' => [ - 'user_id' - ], - 'field_order' => [ - 'user_id', - 'permission' - ], - 'sql_name' => '6SC36NukknC3IT3M_permission' - }, - 'key' => { - 'fields' => { - 'timestamp' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'timestamp' - }, - 'user_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'user_id' - }, - 'key' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'key_not_a_keyword' - } - }, - 'keyfield_order' => [ - 'user_id' - ], - 'field_order' => [ - 'user_id', - 'key', - 'timestamp' - ], - 'sql_name' => '6SC36NukknC3IT3M_key' - }, - 'password' => { - 'fields' => { - 'password' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'password' - }, - 'user_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'user_id' - } - }, - 'keyfield_order' => [ - 'user_id' - ], - 'field_order' => [ - 'user_id', - 'password' - ], - 'sql_name' => '6SC36NukknC3IT3M_password' - }, - 'problem' => { - 'fields' => { - 'problem_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'INT', - 'sql_name' => 'problem_id' - }, - 'max_attempts' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'max_attempts' - }, - 'value' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'value' - }, - 'source_file' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'source_file' - }, - 'set_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'set_id' - } - }, - 'keyfield_order' => [ - 'set_id', - 'problem_id' - ], - 'field_order' => [ - 'set_id', - 'problem_id', - 'source_file', - 'value', - 'max_attempts' - ], - 'sql_name' => '6SC36NukknC3IT3M_problem' - }, - 'user' => { - 'fields' => { - 'email_address' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'email_address' - }, - 'student_id' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'student_id' - }, - 'comment' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'comment' - }, - 'status' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'status' - }, - 'recitation' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'recitation' - }, - 'section' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'section' - }, - 'user_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'user_id' - }, - 'last_name' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'last_name' - }, - 'first_name' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'first_name' - } - }, - 'keyfield_order' => [ - 'user_id' - ], - 'field_order' => [ - 'user_id', - 'first_name', - 'last_name', - 'email_address', - 'student_id', - 'status', - 'section', - 'recitation', - 'comment' - ], - 'sql_name' => '6SC36NukknC3IT3M_user' - }, - 'set_user' => { - 'fields' => { - 'version_time_limit' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'version_time_limit' - }, - 'set_header' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'set_header' - }, - 'psvn' => { - 'is_keyfield' => '', - 'sql_type' => 'INT NOT NULL PRIMARY KEY AUTO_INCREMENT', - 'sql_name' => 'psvn' - }, - 'hardcopy_header' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'hardcopy_header' - }, - 'version_creation_time' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'version_creation_time' - }, - 'open_date' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'open_date' - }, - 'problem_randorder' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'problem_randorder' - }, - 'versions_per_interval' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'versions_per_interval' - }, - 'version_last_attempt_time' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'version_last_attempt_time' - }, - 'time_interval' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'time_interval' - }, - 'set_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'set_id' - }, - 'visible' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'visible' - }, - 'assignment_type' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'assignment_type' - }, - 'due_date' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'due_date' - }, - 'answer_date' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'answer_date' - }, - 'user_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'user_id' - }, - 'attempts_per_version' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'attempts_per_version' - } - }, - 'keyfield_order' => [ - 'user_id', - 'set_id' - ], - 'field_order' => [ - 'user_id', - 'set_id', - 'psvn', - 'set_header', - 'hardcopy_header', - 'open_date', - 'due_date', - 'answer_date', - 'visible', - 'assignment_type', - 'attempts_per_version', - 'time_interval', - 'versions_per_interval', - 'version_time_limit', - 'version_creation_time', - 'problem_randorder', - 'version_last_attempt_time' - ], - 'sql_name' => '6SC36NukknC3IT3M_set_user' - }, - 'set' => { - 'fields' => { - 'version_last_attempt_time' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'version_last_attempt_time' - }, - 'version_time_limit' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'version_time_limit' - }, - 'versions_per_interval' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'versions_per_interval' - }, - 'time_interval' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'time_interval' - }, - 'set_header' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'set_header' - }, - 'set_id' => { - 'is_keyfield' => 1, - 'sql_type' => 'BLOB', - 'sql_name' => 'set_id' - }, - 'hardcopy_header' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'hardcopy_header' - }, - 'visible' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'visible' - }, - 'version_creation_time' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'version_creation_time' - }, - 'due_date' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'due_date' - }, - 'assignment_type' => { - 'is_keyfield' => '', - 'sql_type' => 'TEXT', - 'sql_name' => 'assignment_type' - }, - 'open_date' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'open_date' - }, - 'answer_date' => { - 'is_keyfield' => '', - 'sql_type' => 'BIGINT', - 'sql_name' => 'answer_date' - }, - 'attempts_per_version' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'attempts_per_version' - }, - 'problem_randorder' => { - 'is_keyfield' => '', - 'sql_type' => 'INT', - 'sql_name' => 'problem_randorder' - } - }, - 'keyfield_order' => [ - 'set_id' - ], - 'field_order' => [ - 'set_id', - 'set_header', - 'hardcopy_header', - 'open_date', - 'due_date', - 'answer_date', - 'visible', - 'assignment_type', - 'attempts_per_version', - 'time_interval', - 'versions_per_interval', - 'version_time_limit', - 'version_creation_time', - 'problem_randorder', - 'version_last_attempt_time' - ], - 'sql_name' => '6SC36NukknC3IT3M_set' - } - ); -} diff --git a/bin/old_scripts/wwdb_init b/bin/old_scripts/wwdb_init deleted file mode 100755 index 2cb08b5992..0000000000 --- a/bin/old_scripts/wwdb_init +++ /dev/null @@ -1,199 +0,0 @@ -#!/usr/bin/env perl -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2024 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -use strict; -use warnings; -use Getopt::Std; -use DBI; -use Data::Dumper; - -my $pg_dir; -BEGIN { - die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; - $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; - die "The pg directory must be defined in PG_ROOT" unless (-e $pg_dir); -} -use lib "$ENV{WEBWORK_ROOT}/lib"; -use lib "$pg_dir/lib"; -use WeBWorK::CourseEnvironment; -use WeBWorK::Utils qw/runtime_use/; - - -our ($opt_v); -getopts("v"); - -if ($opt_v) { - $| = 1; - *verbose = sub { print STDERR @_ }; -} else { - *verbose = sub {}; -} - -# global variables, hah hah. -my ($dbh, %sql_tables); - -################################################################################ - -my $i = -1; -our @DB_VERSIONS; - -$DB_VERSIONS[++$i]{desc} = "is the initial version of database, identical to database structure in WeBWorK 2.2.x."; - -$DB_VERSIONS[++$i]{desc} = "adds dbupgrade table to facilitate automatic database upgrades."; -$DB_VERSIONS[ $i]{global_code} = sub { - $dbh->do("CREATE TABLE `dbupgrade` (`name` VARCHAR(255) NOT NULL PRIMARY KEY, `value` TEXT)"); - $dbh->do("INSERT INTO `dbupgrade` (`name`, `value`) VALUES (?, ?)", {}, "db_version", 1); - $sql_tables{dbupgrade} = (); -}; - - -$DB_VERSIONS[++$i]{desc} = "adds depths table to keep track of dvipng depth information."; -$DB_VERSIONS[ $i]{global_code} = sub { - $dbh->do("CREATE TABLE depths (md5 CHAR(33) NOT NULL, depth SMALLINT, PRIMARY KEY (md5))"); - $sql_tables{depths} = (); -}; - -$DB_VERSIONS[++$i]{desc} = "adds locations, location_addresses, set_locations and set_locations_user tables to database, and add restrict_ip to set and set_user."; -$DB_VERSIONS[ $i]{global_code} = sub { - $dbh->do("CREATE TABLE locations (location_id TINYBLOB NOT NULL, description TEXT, PRIMARY KEY (location_id(1000)))"); - $dbh->do("CREATE TABLE location_addresses (location_id TINYBLOB NOT NULL, ip_mask TINYBLOB NOT NULL, PRIMARY KEY (location_id(500),ip_mask(500)))"); -}; - -our $THIS_DB_VERSION = $i; - -################################################################################ - -my $ce = WeBWorK::CourseEnvironment->new({ - webwork_dir => $ENV{WEBWORK_ROOT}, -}); - -$dbh = DBI->connect( - $ce->{database_dsn}, - $ce->{database_username}, - $ce->{database_password}, - { - PrintError => 0, - RaiseError => 1, - }, -); - -{ - verbose("Obtaining dbupgrade lock...\n"); - my ($lock_status) = $dbh->selectrow_array("SELECT GET_LOCK('dbupgrade', 10)"); - if (not defined $lock_status) { - print "Couldn't obtain lock because an error occurred.\n"; - exit 2; - } - if ($lock_status) { - verbose("Got lock.\n"); - } else { - print "Timed out while waiting for lock.\n"; - exit 2; - } -} - -%sql_tables = get_sql_tables(); - -my $db_version = 0; - - -verbose("Initial db_version is $db_version\n"); - -if ($db_version > $THIS_DB_VERSION) { - print "db_version is $db_version, but the current database version is only $THIS_DB_VERSION. This database was probably used with a newer version of WeBWorK.\n"; - exit; -} - -while ($db_version < $THIS_DB_VERSION) { - $db_version++; - unless (upgrade_to_version($db_version)) { - print "\nUpgrading from version ".($db_version-1)." to $db_version failed.\n\n"; - unless (ask_permission("Ignore this error and go on to the next version?", 0)) { - exit 3; - } - } - set_db_version($db_version); -} - -print "\nDatabase is up-to-date at version $db_version.\n"; - -END { - verbose("Releasing dbupgrade lock...\n"); - my ($lock_status) = $dbh->selectrow_array("SELECT RELEASE_LOCK('dbupgrade')"); - if (not defined $lock_status) { - print "Couldn't release lock because the lock does not exist.\n"; - exit 2; - } - if ($lock_status) { - verbose("Released lock.\n"); - } else { - print "Couldn't release lock because the lock is not held by this thread.\n"; - exit 2; - } -} - -################################################################################ - -sub get_sql_tables { - my $sql_tables_ref = $dbh->selectcol_arrayref("SHOW TABLES"); - my %sql_tables; @sql_tables{@$sql_tables_ref} = (); - - return %sql_tables; -} - -sub set_db_version { - my $vers = shift; - $dbh->do("UPDATE `dbupgrade` SET `value`=? WHERE `name`='db_version'", {}, $vers); -} - -sub upgrade_to_version { - my $vers = shift; - my %info = %{$DB_VERSIONS[$vers]}; - - print "\nUpgrading database from version " . ($vers-1) . " to $vers...\n"; - my $desc = $info{desc} || "has no description."; - print "(Version $vers $desc)\n"; - - if (exists $info{global_code}) { - eval { $info{global_code}->() }; - if ($@) { - print "\nAn error occurred while running the system upgrade code for version $vers:\n"; - print "$@"; - return 0 unless ask_permission("Ignore this error and keep going?", 0); - } - } - print "Done.\n"; - return 1; -} - -################################################################################ - -sub ask_permission { - my ($prompt, $default) = @_; - - $default = 1 if not defined $default; - my $options = $default ? "[Y/n]" : "[y/N]"; - - while (1) { - print "$prompt $options "; - my $resp = ; - chomp $resp; - return $default if $resp eq ""; - return 1 if lc $resp eq "y"; - return 0 if lc $resp eq "n"; - $prompt = 'Please enter "y" or "n".'; - } -} diff --git a/bin/old_scripts/wwdb_upgrade b/bin/old_scripts/wwdb_upgrade deleted file mode 100755 index ad779a2771..0000000000 --- a/bin/old_scripts/wwdb_upgrade +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/env perl -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2024 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -use strict; -use warnings; -use Getopt::Std; -use Data::Dumper; - -my $pg_dir; -BEGIN { - die "WEBWORK_ROOT not found in environment.\n" unless exists $ENV{WEBWORK_ROOT}; - $pg_dir = $ENV{PG_ROOT} // "$ENV{WEBWORK_ROOT}/../pg"; - die "The pg directory must be defined in PG_ROOT" unless (-e $pg_dir); -} -use lib "$ENV{WEBWORK_ROOT}/lib"; -use lib "$pg_dir/lib"; -use WeBWorK::CourseEnvironment; -use WeBWorK::Utils::DBUpgrade; - -our ($opt_v); -getopts("v"); - -if ($opt_v) { - $WeBWorK::Debug::Enabled = 1; -} else { - $WeBWorK::Debug::Enabled = 0; -} - -my $ce = new WeBWorK::CourseEnvironment({webwork_dir=>$ENV{WEBWORK_ROOT}}); - -my $upgrader = new WeBWorK::Utils::DBUpgrade( - ce => $ce, - verbose_sub => sub { print STDERR @_ }, -); - -$upgrader->do_upgrade; -