View of /trunk/webwork-modperl/bin/hash2sql

    1 #!/usr/bin/env perl
    2 ################################################################################
    3 # WeBWorK Online Homework Delivery System
    4 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    5 # $CVSHeader: webwork-modperl/bin/hash2sql,v 1.3 2003/12/09 01:12:28 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 =head1 NAME
   19 
   20 hash2sql - copies data from a course using a hash-based database (without global tables)
   21 to a course using an sql-based database (with global tables).
   22 
   23 =cut
   24 
   25 use strict;
   26 use warnings;
   27 use FindBin;
   28 use lib "$FindBin::Bin/../lib";
   29 use WeBWorK::CourseEnvironment;
   30 use WeBWorK::DB;
   31 use WeBWorK::DB::Utils qw(findDefaults);
   32 
   33 sub main(@) {
   34 	my ($hashCourse, $sqlCourse) = @_;
   35 	
   36 	unless ($ENV{WEBWORK_ROOT}) {
   37 		die "WEBWORK_ROOT not found in environment.\n";
   38 	}
   39 	
   40 	unless ($hashCourse and $sqlCourse) {
   41 		die "usage: $0 hashCourse sqlCourse\n";
   42 	}
   43 	
   44 	my $hashCE = WeBWorK::CourseEnvironment->new($ENV{WEBWORK_ROOT}, "", "", $hashCourse);
   45 	my $hashDB = WeBWorK::DB->new($hashCE->{dbLayout});
   46 	
   47 	my $sqlCE = WeBWorK::CourseEnvironment->new($ENV{WEBWORK_ROOT}, "", "", $sqlCourse);
   48 	my $sqlDB = WeBWorK::DB->new($sqlCE->{dbLayout});
   49 	
   50 	# get names of global record classes
   51 	my $globalSetClass = $sqlCE->{dbLayout}->{set}->{record};
   52 	my $globalProblemClass = $sqlCE->{dbLayout}->{problem}->{record};
   53 	
   54 	# get non-key, global field names
   55 	my @setFields = getNonKeyFields($sqlCE->{dbLayout}->{set}->{record});
   56 	my @problemFields = getNonKeyFields($sqlCE->{dbLayout}->{problem}->{record});
   57 	
   58 	# hash to store all sets
   59 	my %allSets;
   60 	
   61 	# populate user, password, permission, and key tables
   62 	print "\n---------- adding users: ----------\n\n";
   63 	
   64 	foreach my $userID ($hashDB->listUsers()) {
   65 		print "adding user $userID:";
   66 		$sqlDB->addUser($hashDB->getUser($userID));
   67 		
   68 		my $Password = $hashDB->getPassword($userID);
   69 		if ($Password) {
   70 			print " +password";
   71 			$sqlDB->addPassword($Password);
   72 		} else {
   73 			print " -password";
   74 		}
   75 		
   76 		my $PermissionLevel = $hashDB->getPermissionLevel($userID);
   77 		if ($PermissionLevel) {
   78 			print " +permissionLevel";
   79 			$sqlDB->addPermissionLevel($PermissionLevel);
   80 		} else {
   81 			print " -permissionLevel";
   82 		}
   83 		
   84 		my $Key = $hashDB->getKey($userID);
   85 		if ($Key) {
   86 			print " +key";
   87 			$sqlDB->addKey($Key) if $Key;
   88 		} else {
   89 			print " -key";
   90 		}
   91 		
   92 		print "\n";
   93 		
   94 		# also get the names of all sets
   95 		foreach my $setID ($hashDB->listUserSets($userID)) {
   96 			$allSets{$setID}++;
   97 		}
   98 	}
   99 	
  100 	print "\n---------- found these sets: ----------\n\n";
  101 	
  102 	print join(" ", keys %allSets), "\n";
  103 	
  104 	print "\n---------- determining set defaults: ----------\n\n";
  105 	
  106 	foreach my $setID (keys %allSets) {
  107 		print "processing set $setID.\n";
  108 		# get a consensus view for each set
  109 		my @setUserIDs = $hashDB->listSetUsers($setID);
  110 		my @UserSets = map { $hashDB->getUserSet($_, $setID) } @setUserIDs;
  111 		my $GlobalSet = findDefaults($globalSetClass, @UserSets);
  112 		print "adding global set record.\n";
  113 		$sqlDB->addGlobalSet($GlobalSet);
  114 
  115 		# remove default values from each user set
  116 		# and store into sql db.
  117 		foreach my $UserSet (@UserSets) {
  118 			foreach my $field (@setFields) {
  119 				if ($UserSet->$field() eq $GlobalSet->$field()) {
  120 					$UserSet->$field(undef);
  121 				}
  122 			}
  123 			print "adding user set for user ", $UserSet->user_id, ".\n";
  124 			$sqlDB->addUserSet($UserSet);
  125 		}
  126 		
  127 		# get all problems in this set
  128 		my %allProblems;
  129 		foreach my $userID ($hashDB->listSetUsers($setID)) {
  130 			foreach my $problemID ($hashDB->listUserProblems($userID, $setID)) {
  131 				$allProblems{$problemID}++;
  132 			}
  133 		}
  134 		
  135 		print "\n----- found these problems in set $setID: ----\n\n";
  136 		
  137 		print join(" ", keys %allProblems), "\n";
  138 		
  139 	print "\n----- determining defaults for problems in set $setID: -----\n\n";
  140 	
  141 		# get a consensus for each problem in this set
  142 		foreach my $problemID (keys %allProblems) {
  143 			print "determining defaults for problem $problemID.\n";
  144 			my @problemUserIDs = $hashDB->listProblemUsers($setID, $problemID);
  145 			my @UserProblems;
  146 			print "getting user problem for user:";
  147 			foreach (@problemUserIDs) {
  148 				print " $_";
  149 				my $UserProblem = $hashDB->getUserProblem($_, $setID, $problemID);
  150 				unless (defined $UserProblem) {
  151 					print "(UNDEFINED!)";
  152 					next;
  153 				}
  154 				push @UserProblems, $UserProblem;
  155 			}
  156 			print "\n";
  157 			my $GlobalProblem = findDefaults($globalProblemClass, @UserProblems);
  158 			print "adding global problem record.\n";
  159 			$sqlDB->addGlobalProblem($GlobalProblem);
  160 			
  161 			# remove defaults from each user problem
  162 			foreach my $UserProblem (@UserProblems) {
  163 				foreach my $field (@problemFields) {
  164 					if ($UserProblem->$field() eq $GlobalProblem->$field()) {
  165 						$UserProblem->$field(undef);
  166 					}
  167 				}
  168 				print "adding user problem for user ", $UserProblem->user_id, ".\n";
  169 				$sqlDB->addUserProblem($UserProblem);
  170 			}
  171 		}
  172 	}
  173 }
  174 
  175 sub getNonKeyFields($) {
  176 	my ($Record) = @_;
  177 	
  178 	my %fields = map { $_ => {} } $Record->FIELDS();
  179 	delete $fields{$_} foreach $Record->KEYFIELDS();
  180 	return keys %fields;
  181 }
  182 
  183 main(@ARGV);