Difference between revisions of "WwManage"

From WeBWorK_wiki
Jump to navigation Jump to search
m
Line 1: Line 1:
[[wwManageDescription|Description of script]]
 
 
 
#!/usr/bin/perl -w
 
#!/usr/bin/perl -w
 
use strict;
 
use strict;
Line 6: Line 4:
 
# wwManage: manage webwork gateways/homework courses
 
# wwManage: manage webwork gateways/homework courses
 
#
 
#
my $version = '1.702';
+
my $version = '1.7492';
my $lastmod = '13 Jan 2011';
+
my $lastmod = '9 Jan 2014';
# changelog:
+
# changelog:
  +
# 1.74: add updateTermRoster function
  +
# 1.73: improve handling of courses like ma215-s12
  +
# 1.72: add nobuild feature for roster updates
  +
# 1.711: add flexibility in dealing with courses like ma215-w11
  +
# 1.71: add links in template directories of created courses
 
# 1.702: remove -o option, add comments, add $mailDomain variable
 
# 1.702: remove -o option, add comments, add $mailDomain variable
 
# 1.701: add domain extensions to e-mail addresses
 
# 1.701: add domain extensions to e-mail addresses
Line 68: Line 66:
 
#
 
#
 
my ( $archiveDir, $dataDir, $wwHome, $rosterDir, $htuser, $htgroup,
 
my ( $archiveDir, $dataDir, $wwHome, $rosterDir, $htuser, $htgroup,
$proctorDir, $wwCourseDir );
+
$proctorDir, $wwCourseDir );
 
 
$archiveDir = '/opt/webwork/Old';
 
$archiveDir = '/opt/webwork/Old';
 
$dataDir = '/path/to/classlists/data';
 
$dataDir = '/path/to/classlists/data';
 
$proctorDir = '/path/to/gateways/data';
 
$proctorDir = '/path/to/gateways/data';
 
  +
# my $dataDir = '/afs/lsa.umich.edu/user/g/l/glarose/Private/mathhome/mich/' .
 
# 'production/gateways/webwork/data/classlists/F05';
 
 
 
# where do we put output webwork rosters?
 
# where do we put output webwork rosters?
$rosterDir = "/path/to/gateways/webwork/data/NEWTERM/CRS";
+
$rosterDir = "/path/to/data/NEWTERM/CRS";
 
# do we save them at all?
 
# do we save them at all?
 
my $saveWWrosters = 0;
 
my $saveWWrosters = 0;
  +
  +
#-------------------------
  +
# copy data parameters
  +
# do we copy data for student work between sections?
  +
my $copyWork = 1;
  +
# skip campuses?
  +
my $copyWorkForCampuses = 0;
  +
# default tests to copy
  +
my %copyTests = ( 105 => [ 'ProctoredEntrGW', 'InstrProctoredEntrGW' ],
  +
115 => [ 'ProctoredDerivGW', 'InstrProctoredDerivGW' ],
  +
116 => [ 'ProctoredEntrGW', 'InstrProctoredEntrGW',
  +
'ProctoredIntegralGW', 'InstrProctoredIntegralGW' ]
  +
);
  +
# assignments that aren't homeworks
  +
my @copyNotLike = ( '105%', '%GW' );
  +
# set fields to copy
  +
my @copy_test_set_user_fields =
  +
( qw( user_id set_id set_header hardcopy_header open_date due_date
  +
answer_date visible enable_reduced_scoring assignment_type
  +
attempts_per_version time_interval versions_per_interval
  +
version_time_limit version_creation_time problem_randorder
  +
version_last_attempt_time problems_per_page hide_score
  +
hide_score_by_problem hide_work time_limit_cap restrict_ip
  +
relax_restrict_ip restricted_login_proctor ) );
  +
## we don't have to copy any of these for homework
  +
my @copy_hwk_set_user_fields = ( );
  +
## index of the set_id in the @copy_test_set_user_fields array
  +
my $copy_set_id_index = 1;
  +
  +
## problem fields to copy
  +
my @copy_test_prob_user_fields =
  +
( qw( user_id set_id problem_id source_file value max_attempts
  +
problem_seed status attempted last_answer num_correct
  +
num_incorrect sub_status flags ) );
  +
## homework problem fields to copy (the first $copy_hwk_update_fields
  +
## identify the problem and aren't copied)
  +
my @copy_hwk_prob_user_fields =
  +
( qw( user_id set_id problem_id problem_seed status attempted
  +
num_correct num_incorrect sub_status ) );
  +
# last_answer num_correct num_incorrect sub_status ) );
  +
my $copy_problem_set_id_index = 1;
  +
my $copy_problem_id_index = 2;
  +
# update from this index in @hwk_prob_user_fields
  +
my $copy_hwk_update_fields = 3;
  +
  +
# we need this because we're not using the WeBWorK database object
  +
# to copy work
  +
use DBI;
  +
#-------------------------
 
 
 
# a default file giving the courses and instructors to create when
 
# a default file giving the courses and instructors to create when
Line 90: Line 134:
 
# these extensions on an instructor file flag that we should look
 
# these extensions on an instructor file flag that we should look
 
# for alternate roster names: CRS_SXN_EXT.csv, instead of CRS_SXN.csv
 
# for alternate roster names: CRS_SXN_EXT.csv, instead of CRS_SXN.csv
my @fileCampusExt = ( '_umd' );
+
my @fileCampusExt = ( '_ext' );
 
# and these extensions on course names similarly; the order of these
 
# and these extensions on course names similarly; the order of these
# extensions is the same as in @fileCampusExt
+
# extensions is the same as in @fileCampusExt. dropping the -, this
my @courseCampusExt = ( '-umd' );
+
# is also prepended to the domain in the e-mail addresses assigned
  +
# to users of these courses.
  +
my @courseCampusExt = ( '-ext' );
 
# admin users for these extensions are:
 
# admin users for these extensions are:
 
my %courseCampusAdmins =
 
my %courseCampusAdmins =
( '-umd' => { 'user_id' => 'username',
+
( '-ext' => { 'user_id' => 'username',
'student_id' => '007',
+
'student_id' => 'idnumber',
'last_name' => 'Last',
+
'last_name' => 'lastname',
'first_name' => 'First' }, );
+
'first_name' => 'firstname' }, );
  +
# we may not want to build assignments when doing roster updates for
  +
# these campuses
  +
my %courseCampusBuildSets = ( '-ext' => 0 );
  +
  +
# course.conf additions to add, by campus
  +
my %courseConfAdditions =
  +
( '-ext' => '$permissionLevels{view_proctored_tests} = "student";' . "\n");
 
 
 
# default e-mail domain
 
# default e-mail domain
my $mailDomain = 'umich.edu';
+
my $mailDomain = 'school.edu';
 
 
 
$wwHome = '/opt/webwork/webwork2';
 
$wwHome = '/opt/webwork/webwork2';
 
$wwCourseDir = "$wwHome/courses";
 
$wwCourseDir = "$wwHome/courses";
  +
  +
# links to put in template directories in created courses
  +
my %templateDirLinks = ( Library => '/opt/webwork/problembanks/' .
  +
'NationalProblemLibrary',
  +
Other => '/opt/webwork/problembanks/Other' );
 
 
 
# set environment variables to allow use of WeBWorK scripts
 
# set environment variables to allow use of WeBWorK scripts
Line 120: Line 169:
 
# from the database and deletes the course directory
 
# from the database and deletes the course directory
 
# load needed webwork libraries
 
# load needed webwork libraries
use lib '/opt/webwork/pg/lib';
+
use lib '/var/www/webwork/pg/lib';
use lib '/opt/webwork/webwork2/lib';
+
use lib '/var/www/webwork/webwork2/lib';
 
 
 
use WeBWorK::PG::ImageGenerator;
 
use WeBWorK::PG::ImageGenerator;
Line 164: Line 213:
 
# an admin user to add to all classes
 
# an admin user to add to all classes
 
my $adminUser = "username";
 
my $adminUser = "username";
my $adminID = 'idnumber';
+
my $adminID = 'idnumber'; # fake id/password
 
my $adminLname = "lastname";
 
my $adminLname = "lastname";
 
my $adminFname = "firstname";
 
my $adminFname = "firstname";
Line 181: Line 230:
 
@stu_output_data
 
@stu_output_data
 
.
 
.
  +
  +
# these sets are ignored when assignments are made; format
  +
# crs_num => pattern
  +
my %skipAssignments = ( 215 => '^homework.*',
  +
217 => '^((webHW.*)|(JoyOfSets)|(MathHygiene))' );
 
 
 
# these sets aren't assigned to everyone; they just need to be imported
 
# these sets aren't assigned to everyone; they just need to be imported
 
# when we're adding assignments to a course
 
# when we're adding assignments to a course
# precal assignments also include "substitution", but this is the same
 
  +
my @groupSets = ( qw( topic_factoring topic_frac_exp_powers
# name as the integral topic
 
  +
topic_frac_exp_products topic_fractions_quotients
my @groupSets = ( qw( exponents frac_exponents fractions graphs lines
 
  +
topic_fractions_sums topic_graph_concepts
multistep solving_linsys polynomials solving_quadratics
 
  +
topic_lines topic_solving_linsys
chain_rule exponentials powers_sums product_rule
+
chain_rule exponentials powers_sums product_rule
quotient_rule symbolic trig_func_logs
+
quotient_rule symbolic trig_func_logs
simple_definite tan_line
+
simple_definite tan_line
ax_substitution basic_antidif by_parts
+
ax_substitution basic_antidif by_parts
exponentials_int logarithms_int polynomials_int
+
exponentials_int logarithms_int polynomials_int
rational_functions_int roots_int substitution
+
rational_functions_int roots_int substitution
trig_functions_int ) );
+
trig_functions_int
  +
topic_expanding topic_exponents topic_factoring
  +
topic_frac_exp_powers topic_frac_exp_products
  +
topic_fractions_quotients topic_fractions_sums
  +
topic_graph_concepts topic_lines topic_solving_linsys
  +
) );
 
 
 
# this term ordering is a bit arbitrary, and makes the fall term from
 
# this term ordering is a bit arbitrary, and makes the fall term from
Line 216: Line 270:
 
 
 
warn(" ** $myName called with arguments: none expected. (Ignoring.)\n")
 
warn(" ** $myName called with arguments: none expected. (Ignoring.)\n")
if ( @_ );
+
if ( @_ );
 
printHdr(); # welcome to the machine
 
printHdr(); # welcome to the machine
 
 
Line 222: Line 276:
 
 
 
while ( $action ) {
 
while ( $action ) {
if ( $action == 2 ) { delCourses(); }
+
if ( $action == 2 ) { delCourses(); }
elsif ( $action == 1 ) { listCourses(); }
+
elsif ( $action == 1 ) { listCourses(); }
elsif ( $action == 3 ) { addCourses2(); }
+
elsif ( $action == 3 ) { addCourses2(); }
elsif ( $action == 4 ) { addAssignments(); }
+
elsif ( $action == 4 ) { addAssignments(); }
elsif ( $action == 5 ) { addProctors(); }
+
elsif ( $action == 5 ) { addProctors(); }
elsif ( $action == 6 ) { delProctors('global'); }
+
elsif ( $action == 6 ) { delProctors('global'); }
elsif ( $action == 7 ) { delProctors('course'); }
+
elsif ( $action == 7 ) { delProctors('course'); }
elsif ( $action == 8 ) { updateRosters(); }
+
elsif ( $action == 8 ) { updateRosters(); }
elsif ( $action == 9 ) { listArchives(); }
+
elsif ( $action == 9 ) { updateTermRosters(); }
  +
elsif ( $action == 10 ) { listArchives(); }
 
 
print "\n";
+
print "\n";
$action = getAction();
+
$action = getAction();
 
}
 
}
 
}
 
}
Line 250: Line 304:
 
print <<eol;
 
print <<eol;
 
Main Menu:
 
Main Menu:
Select: 1. list defined courses
+
Select: 1. list defined courses
2. delete and archive course(s) from list of defined courses
+
2. delete and archive course(s) from list of defined courses
3. add course(s) to system
+
3. add course(s) to system
4. create assignments in course
+
4. create assignments in course
5. add proctors to courses
+
5. add proctors to courses
6. delete global proctors from courses
+
6. delete global proctors from courses
7. delete course proctors from courses
+
7. delete course proctors from courses
8. update rosters from course CSV files
+
8. update rosters from course CSV files
9. list archived courses
+
9. update rosters for all courses in a term from course CSV files
0. quit
+
10. list archived courses
  +
0. quit
 
eol
 
eol
 
my $action = -1;
 
my $action = -1;
while ( $action !~ /^[0-9]$/ ) {
+
while ( $action !~ /^([0-9])|(10)$/ ) {
print " selection> ";
+
print " selection> ";
chomp($action = <STDIN>);
+
chomp($action = <STDIN>);
warn " ** value must be between 0 and 8.\n" if ( $action !~ /^[0-8]$/ );
+
warn " ** value must be between 0 and 10.\n"
  +
if ( $action !~ /^([0-9])|(10)$/ );
 
}
 
}
 
print "\n";
 
print "\n";
Line 279: Line 333:
 
my %classList;
 
my %classList;
 
if ( @_ ) {
 
if ( @_ ) {
my $classRef = shift;
+
my $classRef = shift;
%classList = %$classRef; # this defines the current list of classes
+
%classList = %$classRef; # this defines the current list of classes
 
} else { # under consideration
 
} else { # under consideration
%classList = getClasses();
+
%classList = getClasses();
 
}
 
}
 
if ( %classList ) {
 
if ( %classList ) {
print " * courses in list * \n";
+
print " * courses in list * \n";
my @keyList = sort keys %classList;
+
my @keyList = sort keys %classList;
my $num1 = int(scalar(@keyList)/3);
+
my $num1 = int(scalar(@keyList)/3);
my ($num2, $num3);
+
my ($num2, $num3);
if ( $num1 == scalar(@keyList)/3 ) {
+
if ( $num1 == scalar(@keyList)/3 ) {
$num2 = $num1;
+
$num2 = $num1;
$num3 = $num1;
+
$num3 = $num1;
} else {
+
} else {
$num3 = $num1;
+
$num3 = $num1;
$num2 = $num1+(scalar(@keyList) - (3*$num1+1));
+
$num2 = $num1+(scalar(@keyList) - (3*$num1+1));
$num1 = $num1+1;
+
$num1 = $num1+1;
}
+
}
my $i;
+
my $i;
my $stdout = select(STDOUT);
+
my $stdout = select(STDOUT);
my $oldFormat = $~;
+
my $oldFormat = $~;
$~ = "CLIST";
+
$~ = "CLIST";
select $stdout;
+
select $stdout;
for($i=1; $i<=$num3; $i++) {
+
for($i=1; $i<=$num3; $i++) {
$i1 = $i; $n1 = $keyList[$i-1];
+
$i1 = $i; $n1 = $keyList[$i-1];
$i2 = $i+$num1; $n2 = $keyList[$i-1+$num1];
+
$i2 = $i+$num1; $n2 = $keyList[$i-1+$num1];
$i3 = $i+$num1+$num2; $n3 = $keyList[$i-1+$num1+$num2];
+
$i3 = $i+$num1+$num2; $n3 = $keyList[$i-1+$num1+$num2];
write;
+
write;
}
+
}
if ( $num2 == $i ) {
+
if ( $num2 == $i ) {
$stdout = select(STDOUT);
+
$stdout = select(STDOUT);
$~ = "CLIST2";
+
$~ = "CLIST2";
select $stdout;
+
select $stdout;
$i1 = $i; $n1 = $keyList[$i-1];
+
$i1 = $i; $n1 = $keyList[$i-1];
$i2 = $i+$num1; $n2 = $keyList[$i-1+$num1];
+
$i2 = $i+$num1; $n2 = $keyList[$i-1+$num1];
write;
+
write;
} elsif ( $num1 == $i ) {
+
} elsif ( $num1 == $i ) {
$stdout = select(STDOUT);
+
$stdout = select(STDOUT);
$~ = "CLIST1";
+
$~ = "CLIST1";
select $stdout;
+
select $stdout;
$i1 = $i; $n1 = $keyList[$i-1];
+
$i1 = $i; $n1 = $keyList[$i-1];
write;
+
write;
}
+
}
$stdout = select(STDOUT);
+
$stdout = select(STDOUT);
$~ = $oldFormat;
+
$~ = $oldFormat;
select $stdout;
+
select $stdout;
 
} else {
 
} else {
die(" ** error getting list of defined courses * \n");
+
die(" ** error getting list of defined courses * \n");
 
}
 
}
 
return 1;
 
return 1;
Line 354: Line 408:
 
my %archiveList = ( );
 
my %archiveList = ( );
 
foreach my $term ( @termList ) {
 
foreach my $term ( @termList ) {
my @aList = `/bin/ls $archiveDir/$term`;
+
my @aList = `/bin/ls $archiveDir/$term`;
 
 
for ( my $i=0; $i<@aList; $i++ ) {
+
for ( my $i=0; $i<@aList; $i++ ) {
chomp($aList[$i]);
+
chomp($aList[$i]);
$aList[$i] =~ s/^ma(.*?)(-?[fwsuFWSU]\d\d)?\.tar\.gz$/$1/;
+
$aList[$i] =~ s/^ma(.*?)(-?[fwsuFWSU]\d\d)?\.tar\.gz$/$1/;
}
+
}
$archiveList{$term} = [ @aList ];
+
$archiveList{$term} = [ @aList ];
 
}
 
}
 
if ( @termList ) {
 
if ( @termList ) {
print " * courses archived:\n";
+
print " * courses archived:\n";
my $numListed = 0;
+
my $numListed = 0;
foreach my $term ( @termList ) {
+
foreach my $term ( @termList ) {
print " $term:",
+
print " $term:",
hangIndent(9,75,9,join(', ', @{$archiveList{$term}})), "\n";
+
hangIndent(9,75,9,join(', ', @{$archiveList{$term}})), "\n";
$numListed += @{$archiveList{$term}};
+
$numListed += @{$archiveList{$term}};
}
+
}
if ( $numListed > 100 ) {
+
if ( $numListed > 100 ) {
print " [cr to continue]";
+
print " [cr to continue]";
my $pause = <STDIN>;
+
my $pause = <STDIN>;
}
+
}
 
} else {
 
} else {
print " * no archived courses to list *\n";
+
print " * no archived courses to list *\n";
 
}
 
}
 
print "\n";
 
print "\n";
Line 404: Line 458:
 
# generate a list of courses by looking in the course directory in
 
# generate a list of courses by looking in the course directory in
 
# the webwork install
 
# the webwork install
my @courses = `/bin/ls -dF $wwHome/courses/*`;
+
my @courses = `/bin/ls -dF $wwCourseDir/*`;
 
foreach my $courseName ( @courses ) {
 
foreach my $courseName ( @courses ) {
next if ( $courseName !~ /\/$/ || $courseName =~ /CVS/ );
+
next if ( $courseName !~ /\/$/ || $courseName =~ /CVS/ );
chomp($courseName);
+
chomp($courseName);
$courseName =~ s/.*\/([^\/]+)\/$/$1/;
+
$courseName =~ s/.*\/([^\/]+)\/$/$1/;
my $cNum = '';
+
my $cNum = '';
my $sNum = '';
+
my $sNum = '';
if ( $courseName =~ /^ma(\d{3})-(.+)$/i ) {
+
if ( $courseName =~ /^ma(\d{3})-(.+)$/i ) {
$cNum = $1;
+
$cNum = $1;
$sNum = $2;
+
$sNum = $2;
} elsif ( $courseName =~ /^ma(\d{3})[fwsu]\d{2}$/ ) {
+
} elsif ( $courseName =~ /^ma(\d{3})[fwsu]\d{2}$/ ) {
$cNum = $1;
+
$cNum = $1;
$sNum = 'all';
+
$sNum = 'all';
} else {
+
} else {
$cNum = $courseName;
+
$cNum = $courseName;
$sNum = '001';
+
$sNum = '001';
}
+
}
 
# save the class information if it has the correct course
 
# save the class information if it has the correct course
 
# number
 
# number
$cl{ $courseName } = [ $cNum, $sNum ]
+
$cl{ $courseName } = [ $cNum, $sNum ]
if ( $crsNum eq 'any' || $cNum eq $crsNum );
+
if ( $crsNum eq 'any' || $cNum eq $crsNum );
 
}
 
}
 
return %cl;
 
return %cl;
Line 445: Line 499:
 
my @delList = getList($delStr, scalar(@classes));
 
my @delList = getList($delStr, scalar(@classes));
 
while ( ! @delList ) {
 
while ( ! @delList ) {
print " * archive, delete which (0 to abort|n1,n2-n3,n4)> ";
+
print " * archive, delete which (0 to abort|n1,n2-n3,n4)> ";
chomp($delStr = <STDIN>);
+
chomp($delStr = <STDIN>);
@delList = getList( $delStr, scalar(@classes) );
+
@delList = getList( $delStr, scalar(@classes) );
 
}
 
}
 
# case of abort delete
 
# case of abort delete
Line 460: Line 514:
 
my %dbOpts = ();
 
my %dbOpts = ();
 
foreach my $cl ( @delClasses ) {
 
foreach my $cl ( @delClasses ) {
my $ce = WeBWorK::CourseEnvironment->new( { webwork_dir=>$wwHome,
+
my $ce = WeBWorK::CourseEnvironment->new( { webwork_dir=>$wwHome,
courseName=>$cl } );
+
courseName=>$cl } );
push( @options, { courseID => $cl, ce => $ce, dbOptions => \%dbOpts } );
+
push( @options, { courseID => $cl, ce => $ce, dbOptions => \%dbOpts } );
 
}
 
}
 
 
 
# make sure we have the correct archive term
 
# make sure we have the correct archive term
print " * archive term [$curTerm] > ";
 
  +
my $arTerm = '';
my $arTerm = <STDIN>;
+
my $guessTerm = $curTerm;
  +
if ( $delClasses[0] =~ /-([fwsu][0-9][0-9])/ ) {
  +
$guessTerm = uc($1);
  +
}
  +
print " * archive term [$guessTerm] > ";
  +
$arTerm = <STDIN>;
 
chomp($arTerm);
 
chomp($arTerm);
if ( $arTerm eq '' ) { $arTerm = $curTerm; }
+
if ( $arTerm eq '' ) { $arTerm = $guessTerm; }
 
 
 
my $clstring = hangIndent(8,60,0,join(', ', @delClasses));
 
my $clstring = hangIndent(8,60,0,join(', ', @delClasses));
 
print " * ready to archive and delete classes\n ",
 
print " * ready to archive and delete classes\n ",
$clstring, "\n * abort? ([cr] = no) > ";
+
$clstring, "\n * abort? ([cr] = no) > ";
 
my $ans = <STDIN>;
 
my $ans = <STDIN>;
 
chomp( $ans );
 
chomp( $ans );
Line 481: Line 535:
 
print " * archiving courses: ";
 
print " * archiving courses: ";
 
foreach my $opt ( @options ) {
 
foreach my $opt ( @options ) {
print $opt->{courseID}, "..";
+
print $opt->{courseID}, "..";
eval { WeBWorK::Utils::CourseManagement::archiveCourse(%$opt); };
+
eval { WeBWorK::Utils::CourseManagement::archiveCourse(%$opt); };
if ( $@ ) {
+
if ( $@ ) {
my $error = $@;
+
my $error = $@;
print STDERR "$error\n";
+
print STDERR "$error\n";
exit;
+
exit;
}
+
}
push( @archives, $opt->{courseID} . ".tar.gz" );
+
push( @archives, $opt->{courseID} . ".tar.gz" );
 
}
 
}
 
print "done.\n * moving archive files to archive directory: ";
 
print "done.\n * moving archive files to archive directory: ";
 
my $saveDir = $archiveDir;
 
my $saveDir = $archiveDir;
 
if ( ! -d "$archiveDir/$arTerm" ) {
 
if ( ! -d "$archiveDir/$arTerm" ) {
$saveDir = "$archiveDir/$arTerm" if ( mkdir "$archiveDir/$arTerm" );
+
$saveDir = "$archiveDir/$arTerm" if ( mkdir "$archiveDir/$arTerm" );
 
} else {
 
} else {
$saveDir = "$archiveDir/$arTerm";
+
$saveDir = "$archiveDir/$arTerm";
 
}
 
}
 
foreach ( @archives ) {
 
foreach ( @archives ) {
if ( rename( "$wwCourseDir/$_", "$saveDir/$_" ) ) {
+
if ( rename( "$wwCourseDir/$_", "$saveDir/$_" ) ) {
print ".";
+
print ".";
} else {
+
} else {
print STDERR " * ERROR moving $_\n";
+
print STDERR " * ERROR moving $_\n";
}
+
}
 
}
 
}
 
 
 
print "done.\n * deleting courses: ";
 
print "done.\n * deleting courses: ";
 
foreach my $opt ( @options ) {
 
foreach my $opt ( @options ) {
print $opt->{courseID}, "..";
+
print $opt->{courseID}, "..";
eval { WeBWorK::Utils::CourseManagement::deleteCourse(%$opt); };
+
eval { WeBWorK::Utils::CourseManagement::deleteCourse(%$opt); };
if ( $@ ) {
+
if ( $@ ) {
my $error = $@;
+
my $error = $@;
print STDERR "$error\n";
+
print STDERR "$error\n";
exit;
+
exit;
}
+
}
 
}
 
}
 
print "\n * done\n";
 
print "\n * done\n";
Line 536: Line 590:
 
if ( @adds ) {
 
if ( @adds ) {
 
# go through and make a list of added course fields
 
# go through and make a list of added course fields
my %addClasses = (); # $addClasses{105-001} = [ @adds_fields ]
+
my %addClasses = (); # $addClasses{105-001} = [ @adds_fields ]
 
# a list of the courses these are associated with
 
# a list of the courses these are associated with
my @addCourseList = ();
+
my @addCourseList = ();
 
 
my $crsNum = '';
+
my $crsNum = '';
foreach ( sort @adds ) {
+
foreach ( sort @adds ) {
# @fields = 116,003,glarose,LaRose,Gavin,[Middle],12345678,password
+
# @fields = 116,003,glarose,LaRose,Gavin,[Middle],23860714,password
 
# note quotes are stripped in getAddCourses
 
# note quotes are stripped in getAddCourses
my @fields = split(/[,\t]/);
+
my @fields = split(/[,\t]/);
$fields[1] = sprintf("%03d", $fields[1]); # get to 00x
+
$fields[1] = sprintf("%03d", $fields[1]); # get to 00x
chomp($fields[-1]);
+
chomp($fields[-1]);
# promote id to password if we didn't get the password field
+
# promote id to password if we didn't get the password field
if ( @fields < 8 ) { $fields[7] = $fields[6]; }
+
if ( @fields < 8 ) { $fields[7] = $fields[6]; }
 
 
$addClasses{"$fields[0]-$fields[1]"} = [ @fields ];
+
$addClasses{"$fields[0]-$fields[1]"} = [ @fields ];
 
 
$crsNum = $fields[0] if ( ! $crsNum );
+
$crsNum = $fields[0] if ( ! $crsNum );
 
 
push( @addCourseList, $crsNum )
+
push( @addCourseList, $crsNum )
if ( ! grep(/^$crsNum$/, @addCourseList ) );
+
if ( ! grep(/^$crsNum$/, @addCourseList ) );
}
+
}
 
 
my %options = ( );
+
my %options = ( );
 
 
 
# now we need to get the users file lists...
 
# now we need to get the users file lists...
my $ext = 0;
+
my $ext = 0;
my %fileNames = buildUserLists( \%addClasses, $fileExt );
+
my %fileNames = buildUserLists( \%addClasses, $fileExt );
 
 
 
# figure out if we're adding any coordinators to these
 
# figure out if we're adding any coordinators to these
my %addCoordUsers = ();
+
my %addCoordUsers = ();
print " * got user lists for course adds\n";
+
print " * got user lists for course adds\n";
foreach my $c ( @addCourseList ) {
+
foreach my $c ( @addCourseList ) {
print " * add course coordinator to $c [uniq|n|N to all] > ";
+
print " * add course coordinator to $c [uniq|n|N to all] > ";
my $u = <STDIN>;
+
my $u = <STDIN>;
chomp($u);
+
chomp($u);
if ( $u eq 'N' ) {
+
if ( $u eq 'N' ) {
last;
+
last;
} elsif ( $u eq 'n' ) {
+
} elsif ( $u eq 'n' ) {
next;
+
next;
} else {
+
} else {
if ( grep( /^$u$/, ( map { $addClasses{$_}->[2] }
+
if ( grep( /^$u$/, ( map { $addClasses{$_}->[2] }
keys( %addClasses ) ) ) ) {
+
keys( %addClasses ) ) ) ) {
my ( $csu ) = grep( /^$c-\d{3}$u$/,
+
my ( $csu ) = grep( /^$c-\d{3}$u$/,
( map { $_ . $addClasses{$_}->[2] }
+
( map { $_ . $addClasses{$_}->[2] }
keys( %addClasses ) ) );
+
keys( %addClasses ) ) );
$csu =~ s/$u$//;
+
$csu =~ s/$u$//;
my @dat = @{ $addClasses{$csu} };
+
my @dat = @{ $addClasses{$csu} };
$addCoordUsers{$c} = [ @dat ];
+
$addCoordUsers{$c} = [ @dat ];
} else {
+
} else {
print " * coordinator data: Last,First,Middle,ID# > ";
+
print " * coordinator data: Last,First,Middle,ID# > ";
my $dat = <STDIN>;
+
my $dat = <STDIN>;
chomp($dat);
+
chomp($dat);
$addCoordUsers{$c} = [ $c, '000', $u, split(/,\s*/, $dat) ];
+
$addCoordUsers{$c} = [ $c, '000', $u, split(/,\s*/, $dat) ];
}
+
}
}
+
}
}
+
}
 
 
 
 
# this returns $fileNames{ crs-sxn } = userlist filename
 
# this returns $fileNames{ crs-sxn } = userlist filename
 
# abort if we had an error
 
# abort if we had an error
return 0 if ( defined( $fileNames{Error} ) && $fileNames{Error} );
+
return 0 if ( defined( $fileNames{Error} ) && $fileNames{Error} );
 
 
 
# all set now: we can go ahead and invoke the addcourse script
 
# all set now: we can go ahead and invoke the addcourse script
print " * ready to add classes. [cr] to continue > ";
+
print " * ready to add classes. [cr] to continue > ";
my $ans = <STDIN>;
+
my $ans = <STDIN>;
print " * adding courses: ";
+
print " * adding courses: ";
 
 
## do we have a course or e-mail domain extension?
+
## do we have a course or e-mail domain extension?
my $crsExt = '';
+
my $crsExt = '';
my $domExt = '';
+
my $domExt = '';
if ( $fileExt ) {
+
if ( $fileExt ) {
foreach ( my $i=0; $i<@fileCampusExt; $i++ ) {
+
foreach ( my $i=0; $i<@fileCampusExt; $i++ ) {
if ( $fileExt eq $fileCampusExt[$i] ) {
+
if ( $fileExt eq $fileCampusExt[$i] ) {
$crsExt = $courseCampusExt[$i];
+
$crsExt = $courseCampusExt[$i];
$domExt = $crsExt;
+
# $domExt = $crsExt;
$domExt =~ s/^-(.+)/$1\./;
+
# $domExt =~ s/^-(.+)/$1\./;
last;
+
last;
}
+
}
}
+
}
}
+
}
 
 
foreach my $cs ( sort keys %addClasses ) {
+
foreach my $cs ( sort keys %addClasses ) {
print "$cs..";
+
print "$cs..";
# in the long run, we probably want the term, too
+
my $courseID = "ma${cs}${crsExt}-$newTerm";
my $courseID = "ma${cs}${crsExt}-$newTerm";
+
# my $courseID = "ma${cs}";
# my $courseID = "ma${cs}";
+
$courseID = lc($courseID);
$courseID = lc($courseID);
 
 
 
my $instrUniq = $addClasses{$cs}->[2];
+
my $instrUniq = $addClasses{$cs}->[2];
my $instrIdnum = $addClasses{$cs}->[6];
+
my $instrIdnum = $addClasses{$cs}->[6];
 
 
 
# get a minimal course environment and hack to get record formats
 
# get a minimal course environment and hack to get record formats
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir=>$wwHome,
+
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir=>$wwHome,
courseName=>$courseID});
+
courseName=>$courseID});
my $dbLayout = $ce->{dbLayoutName};
+
my $dbLayout = $ce->{dbLayoutName};
my %courseOptions = ( dbLayoutName => $dbLayout );
+
my %courseOptions = ( dbLayoutName => $dbLayout );
my $userCl = $ce->{dbLayouts}->{$dbLayout}->{user}->{record};
+
my $userCl = $ce->{dbLayouts}->{$dbLayout}->{user}->{record};
my $passCl = $ce->{dbLayouts}->{$dbLayout}->{password}->{record};
+
my $passCl = $ce->{dbLayouts}->{$dbLayout}->{password}->{record};
my $permCl = $ce->{dbLayouts}->{$dbLayout}->{permission}->{record};
+
my $permCl = $ce->{dbLayouts}->{$dbLayout}->{permission}->{record};
 
 
my @users = ();
+
my @users = ();
my ($sxn, $rcn);
+
my ($sxn, $rcn);
foreach my $uline ( `/bin/cat $fileNames{$cs}` ) {
+
foreach my $uline ( `/bin/cat $fileNames{$cs}` ) {
my %urec;
+
my %urec;
my $userId;
+
my $userId;
my $passWd;
+
my $passWd;
my @fields = csvSplit( $uline );
+
my @fields = csvSplit( $uline );
 
 
if ( $saveWWrosters ) {
+
if ( $saveWWrosters ) {
# lines are
+
# lines are
# 12345678 , Last , First ,C , , CRS ,SXN , email , uniq
+
# 12345678 , Last , First ,C , , CRS ,SXN , email , uniq
 
 
# this is cribbed from addcourse, and includes extra fields from
+
# this is cribbed from addcourse, and includes extra fields from
# there. note that the userlist we get from the file does not
+
# there. note that the userlist we get from the file does not
# include the professor; we add that user below
+
# include the professor; we add that user below
my $email = ( $fields[7] =~ /@/ ) ? $fields[7] :
+
my $email = ( $fields[7] =~ /@/ ) ? $fields[7] :
"$fields[7]\@${domExt}$mailDomain";
+
"$fields[7]\@${domExt}$mailDomain";
%urec = ( 'student_id' => $fields[0],
+
%urec = ( 'student_id' => $fields[0],
'last_name' => $fields[1],
+
'last_name' => $fields[1],
'first_name' => $fields[2],
+
'first_name' => $fields[2],
'status' => 'C',
+
'status' => 'C',
'comment' => '',
+
'comment' => '',
'section' => $fields[5],
+
'section' => $fields[5],
'recitation' => $fields[6],
+
'recitation' => $fields[6],
'email_address' => $email,
+
'email_address' => $email,
'user_id' => $fields[8],
+
'user_id' => $fields[8],
'password' => $fields[0],
+
'password' => $fields[0],
'permission' => 0 );
+
'permission' => 0 );
$userId = $fields[8];
+
$userId = $fields[8];
$passWd = $fields[0];
+
$passWd = $fields[0];
} else {
+
} else {
# lines are
+
# lines are
# CRS,SXN,uniq,Last,First Middle,12345678
+
# CRS,SXN,uniq,Last,First Middle,12345678
%urec = ( 'student_id' => $fields[5],
+
%urec = ( 'student_id' => $fields[5],
'last_name' => $fields[3],
+
'last_name' => $fields[3],
'first_name' => $fields[4],
+
'first_name' => $fields[4],
'status' => 'C',
+
'status' => 'C',
'comment' => '',
+
'comment' => '',
'section' => $fields[1],
+
'section' => $fields[1],
'recitation' => $fields[1],
+
'recitation' => $fields[1],
'email_address' => "$fields[2]\@${domExt}$mailDomain",
+
'email_address' => "$fields[2]\@${domExt}$mailDomain",
'user_id' => $fields[2],
+
'user_id' => $fields[2],
'password' => $fields[5],
+
'password' => $fields[5],
'permission' => 0 );
+
'permission' => 0 );
$userId = $fields[2];
+
$userId = $fields[2];
$passWd = $fields[5];
+
$passWd = $fields[5];
}
+
}
 
 
my $User = new $userCl( %urec );
+
my $User = new $userCl( %urec );
my $plevel = 0;
+
my $plevel = 0;
if ( $userId eq $instrUniq ) {
+
if ( $userId eq $instrUniq ) {
$plevel = 5;
+
$plevel = 5;
} elsif ( $userId eq $adminUser ) {
+
} elsif ( $userId eq $adminUser ) {
$plevel = 10;
+
$plevel = 10;
}
+
}
my $PermLevel = new $permCl( user_id=>$userId,
+
my $PermLevel = new $permCl( user_id=>$userId,
permission=>$plevel );
+
permission=>$plevel );
my $Password = new $passCl( user_id=>$userId,
+
my $Password = new $passCl( user_id=>$userId,
password=>cryptPass($passWd) );
+
password=>cryptPass($passWd) );
push( @users, [ $User, $Password, $PermLevel ] );
+
push( @users, [ $User, $Password, $PermLevel ] );
 
 
}
+
}
 
 
my $addedCampusAdmin = 0;
+
my $addedCampusAdmin = 0;
 
 
if ( ! $saveWWrosters ) {
 
  +
my $emDomain;
## also add the admin user and instructor, because they
 
  +
if ( ! $saveWWrosters ) {
## haven't been created in the course of the
 
  +
## also add the admin user and instructor, because they
## buildUserLists routine
 
  +
## haven't been created in the course of the
  +
## buildUserLists routine
 
 
my $plevel = ($instrUniq eq $adminUser || $crsExt) ? 10 : 5;
+
my $plevel = ($instrUniq eq $adminUser || $crsExt) ? 10 : 5;
if ( $crsExt && $instrUniq eq $courseCampusAdmins{$crsExt}->{user_id} ) {
+
if ( $crsExt && $instrUniq eq $courseCampusAdmins{$crsExt}->{user_id} ) {
$plevel = 10;
+
$plevel = 10;
$addedCampusAdmin = 1;
+
$addedCampusAdmin = 1;
}
+
}
 
 
my $User = new $userCl( ( 'student_id' => $instrIdnum,
 
  +
$emDomain = "${domExt}$mailDomain";
'last_name' => $addClasses{$cs}->[3],
 
  +
my $User = new $userCl( ( 'student_id' => $instrIdnum,
'first_name' => $addClasses{$cs}->[4],
+
'last_name' => $addClasses{$cs}->[3],
'status' => 'C',
+
'first_name' => $addClasses{$cs}->[4],
'comment' => '',
+
'status' => 'C',
'section' => $addClasses{$cs}->[1],
+
'comment' => '',
'recitation' => $addClasses{$cs}->[1],
+
'section' => $addClasses{$cs}->[1],
'email_address' => "$instrUniq\@$mailDomain",
+
'recitation' => $addClasses{$cs}->[1],
'user_id' => $instrUniq,
+
'email_address' => "$instrUniq\@$emDomain",
'password' => $instrIdnum,
+
'user_id' => $instrUniq,
'permission' => $plevel ) );
+
'password' => $instrIdnum,
my $PermLevel = new $permCl( user_id => $instrUniq,
+
'permission' => $plevel ) );
permission => $plevel );
+
my $PermLevel = new $permCl( user_id => $instrUniq,
my $Password = new $passCl(user_id => $instrUniq,
+
permission => $plevel );
password => cryptPass($instrIdnum));
+
my $Password = new $passCl(user_id => $instrUniq,
push( @users, [ $User, $Password, $PermLevel ] );
+
password => cryptPass($instrIdnum));
  +
push( @users, [ $User, $Password, $PermLevel ] );
 
 
if ( $instrUniq ne $adminUser ) {
+
if ( $instrUniq ne $adminUser ) {
$User = new $userCl( ( 'student_id' => $adminID,
+
$User = new $userCl( ( 'student_id' => $adminID,
'last_name' => $adminLname,
+
'last_name' => $adminLname,
'first_name' => $adminFname,
+
'first_name' => $adminFname,
'status' => 'C',
+
'status' => 'C',
'comment' => '',
+
'comment' => '',
'section' => '',
+
'section' => '',
'recitation' => '',
+
'recitation' => '',
'email_address' => "$adminUser\@$mailDomain",
+
'email_address' => "$adminUser\@$emDomain",
'user_id' => $adminUser,
+
'user_id' => $adminUser,
'password' => $adminID,
+
'password' => $adminID,
'permission' => 10 ) );
+
'permission' => 10 ) );
$PermLevel = new $permCl( user_id => $adminUser,
+
$PermLevel = new $permCl( user_id => $adminUser,
permission => 10 );
+
permission => 10 );
$Password = new $passCl( user_id => $adminUser,
+
$Password = new $passCl( user_id => $adminUser,
password => cryptPass($adminID));
+
password => cryptPass($adminID));
push( @users, [ $User, $Password, $PermLevel ] );
+
push( @users, [ $User, $Password, $PermLevel ] );
}
+
}
 
 
my ( $c, $s ) = split( /-/, $cs );
+
my ( $c, $s ) = split( /-/, $cs );
if ( defined( $addCoordUsers{$c} ) &&
+
if ( defined( $addCoordUsers{$c} ) &&
$instrUniq ne $addCoordUsers{$c}->[2] ) {
+
$instrUniq ne $addCoordUsers{$c}->[2] ) {
my $cUser = new $userCl(
+
my $cUser = new $userCl(
( 'student_id' => $addCoordUsers{$c}->[6],
+
( 'student_id' => $addCoordUsers{$c}->[6],
'last_name' => $addCoordUsers{$c}->[3],
+
'last_name' => $addCoordUsers{$c}->[3],
'first_name' => join(' ', ($addCoordUsers{$c}->[4],
+
'first_name' => join(' ', ($addCoordUsers{$c}->[4],
$addCoordUsers{$c}->[5])),
+
$addCoordUsers{$c}->[5])),
'status' => 'C',
+
'status' => 'C',
'comment' => '',
+
'comment' => '',
'section' => '',
+
'section' => '',
'recitation' => '',
+
'recitation' => '',
'email_address' => $addCoordUsers{$c}->[2] .
+
'email_address' => $addCoordUsers{$c}->[2] .
"\@$mailDomain",
+
"\@$emDomain",
'user_id' => $addCoordUsers{$c}->[2],
+
'user_id' => $addCoordUsers{$c}->[2],
'password' => $addCoordUsers{$c}->[6],
+
'password' => $addCoordUsers{$c}->[6],
'permission' => 10 ) );
+
'permission' => 10 ) );
my $cPermLevel = new $permCl(
+
my $cPermLevel = new $permCl(
user_id => $addCoordUsers{$c}->[2],
+
user_id => $addCoordUsers{$c}->[2],
permission => 10 );
+
permission => 10 );
my $cPassword = new $passCl(
+
my $cPassword = new $passCl(
user_id => $addCoordUsers{$c}->[2],
+
user_id => $addCoordUsers{$c}->[2],
password => cryptPass($adminID));
+
password => cryptPass($adminID));
push( @users, [ $cUser, $cPassword, $cPermLevel ] );
+
push( @users, [ $cUser, $cPassword, $cPermLevel ] );
}
+
}
 
 
}
+
}
 
 
## furthermore, we have to add any campus administrator
+
## furthermore, we have to add any campus administrator
## if there should be such a beast. this is really a bit
+
## if there should be such a beast. this is really a bit
## too convoluted.
+
## too convoluted.
if ( $crsExt && ! $addedCampusAdmin ) {
+
if ( $crsExt && ! $addedCampusAdmin ) {
my $User = new $userCl(
+
my $User = new $userCl(
( 'student_id' => $courseCampusAdmins{$crsExt}->{student_id},
+
( 'student_id' => $courseCampusAdmins{$crsExt}->{student_id},
'last_name' => $courseCampusAdmins{$crsExt}->{last_name},
+
'last_name' => $courseCampusAdmins{$crsExt}->{last_name},
'first_name' => $courseCampusAdmins{$crsExt}->{first_name},
+
'first_name' => $courseCampusAdmins{$crsExt}->{first_name},
'status' => 'C',
+
'status' => 'C',
'comment' => '',
+
'comment' => '',
'section' => $addClasses{$cs}->[1],
+
'section' => $addClasses{$cs}->[1],
'recitation' => $addClasses{$cs}->[1],
+
'recitation' => $addClasses{$cs}->[1],
'email_address' => $courseCampusAdmins{$crsExt}->{user_id} . "\@$mailDomain",
+
'email_address' => $courseCampusAdmins{$crsExt}->{user_id} . "\@$emDomain",
'user_id' => $courseCampusAdmins{$crsExt}->{user_id},
+
'user_id' => $courseCampusAdmins{$crsExt}->{user_id},
'password' => $courseCampusAdmins{$crsExt}->{student_id},
+
'password' => $courseCampusAdmins{$crsExt}->{student_id},
'permission' => 10 ) );
+
'permission' => 10 ) );
my $PermLevel = new $permCl( user_id => $courseCampusAdmins{$crsExt}->{user_id},
+
my $PermLevel = new $permCl( user_id => $courseCampusAdmins{$crsExt}->{user_id},
permission => 10 );
+
permission => 10 );
my $Password = new $passCl(user_id => $courseCampusAdmins{$crsExt}->{user_id},
+
my $Password = new $passCl(user_id => $courseCampusAdmins{$crsExt}->{user_id},
password => cryptPass($courseCampusAdmins{$crsExt}->{student_id}));
+
password => cryptPass($courseCampusAdmins{$crsExt}->{student_id}));
push( @users, [ $User, $Password, $PermLevel ] );
+
push( @users, [ $User, $Password, $PermLevel ] );
}
+
}
 
 
# ok, now go ahead and add
+
# ok, now go ahead and add
eval( WeBWorK::Utils::CourseManagement::addCourse(
+
eval( WeBWorK::Utils::CourseManagement::addCourse(
courseID => $courseID,
+
courseID => $courseID,
ce => $ce,
+
ce => $ce,
courseOptions => \%courseOptions,
+
courseOptions => \%courseOptions,
dbOptions => { },
+
dbOptions => { },
users => \@users,
+
users => \@users,
%options
+
%options
));
+
));
if ( $@ ) {
+
if ( $@ ) {
my $error = $@;
+
my $error = $@;
print STDERR "$error\n";
+
print STDERR "$error\n";
exit;
+
exit;
}
+
}
 
 
 
# edit file name printing
 
# edit file name printing
my $printfor = "\$pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES" .
+
my $printfor = "\$pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES" .
"_FOR} = ['$adminUser','" . $addClasses{$cs}->[2]. "'];\n\n";
+
"_FOR} = ['$adminUser','" . $addClasses{$cs}->[2]. "'];\n";
my @confFile = `/bin/cat $wwHome/courses/$courseID/course.conf`;
+
if ( defined( $courseConfAdditions{$crsExt} ) ) {
my $cFile = join('', @confFile);
+
$printfor .= $courseConfAdditions{$crsExt};
# $cFile =~ s/^(\#\s*\S+PRINT_FILE_NAMES_FOR.*)$/$1\n$printfor/s;
+
}
$cFile .= $printfor;
+
my @confFile = `/bin/cat $wwHome/courses/$courseID/course.conf`;
if ( open(OF, ">$wwHome/courses/$courseID/course.conf") ) {
+
my $cFile = join('', @confFile);
print OF $cFile;
+
# $cFile =~ s/^(\#\s*\S+PRINT_FILE_NAMES_FOR.*)$/$1\n$printfor/s;
close(OF);
+
$cFile .= $printfor;
} else {
+
if ( open(OF, ">$wwHome/courses/$courseID/course.conf") ) {
warn(" ** error writing conf file for course $courseID\n");
+
print OF $cFile;
}
+
close(OF);
# and finally make sure that all of the files have the right user and group
+
} else {
system("/bin/chown", "-R", "$htuser:$htgroup",
+
warn(" ** error writing conf file for course $courseID\n");
"$wwHome/courses/$courseID");
+
}
}
+
# and make sure that all of the files have the right user and group
  +
system("/bin/chown", "-R", "$htuser:$htgroup",
  +
"$wwHome/courses/$courseID");
  +
# lastly, make sure that the appropriate links exist in the templates
  +
# directory of the created course
  +
foreach my $lk ( keys( %templateDirLinks ) ) {
  +
system( "/bin/ln", "-s" , $templateDirLinks{$lk},
  +
"$wwHome/courses/$courseID/templates/$lk" );
  +
}
  +
}
 
} else {
 
} else {
print " ** no courses specified to add *\n";
+
print " ** no courses specified to add *\n";
return 0;
+
return 0;
 
}
 
}
 
}
 
}
Line 851: Line 906:
 
 
 
if ( $ans ) {
 
if ( $ans ) {
my $default = '';
+
my $default = '';
$default = "[$instrFile] "
+
$default = "[$instrFile] "
if ( -f $instrFile || -f "$dataDir/$instrFile" );
+
if ( -f $instrFile || -f "$dataDir/$instrFile" );
 
 
print " file giving courses to add (format: crs,sxn,uniq,lname," .
+
print " file giving courses to add (format: crs,sxn,uniq,lname," .
"fname mname,id,passwd\n comma or tab separated) $default> ";
+
"fname mname,id,passwd\n comma or tab separated) $default> ";
my $file = <STDIN>;
+
my $file = <STDIN>;
chomp($file);
+
chomp($file);
if ( ! $file && $default ) {
+
if ( ! $file && $default ) {
$file = $instrFile;
+
$file = $instrFile;
} else {
+
} else {
while ( ! -f $file && ! -f "$dataDir/$file" ) {
+
while ( ! -f $file && ! -f "$dataDir/$file" ) {
print " can't locate file $file; file > ";
+
print " can't locate file $file; file > ";
chomp($file = <STDIN>);
+
chomp($file = <STDIN>);
}
+
}
}
+
}
 
 
# check for special file names
+
# check for special file names
foreach my $campExt ( @fileCampusExt ) {
+
foreach my $campExt ( @fileCampusExt ) {
if ( $file =~ /$campExt\./ ) {
+
if ( $file =~ /$campExt\./ ) {
$fileExt = $campExt;
+
$fileExt = $campExt;
last;
+
last;
}
+
}
}
+
}
 
 
$file = "$dataDir/$file" if ( ! -f $file );
+
$file = "$dataDir/$file" if ( ! -f $file );
 
 
@adds = `/bin/cat $file`;
+
@adds = `/bin/cat $file`;
@adds = modifyEntries(\@adds);
+
@adds = modifyEntries(\@adds);
 
# we assume that the passwords are provided at this point
 
# we assume that the passwords are provided at this point
# addPasswords(\@adds);
+
# addPasswords(\@adds);
die(" ** error: can't read $file\n") if ( ! @adds );
+
die(" ** error: can't read $file\n") if ( ! @adds );
print "\n";
+
print "\n";
 
} else {
 
} else {
my $confirm = 0;
+
my $confirm = 0;
while ( ! $confirm ) {
+
while ( ! $confirm ) {
print " course-section to add (e.g., 115-021) > ";
+
print " course-section to add (e.g., 115-021) > ";
my $cs = <STDIN>;
+
my $cs = <STDIN>;
chomp($cs);
+
chomp($cs);
print " instructor uniqname > ";
+
print " instructor uniqname > ";
my $uniq = <STDIN>;
+
my $uniq = <STDIN>;
chomp($uniq);
+
chomp($uniq);
print " instructor name ( First, MI, Last ) > ";
+
print " instructor name ( First, MI, Last ) > ";
my $name = <STDIN>;
+
my $name = <STDIN>;
chomp($name);
+
chomp($name);
my ($fname, $mi, $lname) = split(/,\s*/,$name);
+
my ($fname, $mi, $lname) = split(/,\s*/,$name);
my $continue = 0;
+
my $continue = 0;
my ($passwd, $passwd1, $passwd2);
+
my ($passwd, $passwd1, $passwd2);
while ( ! $continue ) {
+
while ( ! $continue ) {
print " course password > ";
+
print " course password > ";
system('/usr/bin/stty -echo');
+
system('/usr/bin/stty -echo');
chomp($passwd1 = <STDIN>);
+
chomp($passwd1 = <STDIN>);
print "\n";
+
print "\n";
system('/usr/bin/stty echo');
+
system('/usr/bin/stty echo');
print " again > ";
+
print " again > ";
system('/usr/bin/stty -echo');
+
system('/usr/bin/stty -echo');
chomp($passwd2 = <STDIN>);
+
chomp($passwd2 = <STDIN>);
print "\n";
+
print "\n";
system('/usr/bin/stty echo');
+
system('/usr/bin/stty echo');
if ( $passwd1 eq $passwd2 ) {
+
if ( $passwd1 eq $passwd2 ) {
chomp($passwd = $passwd1);
+
chomp($passwd = $passwd1);
$continue = 1;
+
$continue = 1;
} else {
+
} else {
print " passwords don't match. again: \n";
+
print " passwords don't match. again: \n";
}
+
}
}
+
}
if ( $cs eq '' ) {
+
if ( $cs eq '' ) {
warn " ** error: empty class specified *\n";
+
warn " ** error: empty class specified *\n";
return( () );
+
return( () );
}
+
}
print " adding course math $cs, taught by $name ($uniq)\n";
+
print " adding course math $cs, taught by $name ($uniq)\n";
my ( $crs, $sxn ) = split(/-/, $cs);
+
my ( $crs, $sxn ) = split(/-/, $cs);
$adds[0] = "$crs,$sxn,$uniq,$lname,$fname,$mi,$passwd\n";
+
$adds[0] = "$crs,$sxn,$uniq,$lname,$fname,$mi,$passwd\n";
}
+
}
 
}
 
}
 
return \@adds, $fileExt;
 
return \@adds, $fileExt;
Line 937: Line 992:
 
my $addRef = shift;
 
my $addRef = shift;
 
# for ( my $i=0; $i<@$addRef; $i++ ) {
 
# for ( my $i=0; $i<@$addRef; $i++ ) {
# my @ent = split(/,/, $addRef->[$i]);
+
# my @ent = split(/,/, $addRef->[$i]);
# for ( my $j=0; $j<@ent; $j++ ) {
+
# for ( my $j=0; $j<@ent; $j++ ) {
# chomp($ent[$j]);
+
# chomp($ent[$j]);
# $ent[$j] =~ s/^"(.*)"$/$1/; # this is subtle
+
# $ent[$j] =~ s/^"(.*)"$/$1/; # this is subtle
# $ent[$j] =~ s/"//g; #" # this is the brute force version
+
# $ent[$j] =~ s/"//g; #" # this is the brute force version
# }
+
# }
# $addRef->[$i]=join(',', @ent);
+
# $addRef->[$i]=join(',', @ent);
 
# }
 
# }
 
 
 
for ( my $i=0; $i<@{$addRef}; $i++ ) {
 
for ( my $i=0; $i<@{$addRef}; $i++ ) {
$addRef->[$i] =~ s/"//g; #"
+
$addRef->[$i] =~ s/"//g; #"
$addRef->[$i] =~ s/[^\w,]/ /g;
+
$addRef->[$i] =~ s/[^\w,]/ /g;
$addRef->[$i] =~ s/\s*$//;
+
$addRef->[$i] =~ s/\s*$//;
 
}
 
}
 
# chomp($addRef->[scalar(@{$addRef})]);
 
# chomp($addRef->[scalar(@{$addRef})]);
Line 961: Line 1,016:
 
my @newEnt = ();
 
my @newEnt = ();
 
for ( my $i=0; $i<@$addRef; $i++ ) {
 
for ( my $i=0; $i<@$addRef; $i++ ) {
next if (! $addRef->[$i]);
+
next if (! $addRef->[$i]);
my @fields = split(/,/, $addRef->[$i]);
+
my @fields = split(/,/, $addRef->[$i]);
my ($fname, $mi) = ($fields[4] =~ /(.*)\s+(\S+)$/);
+
my ($fname, $mi) = ($fields[4] =~ /(.*)\s+(\S+)$/);
if ( ! defined($fname) || ! $fname ) {
+
if ( ! defined($fname) || ! $fname ) {
$fname = $fields[4]; $mi = ''; # using ' ' relies on edu taking
+
$fname = $fields[4]; $mi = ''; # using ' ' relies on edu taking
} # all spaces as a field separator
+
} # all spaces as a field separator
$fname =~ s/\s*//g; # get rid of spaces in names
+
$fname =~ s/\s*//g; # get rid of spaces in names
$fields[3] =~ s/\s*//g;
+
$fields[3] =~ s/\s*//g;
push( @newEnt, join(',', ( @fields[0..3], $fname, $mi, $fields[5] )) );
+
push( @newEnt, join(',', ( @fields[0..3], $fname, $mi, $fields[5] )) );
$newEnt[-1] .= ",$fields[6]" if ( @fields == 7 );
+
$newEnt[-1] .= ",$fields[6]" if ( @fields == 7 );
 
}
 
}
 
return @newEnt
 
return @newEnt
Line 981: Line 1,036:
 
# loadDict($threedictfile, $fourdictfile, \@threes, \@fours);
 
# loadDict($threedictfile, $fourdictfile, \@threes, \@fours);
 
# for ( my $i=0; $i<@$addRef; $i++ ) {
 
# for ( my $i=0; $i<@$addRef; $i++ ) {
# my @data = split(/,/, $addRef->[$i]);
+
# my @data = split(/,/, $addRef->[$i]);
# if ( @data < 7 ) {
+
# if ( @data < 7 ) {
# push(@data, getpass(\@threes, \@fours));
+
# push(@data, getpass(\@threes, \@fours));
# $addRef->[$i] = join(',', @data);
+
# $addRef->[$i] = join(',', @data);
# }
+
# }
 
# }
 
# }
 
# return 1;
 
# return 1;
Line 1,006: Line 1,061:
 
## if we're not saving files, just return the filelist of roster files
 
## if we're not saving files, just return the filelist of roster files
 
if ( ! $saveWWrosters ) {
 
if ( ! $saveWWrosters ) {
print " * getting roster filenames: ";
+
print " * getting roster filenames: ";
foreach my $cs ( sort keys %adds ) {
+
foreach my $cs ( sort keys %adds ) {
print "$cs..";
+
print "$cs..";
my ( $cl, $sc ) = split(/-/, $cs);
+
my ( $cl, $sc ) = split(/-/, $cs);
# set some sensible section and recitation numbers
+
# set some sensible section and recitation numbers
my $rcn = $sc;
+
my $rcn = $sc;
my $sxn = ( $cl =~ /21[56]/ ) ? substr($sc,0,2) . '0' : $sc;
+
my $sxn = ( $cl =~ /21[56]/ ) ? substr($sc,0,2) . '0' : $sc;
 
 
my $clistName = "$cs$ext.csv";
+
my $clistName = "$cs$ext.csv";
$clistName =~ s/-/_/;
+
$clistName =~ s/-/_/;
while ( ! -f $clistName && ! -f "$dataDir/$clistName" ) {
+
while ( ! -f $clistName && ! -f "$dataDir/$clistName" ) {
print "\n * cannot find course list name $clistName for " .
+
print "\n * cannot find course list name $clistName for " .
"course $cs\n";
+
"course $cs\n";
print " * name (blank to exit add) > ";
+
print " * name (blank to exit add) > ";
chomp( $clistName = <STDIN> );
+
chomp( $clistName = <STDIN> );
if ( ! $clistName ) {
+
if ( ! $clistName ) {
print " * aborting add. *\n";
+
print " * aborting add. *\n";
return( ( 'Error' => 1 ) );
+
return( ( 'Error' => 1 ) );
}
+
}
}
+
}
$clistName = "$dataDir/$clistName" if ( ! -f $clistName );
+
$clistName = "$dataDir/$clistName" if ( ! -f $clistName );
$fileNames{ $cs } = $clistName;
+
$fileNames{ $cs } = $clistName;
}
+
}
print "\n * done\n";
+
print "\n * done\n";
return %fileNames;
+
return %fileNames;
 
}
 
}
 
 
Line 1,039: Line 1,094:
 
my $adminPw = '';
 
my $adminPw = '';
 
if ( $adminUser ) {
 
if ( $adminUser ) {
# print " $adminUser password > ";
+
# print " $adminUser password > ";
# system("stty -echo");
+
# system("stty -echo");
# chomp( $adminPw = <STDIN> );
+
# chomp( $adminPw = <STDIN> );
$adminPw = $adminID;
+
$adminPw = $adminID;
# print "\n again > ";
+
# print "\n again > ";
# my $pwCheck = <STDIN>;
+
# my $pwCheck = <STDIN>;
# chomp($pwCheck);
+
# chomp($pwCheck);
# while ( $adminPw ne $pwCheck ) {
+
# while ( $adminPw ne $pwCheck ) {
# print "\n passwords don't match; again: password > ";
+
# print "\n passwords don't match; again: password > ";
# chomp( $adminPw = <STDIN> );
+
# chomp( $adminPw = <STDIN> );
# print "\n again > ";
+
# print "\n again > ";
# chomp( $pwCheck = <STDIN> );
+
# chomp( $pwCheck = <STDIN> );
# }
+
# }
# system("stty echo");
+
# system("stty echo");
# print "\n";
+
# print "\n";
 
}
 
}
 
 
Line 1,071: Line 1,126:
 
$dir = $destDir if ( ! $dir );
 
$dir = $destDir if ( ! $dir );
 
if ( $dir eq $destDir && ! -d $baseDir ) {
 
if ( $dir eq $destDir && ! -d $baseDir ) {
die " ** error creating base directory (exiting)\n ** $baseDir\n"
+
die " ** error creating base directory (exiting)\n ** $baseDir\n"
if ( ! mkdir $baseDir );
+
if ( ! mkdir $baseDir );
 
}
 
}
 
if ( ! -d $dir ) {
 
if ( ! -d $dir ) {
if ( mkdir $dir ) {
+
if ( mkdir $dir ) {
print " * (created new directory)\n";
+
print " * (created new directory)\n";
} else {
+
} else {
die " ** error creating directory (exiting)\n ** $dir\n";
+
die " ** error creating directory (exiting)\n ** $dir\n";
}
+
}
 
}
 
}
 
 
Line 1,085: Line 1,140:
 
print " * writing files: ";
 
print " * writing files: ";
 
foreach my $cs ( sort keys %adds ) {
 
foreach my $cs ( sort keys %adds ) {
print "$cs..";
+
print "$cs..";
my ( $cl, $sc ) = split(/-/, $cs);
+
my ( $cl, $sc ) = split(/-/, $cs);
 
# set some sensible section and recitation numbers
 
# set some sensible section and recitation numbers
my $rcn = $sc;
+
my $rcn = $sc;
my $sxn = ( $cl =~ /21[56]/ ) ? substr($sc,0,2) . '0' : $sc;
+
my $sxn = ( $cl =~ /21[56]/ ) ? substr($sc,0,2) . '0' : $sc;
 
 
my $clistName = "$cs$ext.csv";
+
my $clistName = "$cs$ext.csv";
$clistName =~ s/-/_/;
+
$clistName =~ s/-/_/;
while ( ! -f $clistName && ! -f "$dataDir/$clistName" ) {
+
while ( ! -f $clistName && ! -f "$dataDir/$clistName" ) {
print "\n * cannot find course list name $clistName for " .
+
print "\n * cannot find course list name $clistName for " .
"course $cs\n";
+
"course $cs\n";
print " * name (blank to exit add) > ";
+
print " * name (blank to exit add) > ";
chomp( $clistName = <STDIN> );
+
chomp( $clistName = <STDIN> );
if ( ! $clistName ) {
+
if ( ! $clistName ) {
print " * aborting add. *\n";
+
print " * aborting add. *\n";
return( ( 'Error' => 1 ) );
+
return( ( 'Error' => 1 ) );
}
+
}
}
+
}
$clistName = "$dataDir/$clistName" if ( ! -f $clistName );
+
$clistName = "$dataDir/$clistName" if ( ! -f $clistName );
 
 
 
# got name; read contents and reformat appropriately
 
# got name; read contents and reformat appropriately
my @roster = `/bin/cat $clistName`;
+
my @roster = `/bin/cat $clistName`;
@roster = modifyEntries( \@roster );
+
@roster = modifyEntries( \@roster );
 
 
 
# start off with the instructor
 
# start off with the instructor
my $dataList = sprintf( $wwclFormat, $adds{$cs}->[7], $adds{$cs}->[3],
+
my $dataList = sprintf( $wwclFormat, $adds{$cs}->[7], $adds{$cs}->[3],
$adds{$cs}->[4] . " " . $adds{$cs}->[5],
+
$adds{$cs}->[4] . " " . $adds{$cs}->[5],
$sxn, $rcn, $adds{$cs}->[2], $adds{$cs}->[2] );
+
$sxn, $rcn, $adds{$cs}->[2], $adds{$cs}->[2] );
 
# add the administrator, if any, if the instructor isn't the admin user
 
# add the administrator, if any, if the instructor isn't the admin user
$dataList .= sprintf( $wwclFormat, $adminPw, 'Administrator', 'An',
+
$dataList .= sprintf( $wwclFormat, $adminPw, 'Administrator', 'An',
$sxn, $rcn, 'math-itc', $adminUser )
+
$sxn, $rcn, 'math-itc', $adminUser )
if ( $adminUser && $adminUser ne $adds{$cs}->[2] );
+
if ( $adminUser && $adminUser ne $adds{$cs}->[2] );
 
 
foreach my $stuEntry ( @roster ) {
+
foreach my $stuEntry ( @roster ) {
my @fields = split( /,/, $stuEntry );
+
my @fields = split( /,/, $stuEntry );
my $uniq = $fields[2];
+
my $uniq = $fields[2];
 
 
my $lname = $fields[3]; $lname =~ s/\"//g;
+
my $lname = $fields[3]; $lname =~ s/\"//g;
my $fmname = "$fields[4] $fields[5]"; $fmname =~ s/\"//g;
+
my $fmname = "$fields[4] $fields[5]"; $fmname =~ s/\"//g;
my $umid = $fields[6]; $umid =~ s/\"//g; # fix emacs' hiliting:"
+
my $umid = $fields[6]; $umid =~ s/\"//g; # fix emacs' hiliting:"
 
 
$dataList .= sprintf( $wwclFormat, $fields[6], $fields[3],
+
$dataList .= sprintf( $wwclFormat, $fields[6], $fields[3],
$fields[4] . " " . $fields[5], $sxn, $rcn,
+
$fields[4] . " " . $fields[5], $sxn, $rcn,
$fields[2], $fields[2] );
+
$fields[2], $fields[2] );
}
+
}
 
# output data to file
 
# output data to file
$fileNames{ $cs } = "$dir/$cs.lst";
+
$fileNames{ $cs } = "$dir/$cs.lst";
open( OF, ">$dir/$cs.lst" ) or
+
open( OF, ">$dir/$cs.lst" ) or
die("\n ** error writing user list file $cs.lst (exiting)\n");
+
die("\n ** error writing user list file $cs.lst (exiting)\n");
print OF $dataList;
+
print OF $dataList;
close( OF );
+
close( OF );
 
}
 
}
 
 
Line 1,163: Line 1,218:
 
my @addTo;
 
my @addTo;
 
if ( ! $cnum ) {
 
if ( ! $cnum ) {
print " ** error: no classes specified for assignment add *\n";
+
print " ** error: no classes specified for assignment add *\n";
return 0;
+
return 0;
 
} else {
 
} else {
@addTo = getList( $cnum, scalar(@classNameList) );
+
@addTo = getList( $cnum, scalar(@classNameList) );
while ( ! @addTo ) {
+
while ( ! @addTo ) {
print " * course(s) to which to add assignments (n1,n2-n3,n4) > ";
+
print " * course(s) to which to add assignments (n1,n2-n3,n4) > ";
chomp( $cnum = <STDIN> );
+
chomp( $cnum = <STDIN> );
@addTo = getList( $cnum, scalar(@classNameList) );
+
@addTo = getList( $cnum, scalar(@classNameList) );
}
+
}
foreach ( @addTo ) {
+
foreach ( @addTo ) {
$assignmentClassList{$classNameList[$_-1]} =
+
$assignmentClassList{$classNameList[$_-1]} =
$classList{$classNameList[$_-1]};
+
$classList{$classNameList[$_-1]};
}
+
}
 
}
 
}
 
 
 
# get template class for assignments
 
# get template class for assignments
 
print " * template course giving assignments\n (enter number; " .
 
print " * template course giving assignments\n (enter number; " .
"0|-1 to exit|use existing) > ";
+
"0|-1 to exit|use existing) > ";
 
my $templNum = <STDIN>;
 
my $templNum = <STDIN>;
 
chomp( $templNum );
 
chomp( $templNum );
 
while( $templNum !~ /^-?\d+$/ || $templNum < -1 ||
 
while( $templNum !~ /^-?\d+$/ || $templNum < -1 ||
$templNum > @classNameList ) {
+
$templNum > @classNameList ) {
print " * please enter a number (-1 - " . scalar(@classNameList) .
+
print " * please enter a number (-1 - " . scalar(@classNameList) .
") > ";
+
") > ";
chomp( $templNum = <STDIN> );
+
chomp( $templNum = <STDIN> );
 
}
 
}
 
# leave if need be
 
# leave if need be
 
if ( $templNum == 0 ) {
 
if ( $templNum == 0 ) {
print " * aborting set assignment.\n";
+
print " * aborting set assignment.\n";
return 1;
+
return 1;
 
}
 
}
 
# save the name of the template class
 
# save the name of the template class
 
my $templateClass;
 
my $templateClass;
 
if ( $templNum > 0 ) {
 
if ( $templNum > 0 ) {
$templateClass = $classNameList[ $templNum-1 ];
+
$templateClass = $classNameList[ $templNum-1 ];
 
} else {
 
} else {
## if we're using existing template files, say the template
+
## if we're using existing template files, say the template
## class is the first in the list, for now
+
## class is the first in the list, for now
$templateClass = $classNameList[ $addTo[0]-1 ];
+
$templateClass = $classNameList[ $addTo[0]-1 ];
 
}
 
}
 
 
Line 1,209: Line 1,264:
 
my @importDefFiles = (); # sets to just import
 
my @importDefFiles = (); # sets to just import
 
for ( my $i=0; $i<@defFiles; $i++ ) {
 
for ( my $i=0; $i<@defFiles; $i++ ) {
chomp( $defFiles[$i] );
+
chomp( $defFiles[$i] );
$defFiles[$i] =~ s/.*\/(set.+\.def)/$1/;
+
$defFiles[$i] =~ s/.*\/(set.+\.def)/$1/;
my ($setName) = ($defFiles[$i] =~ /set(.+)\.def/);
+
my ($setName) = ($defFiles[$i] =~ /set(.+)\.def/);
if ( isIn( $setName, @groupSets ) ) {
+
if ( isIn( $setName, @groupSets ) ) {
push( @importDefFiles, $defFiles[$i] );
+
push( @importDefFiles, $defFiles[$i] );
} else {
+
} else {
push( @assignDefFiles, $defFiles[$i] );
+
push( @assignDefFiles, $defFiles[$i] );
}
+
}
 
}
 
}
 
 
 
if ( ! @defFiles ) {
 
if ( ! @defFiles ) {
print " * found no set definition files for $templateClass " .
+
print " * found no set definition files for $templateClass " .
"(aborting add).\n";
+
"(aborting add).\n";
return 0;
+
return 0;
 
} else {
 
} else {
print " * found " . scalar( @defFiles ) . " template assignments " .
+
print " * found " . scalar( @defFiles ) . " template assignments " .
"(in $templateClass)\n";
+
"(in $templateClass)\n";
 
 
my %assignmentData = ();
+
my %assignmentData = ();
 
# ok, now we have to deal with possible gateway tests
 
# ok, now we have to deal with possible gateway tests
print " * for gateway tests: enter g/w params, or read from file ",
+
print " * for gateway tests: enter g/w params, or read from file ",
"(0|[f]) > ";
+
"(0|[f]) > ";
my $ans = <STDIN>;
+
my $ans = <STDIN>;
chomp( $ans );
+
chomp( $ans );
if ( $ans eq '0' ) {
+
if ( $ans eq '0' ) {
foreach my $setFile ( @defFiles ) {
+
foreach my $setFile ( @defFiles ) {
next if ( $setFile !~ /gateway/i && $setFile !~ /GW/ );
+
next if ( $setFile !~ /gateway/i && $setFile !~ /GW/ );
 
# we want to set: in the webwork table course_set,
 
# we want to set: in the webwork table course_set,
 
# assignment_type = 'gateway' (or 'proctored_gateway')
 
# assignment_type = 'gateway' (or 'proctored_gateway')
Line 1,244: Line 1,299:
 
# problem_randorder = 0 or 1
 
# problem_randorder = 0 or 1
 
# problems_per_page = n
 
# problems_per_page = n
my $setName = $setFile;
+
my $setName = $setFile;
$setName =~ s/set?(.+)\.def/$1/;
+
$setName =~ s/set?(.+)\.def/$1/;
print " * for set $setName: \n";
+
print " * for set $setName: \n";
print " assignment type ([cr], [g]ateway, or " .
+
print " assignment type ([cr], [g]ateway, or " .
"[p]roctored_gateway) > ";
+
"[p]roctored_gateway) > ";
my $type = <STDIN>;
+
my $type = <STDIN>;
chomp( $type );
+
chomp( $type );
if ( ! $type ) {
+
if ( ! $type ) {
$type = 'default';
+
$type = 'default';
} else {
+
} else {
$type = ( $type eq 'g' ) ? 'gateway' : 'proctored_gateway';
+
$type = ( $type eq 'g' ) ? 'gateway' : 'proctored_gateway';
}
+
}
print " time interval for new versions ([cr] for " .
+
print " time interval for new versions ([cr] for " .
"fake day) > ";
+
"fake day) > ";
my $timeInterval = <STDIN>;
+
my $timeInterval = <STDIN>;
chomp( $timeInterval );
+
chomp( $timeInterval );
$timeInterval = 43200 if ( ! $timeInterval );
+
$timeInterval = 43200 if ( ! $timeInterval );
print " number of tests per interval (0 for infty) > ";
+
print " number of tests per interval (0 for infty) > ";
my $numTests = <STDIN>;
+
my $numTests = <STDIN>;
chomp( $numTests );
+
chomp( $numTests );
$numTests = 0 if ( ! $numTests );
+
$numTests = 0 if ( ! $numTests );
print " time limit per test (in min) > ";
+
print " time limit per test (in min) > ";
my $timeLimit = <STDIN>;
+
my $timeLimit = <STDIN>;
chomp( $timeLimit );
+
chomp( $timeLimit );
$timeLimit *= 60;
+
$timeLimit *= 60;
# print " order problems randomly (0|1) > ";
+
# print " order problems randomly (0|1) > ";
# my $ordering = <STDIN>;
+
# my $ordering = <STDIN>;
my $ordering = 1;
+
my $ordering = 1;
chomp( $ordering );
+
chomp( $ordering );
print " problems per page ([cr] = all) > ";
+
print " problems per page ([cr] = all) > ";
my $pppage = <STDIN>;
+
my $pppage = <STDIN>;
chomp( $pppage );
+
chomp( $pppage );
$pppage = 0 if ( ! $pppage );
+
$pppage = 0 if ( ! $pppage );
 
 
$assignmentData{ $setFile } = {
+
$assignmentData{ $setFile } = {
assignment_type => $type,
+
open_date =>
attempts_per_version => 1,
+
assignment_type => $type,
time_interval => $timeInterval,
+
attempts_per_version => 1,
versions_per_interval => $numTests,
+
time_interval => $timeInterval,
version_time_limit => $timeLimit,
+
versions_per_interval => $numTests,
problem_randorder => $ordering,
+
version_time_limit => $timeLimit,
published => 1,
+
problem_randorder => $ordering,
problems_per_page => $pppage, };
+
published => 1,
}
+
problems_per_page => $pppage, };
}
+
}
  +
}
 
 
 
# sanity check
 
# sanity check
if ( ! %assignmentClassList ) {
+
if ( ! %assignmentClassList ) {
warn(" ** error: no classes found for course number $cnum\n");
+
warn(" ** error: no classes found for course number $cnum\n");
return 0;
+
return 0;
}
+
}
 
 
 
# now we have the set definition files, we can go through each course
 
# now we have the set definition files, we can go through each course
 
# and make the assignments using our fake Instructor object
 
# and make the assignments using our fake Instructor object
print " * making set assignments to courses:\n ";
+
print " * making set assignments to courses:\n ";
foreach my $csName ( sort keys %assignmentClassList ) {
+
foreach my $csName ( sort keys %assignmentClassList ) {
next if ( $csName =~ /-sample/ );
+
next if ( $csName =~ /-sample/ );
print "$csName..";
+
print "$csName..";
 
# make sure that the course has the required set definition files
 
# make sure that the course has the required set definition files
if ( $templNum > 0 && $csName ne $templateClass ) {
+
if ( $templNum > 0 && $csName ne $templateClass ) {
system( "/bin/cp " .
+
system( "/bin/cp " .
"$wwHome/courses/$templateClass/templates/set*.def " .
+
"$wwHome/courses/$templateClass/templates/set*.def " .
"$wwHome/courses/$csName/templates/" );
+
"$wwHome/courses/$csName/templates/" );
system( "/bin/chown $htuser:$htgroup " .
+
system( "/bin/chown $htuser:$htgroup " .
"$wwHome/courses/$csName/templates/set*.def" );
+
"$wwHome/courses/$csName/templates/set*.def" );
}
+
}
 
# get the course environment for this course
 
# get the course environment for this course
my $csce =
+
my $csce =
WeBWorK::CourseEnvironment->new( { webwork_dir => $wwHome,
+
WeBWorK::CourseEnvironment->new( { webwork_dir => $wwHome,
courseName => $csName } );
+
courseName => $csName } );
 
# and create an appropriate database object
 
# and create an appropriate database object
my $db = WeBWorK::DB->new( $csce->{dbLayout} );
+
my $db = WeBWorK::DB->new( $csce->{dbLayout} );
 
# build a fake request object so that we can get an
 
# build a fake request object so that we can get an
 
# instructor::problemsetlist object
 
# instructor::problemsetlist object
my $fr = FakeRequest->new();
+
my $fr = FakeRequest->new();
$fr->ce( $csce );
+
$fr->ce( $csce );
$fr->db( $db );
+
$fr->db( $db );
my $wwInstrPSL =
+
$fr->param( 'user', $adminUser );
WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($fr);
+
my $wwInstrPSL =
  +
WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($fr);
 
# import the sets
 
# import the sets
$wwInstrPSL->importSetsFromDef( '', 'all', @assignDefFiles );
+
$wwInstrPSL->importSetsFromDef( '', 'all', @assignDefFiles );
$wwInstrPSL->importSetsFromDef( '', 'none', @importDefFiles );
+
$wwInstrPSL->importSetsFromDef( '', 'none', @importDefFiles );
 
 
 
# then make any gateway adjustments that we need to
 
# then make any gateway adjustments that we need to
foreach my $setFile ( @defFiles ) {
+
foreach my $setFile ( @defFiles ) {
next if ( ! defined( $assignmentData{ $setFile } ) );
+
next if ( ! defined( $assignmentData{ $setFile } ) );
# find the setName
+
# find the setName
my ($setName) = ( $setFile =~ m|^set([.\w-]+)\.def$| );
+
my ($setName) = ( $setFile =~ m|^set([.\w-]+)\.def$| );
# get and update the global set
+
# get and update the global set
my $set = $db->getGlobalSet( $setName );
+
eval {
foreach my $field ( %{$assignmentData{ $setFile }} ) {
+
my $set = $db->getGlobalSet( $setName );
$set->{$field} = $assignmentData{$setFile}->{$field};
+
foreach my $field ( %{$assignmentData{ $setFile }} ) {
}
+
$set->{$field} = $assignmentData{$setFile}->{$field};
$db->putGlobalSet( $set );
+
}
}
+
$db->putGlobalSet( $set );
}
+
};
print "\n * done.\n";
+
if ( $@ ) {
  +
print "Error updating g/w set $setName: $@\n";
  +
print "Continue? ([cr]|n) ";
  +
my $ans = <STDIN>;
  +
exit if ( $ans =~ /n/i );
  +
}
  +
}
  +
}
  +
print "\n * done.\n";
 
}
 
}
 
}
 
}
Line 1,359: Line 1,414:
 
listCourses( \%classList );
 
listCourses( \%classList );
 
 
print " * courses to which to add proctors (give n1,n2-n3,n4)> ";
+
print " * courses to which to add proctors (n1,n2-n3,n4|crs-trm)> ";
 
my $procList = <STDIN>;
 
my $procList = <STDIN>;
 
chomp($procList);
 
chomp($procList);
 
 
 
if ( ! $procList ) {
 
if ( ! $procList ) {
print " ** error: no classes specified for proctor add *\n";
+
print " ** error: no classes specified for proctor add *\n";
return 0;
+
return 0;
 
 
 
} else {
 
} else {
my @procCrsList = getList($procList, scalar(@classNameList));
+
if ( $procList =~ /-[fwsu]\d\d$/ ) {
while ( ! @procCrsList ) {
+
my ( $crs,$trm ) = split(/-/, $procList );
print " * courses to which to add proctors (give n1,n2-n3,n4)> ";
+
@procCrses = grep( /ma${crs}-\d\d\d-${trm}$/, @classNameList );
chomp($procList = <STDIN>);
+
} else {
@procCrsList = getList($procList, scalar(@classNameList));
+
my @procCrsList = getList($procList, scalar(@classNameList));
}
+
while ( ! @procCrsList ) {
foreach ( @procCrsList ) {
+
print " * courses to which to add proctors (n1,n2-n3,n4)> ";
push( @procCrses, $classNameList[$_-1] );
+
chomp($procList = <STDIN>);
}
+
@procCrsList = getList($procList, scalar(@classNameList));
  +
}
  +
foreach ( @procCrsList ) {
  +
push( @procCrses, $classNameList[$_-1] );
  +
}
  +
}
 
}
 
}
  +
 
# now $procCrses[i] = crsName for all courses to which we add proctors
 
# now $procCrses[i] = crsName for all courses to which we add proctors
 
 
 
my $printDir = substr($proctorDir,-40);
 
my $printDir = substr($proctorDir,-40);
 
print " * file giving proctors (name\\t+uniq\\t+passwd)\n" .
 
print " * file giving proctors (name\\t+uniq\\t+passwd)\n" .
" [default in $printDir] > ";
+
" [default in $printDir] > ";
 
my $procFile = <STDIN>;
 
my $procFile = <STDIN>;
 
chomp($procFile);
 
chomp($procFile);
 
$procFile = "$proctorDir/$procFile" if ( ! -f $procFile );
 
$procFile = "$proctorDir/$procFile" if ( ! -f $procFile );
 
while ( ! -r $procFile ) {
 
while ( ! -r $procFile ) {
print " * cannot read $procFile; file > ";
+
print " * cannot read $procFile; file > ";
chomp($procFile = <STDIN>);
+
chomp($procFile = <STDIN>);
 
}
 
}
 
my @tmpList = `/bin/cat $procFile`;
 
my @tmpList = `/bin/cat $procFile`;
 
my @proctorList = ();
 
my @proctorList = ();
 
foreach (@tmpList) {
 
foreach (@tmpList) {
push( @proctorList, $_ ) if ( /\S/ );
+
push( @proctorList, $_ ) if ( /\S/ && /^[^#]/ );
  +
}
  +
# check file format
  +
my $fmtok = 1;
  +
my $badline = '';
  +
foreach ( @proctorList ) {
  +
my @f = split(/\t+/);
  +
if ( @f != 3 ) {
  +
$fmtok = 0;
  +
$badline = $_;
  +
last;
  +
}
  +
}
  +
if ( ! $fmtok ) {
  +
print " * error: file format doesn't appear to be " .
  +
"name\t+uniq\t+password\n$badline";
  +
return 0;
 
}
 
}
 
 
Line 1,404: Line 1,460:
 
my @courseSpecific = ();
 
my @courseSpecific = ();
 
foreach ( @proctorList ) {
 
foreach ( @proctorList ) {
my @fields = split(/\t+/);
+
my @fields = split(/\t+/);
if ( @fields == 4 ) {
+
if ( @fields == 4 ) {
push( @courseSpecific, $_ );
+
push( @courseSpecific, $_ );
} else {
+
} else {
push( @globalProctors, $_ );
+
push( @globalProctors, $_ );
}
+
}
 
}
 
}
 
 
 
if ( @proctorList ) {
 
if ( @proctorList ) {
print " * adding ", scalar(@proctorList), " proctors to courses: \n";
+
print " * adding ", scalar(@proctorList), " proctors to courses: \n";
print " * ", scalar(@globalProctors), " global proctors, \n";
+
print " * ", scalar(@globalProctors), " global proctors, \n";
print " * ", scalar(@courseSpecific), " course proctors:\n ";
+
print " * ", scalar(@courseSpecific), " course proctors:\n ";
 
 
foreach my $cName ( @procCrses ) {
+
foreach my $cName ( @procCrses ) {
print "$cName..";
+
print "$cName..";
 
 
 
# get a database object to be able to add the users
 
# get a database object to be able to add the users
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
+
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
courseName => $cName});
+
courseName => $cName});
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
+
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
 
 
 
# get a list of existing users so that we are sure we're not adding
 
# get a list of existing users so that we are sure we're not adding
 
# a proctor who is in a course already
 
# a proctor who is in a course already
my @userList = $db->listUsers();
+
my @userList = $db->listUsers();
 
 
foreach my $line ( @proctorList ) {
+
foreach my $line ( @proctorList ) {
chomp($line);
+
chomp($line);
my @fields = split( /\t+/, $line );
+
my @fields = split( /\t+/, $line );
my $name = $fields[0];
+
my $name = $fields[0];
my $uniq = $fields[1];
+
my $uniq = $fields[1];
my $passwd = $fields[2];
+
my $passwd = $fields[2];
 
 
my ( $crsnum, $sxnnum ) = ( '', '' );
+
my ( $crsnum, $sxnnum ) = ( '', '' );
if ( @fields == 4 ) {
+
if ( @fields == 4 ) {
$crsnum = substr($fields[3], 0, 3);
+
$crsnum = substr($fields[3], 0, 3);
$sxnnum = [ split(/,/, substr($fields[3],4)) ];
+
$sxnnum = [ split(/,/, substr($fields[3],4)) ];
}
+
}
 
 
# if this is a course proctor, skip if we're not doing
+
# if this is a course proctor, skip if we're not doing
# the correct course
+
# the correct course
if ( $crsnum ) {
+
if ( $crsnum ) {
my $keep = 0;
+
my $keep = 0;
foreach my $s ( @{$sxnnum} ) {
+
foreach my $s ( @{$sxnnum} ) {
if ( $cName =~ /ma$crsnum-$s/ ) {
+
if ( $cName =~ /ma$crsnum-$s/ ) {
$keep = 1;
+
$keep = 1;
last;
+
last;
}
+
}
}
+
}
next if ( ! $keep );
+
next if ( ! $keep );
}
+
}
 
 
if ( isIn($uniq, @userList) ) {
+
if ( isIn($uniq, @userList) ) {
print " * user $uniq ($name) already exists! skipping..\n";
+
print " * user $uniq ($name) already exists! skipping..\n";
next;
+
next;
}
+
}
 
 
my ( $fname, $lname ) = ( '', '' );
+
my ( $fname, $lname ) = ( '', '' );
if ( $name =~ /\s/ ) {
+
if ( $name =~ /\s/ ) {
( $fname, $lname ) = ( $name =~ /(.*)\s(\S+)/ );
+
( $fname, $lname ) = ( $name =~ /(.*)\s(\S+)/ );
} else {
+
} else {
$lname = $name;
+
$lname = $name;
}
+
}
 
 
my $newUser = $db->newUser;
+
my $newUser = $db->newUser;
my $newPermissionLevel = $db->newPermissionLevel;
+
my $newPermissionLevel = $db->newPermissionLevel;
my $newPassword = $db->newPassword;
+
my $newPassword = $db->newPassword;
 
 
$newUser->user_id($uniq);
+
$newUser->user_id($uniq);
$newPermissionLevel->user_id($uniq);
+
$newPermissionLevel->user_id($uniq);
$newPassword->user_id($uniq);
+
$newPassword->user_id($uniq);
my $salt =
+
my $salt =
join("",
+
join("",
('.','/','0'..'9','A'..'Z','a'..'z')[rand 64,rand 64]);
+
('.','/','0'..'9','A'..'Z','a'..'z')[rand 64,rand 64]);
$newPassword->password(crypt($passwd, $salt));
+
$newPassword->password(crypt($passwd, $salt));
$newUser->last_name($lname);
+
$newUser->last_name($lname);
$newUser->first_name($fname);
+
$newUser->first_name($fname);
$newUser->student_id($passwd);
+
$newUser->student_id($passwd);
$newUser->email_address("$uniq\@$mailDomain");
+
$newUser->email_address("$uniq\@$mailDomain");
if ( $crsnum ) {
+
if ( $crsnum ) {
$newUser->section('900'); # distinguish course proctors
+
$newUser->section('900'); # distinguish course proctors
} else { # with section 900
+
} else { # with section 900
$newUser->section('999');
+
$newUser->section('999');
}
+
}
$newUser->recitation('999');
+
$newUser->recitation('999');
$newUser->comment('');
+
$newUser->comment('');
# $newUser->status($ce->status_name_to_abbrevs($ce->{default_status}));
+
# $newUser->status($ce->status_name_to_abbrevs($ce->{default_status}));
$newUser->status($ce->status_name_to_abbrevs("Proctor"));
+
$newUser->status($ce->status_name_to_abbrevs("Proctor"));
$newPermissionLevel->permission(3);
+
$newPermissionLevel->permission(3);
 
 
eval { $db->addUser($newUser) };
+
eval { $db->addUser($newUser) };
if ($@) {
+
if ($@) {
print " * error adding user $uniq ($name): $@\n";
+
print " * error adding user $uniq ($name): $@\n";
next;
+
next;
} else {
+
} else {
$db->addPermissionLevel($newPermissionLevel);
+
$db->addPermissionLevel($newPermissionLevel);
$db->addPassword($newPassword);
+
$db->addPassword($newPassword);
}
+
}
}
+
}
}
+
}
print "\n * done.\n";
+
print "\n * done.\n";
 
 
 
} else {
 
} else {
print " ** error: no proctors found in file\n";
+
print " ** error: no proctors found in file\n";
return 0;
+
return 0;
 
}
 
}
 
}
 
}
Line 1,518: Line 1,574:
 
my $snum = '';
 
my $snum = '';
 
if ( $type eq 'global' ) {
 
if ( $type eq 'global' ) {
$snum = '999';
+
$snum = '999';
 
} else {
 
} else {
$snum = '900';
+
$snum = '900';
 
}
 
}
 
print " * delete proctors from courses in the system *\n";
 
print " * delete proctors from courses in the system *\n";
Line 1,533: Line 1,589:
 
listCourses( \%classList );
 
listCourses( \%classList );
 
 
print " * courses from which to del proctors (give n1,n2-n3,n4)> ";
+
print " * courses from which to del proctors (n1,n2-n3,n4|crs-trm)> ";
 
my $procList = <STDIN>;
 
my $procList = <STDIN>;
 
chomp($procList);
 
chomp($procList);
 
 
 
if ( ! $procList ) {
 
if ( ! $procList ) {
print " ** error: no classes specified for proctor add *\n";
+
print " ** error: no classes specified for proctor add *\n";
return 0;
+
return 0;
 
 
 
} else {
 
} else {
my @procCrsList = getList($procList, scalar(@classNameList));
+
if ( $procList =~ /-[fwsu]\d\d$/ ) {
while ( ! @procCrsList ) {
+
my ( $crs,$trm ) = split(/-/, $procList );
print " * courses to which to del proctors (give n1,n2-n3,n4)> ";
+
@procCrses = grep( /ma${crs}-\d\d\d-${trm}$/, @classNameList );
chomp($procList = <STDIN>);
+
} else {
@procCrsList = getList($procList, scalar(@classNameList));
+
my @procCrsList = getList($procList, scalar(@classNameList));
}
+
while ( ! @procCrsList ) {
foreach ( @procCrsList ) {
+
print " * courses from which to del proctors (n1,n2-n3,n4)> ";
push( @procCrses, $classNameList[$_-1] );
+
chomp($procList = <STDIN>);
}
+
@procCrsList = getList($procList, scalar(@classNameList));
  +
}
  +
foreach ( @procCrsList ) {
  +
push( @procCrses, $classNameList[$_-1] );
  +
}
  +
}
 
}
 
}
 
# now $procCrses[i] = crsName for all courses to which we add proctors
 
# now $procCrses[i] = crsName for all courses to which we add proctors
Line 1,559: Line 1,615:
 
my $cName = $procCrses[0];
 
my $cName = $procCrses[0];
 
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
 
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
courseName => $cName});
+
courseName => $cName});
 
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
 
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
 
 
Line 1,567: Line 1,623:
 
print " * found ", scalar(@procUsers), " ($type) proctors in $cName\n";
 
print " * found ", scalar(@procUsers), " ($type) proctors in $cName\n";
 
print " * ready to delete these proctors from courses $crses. " .
 
print " * ready to delete these proctors from courses $crses. " .
"continue? ([n]|y) > ";
+
"continue? ([n]|y) > ";
 
my $ans = <STDIN>;
 
my $ans = <STDIN>;
 
chomp($ans);
 
chomp($ans);
 
if ( $ans !~ /^y$/i ) {
 
if ( $ans !~ /^y$/i ) {
print " ** ok. exiting delete.\n";
+
print " ** ok. exiting delete.\n";
return 0;
+
return 0;
 
} else {
 
} else {
print " * deleting proctors from $cName..";
+
print " * deleting proctors from $cName..";
foreach ( @procUsers ) {
+
foreach ( @procUsers ) {
$db->deleteUser( $_->user_id() );
+
$db->deleteUser( $_->user_id() );
}
+
}
foreach $cName ( @procCrses ) {
+
foreach $cName ( @procCrses ) {
next if $cName eq $procCrses[0];
+
next if $cName eq $procCrses[0];
print "$cName.. ";
+
print "$cName.. ";
$ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
+
$ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
courseName => $cName});
+
courseName => $cName});
$db = WeBWorK::DB->new( $ce->{dbLayout} );
+
$db = WeBWorK::DB->new( $ce->{dbLayout} );
my @userIDList = $db->listUsers();
+
my @userIDList = $db->listUsers();
my @procUsers = grep {$_->section() eq $snum}
+
my @procUsers = grep {$_->section() eq $snum}
$db->getUsers( @userIDList );
+
$db->getUsers( @userIDList );
foreach ( @procUsers ) {
+
foreach ( @procUsers ) {
$db->deleteUser( $_->user_id() );
+
$db->deleteUser( $_->user_id() );
}
+
}
}
+
}
print "\n * done.\n";
+
print "\n * done.\n";
  +
}
  +
}
  +
  +
sub updateTermRosters {
  +
# pre:
  +
# post: we update rosters for all courses in a given term
  +
  +
print " * update rosters for all courses in a term *\n";
  +
print " * term to update ([fwsu]\\d\\d) > ";
  +
my $term = <STDIN>;
  +
chomp( $term );
  +
  +
print " * campus extension ([cr] for none) > ";
  +
my $ext = <STDIN>;
  +
chomp( $ext );
  +
  +
my %classList = getClasses();
  +
my @classNameList = sort keys( %classList );
  +
my $matchPat = ( $ext ) ? "-$ext-$term" : "\\d-$term";
  +
  +
my @allUpdateCrses = grep( /$matchPat$/, @classNameList );
  +
  +
# sort these by course and do the updates in batch
  +
my $prevcrs = 0;
  +
my @updateCrses = ();
  +
  +
my ( $crs, $sxn );
  +
foreach my $crsName ( @allUpdateCrses ) {
  +
( $crs, $sxn ) = ( 0, 0 );
  +
if ( $crsName =~ /ma(\d{3})-(\d{3})/ ) {
  +
$crs = $1;
  +
$sxn = $2;
  +
} elsif ( $crsName =~ /ma(\d{3})-[fwsu]\d\d/ ) {
  +
$crs = $1;
  +
} else {
  +
# this gets dealt with in doRosterUpdate
  +
next;
  +
}
  +
if ( ! $prevcrs || $crs ne $prevcrs ) {
  +
if ( @updateCrses ) {
  +
print " * updating by course number: $prevcrs\n";
  +
# print " * update for " . join(", ", @updateCrses) . "\n";
  +
doRosterUpdate( @updateCrses );
  +
}
  +
@updateCrses = ( $crsName );
  +
$prevcrs = $crs;
  +
} else {
  +
push( @updateCrses, $crsName );
  +
}
  +
}
  +
if ( @updateCrses ) {
  +
print " * updating by course number: $prevcrs\n";
  +
# print " * update for " . join(", ", @updateCrses) . "\n";
  +
doRosterUpdate( @updateCrses );
 
}
 
}
 
}
 
}
Line 1,597: Line 1,653:
 
sub updateRosters {
 
sub updateRosters {
 
# pre:
 
# pre:
# post: we update the rosters of the requested courses based on the
+
# post: we get a list of courses for which to update rosters, and update
# roster data in $dataDir
+
# those
 
 
 
print " * update rosters for courses in the system *\n";
 
print " * update rosters for courses in the system *\n";
Line 1,614: Line 1,670:
 
 
 
if ( ! $updList ) {
 
if ( ! $updList ) {
print " ** error: no classes specified *\n";
+
print " ** error: no classes specified *\n";
return 0;
+
return 0;
 
} else {
 
} else {
 
 
my @updateIndices = getList( $updList, scalar(@classNameList) );
+
my @updateIndices = getList( $updList, scalar(@classNameList) );
while ( ! @updateIndices ) {
+
while ( ! @updateIndices ) {
print " * courses to update (give n1,n2-n3,n4) > ";
+
print " * courses to update (give n1,n2-n3,n4) > ";
chomp( $updList = <STDIN> );
+
chomp( $updList = <STDIN> );
@updateIndices = getList( $updList, scalar(@classNameList) );
+
@updateIndices = getList( $updList, scalar(@classNameList) );
}
+
}
foreach ( @updateIndices ) {
+
foreach ( @updateIndices ) {
push( @updateCrses, $classNameList[$_-1] );
+
push( @updateCrses, $classNameList[$_-1] );
}
+
}
 
}
 
}
  +
  +
doRosterUpdate( @updateCrses );
  +
}
  +
  +
sub doRosterUpdate {
  +
# pre: a list of courses to update is provided
  +
# post: we update the rosters of the requested courses based on the
  +
# roster data in $dataDir
  +
  +
my @updateCrses = @_;
 
 
 
# ok, now we have a list of course names; read in the current and old rosters
 
# ok, now we have a list of course names; read in the current and old rosters
print " * reading data for course rosters.. \n ";
+
print " * reading data for course rosters.. \n";
 
# oldRosters are read from the WeBWorK courses
 
# oldRosters are read from the WeBWorK courses
 
# oldRosters{uniq} = [ crsName, crs, sxn, umid, last, first ]
 
# oldRosters{uniq} = [ crsName, crs, sxn, umid, last, first ]
Line 1,654: Line 1,720:
 
my %setNames = ();
 
my %setNames = ();
 
my %oldDroppedStu = ();
 
my %oldDroppedStu = ();
  +
  +
# webwork courses that include multiple sections
  +
# multiSectionCourses{crsName} = 0 | sxnstring
  +
my %multiSectionCourses = ();
 
 
 
my @skipClassNames = ();
 
my @skipClassNames = ();
 
 
 
 
# people we don't move or alter: adminUsers = ( list of uniqs )
 
# people we don't move or alter: adminUsers = ( list of uniqs )
 
my @adminUsers = ();
 
my @adminUsers = ();
 
 
  +
# section numbers we save
  +
my %savedSxnNums = ();
  +
  +
# the file extension must be the same for all courses that we are updating
  +
my $fileExt = '';
 
foreach my $crsName ( @updateCrses ) {
 
foreach my $crsName ( @updateCrses ) {
my $fileExt = '';
 
 
 
my ( $crs, $sxn ) = ( $crsName =~ /(\d{3})-(\d{3})/ );
 
  +
# the course name is maCCC-SSS-TTT, maCCC-SSS-EXT-TTT, or maCCC-TTT
print "$crs-$sxn..";
+
my ( $crs, $sxn ) = ( 0, 0 );
if ( ! defined($crs) || ! defined($sxn) ) {
+
if ( $crsName =~ /(\d{3})-(\d{3})/ ) {
print " ** error getting course and section number from " .
+
$crs = $1;
"$crsName; skipping\n";
+
$sxn = $2;
push( @skipClassNames, $crsName );
+
} elsif ( $crsName =~ /(\d{3})-[fwsu]\d\d/ ) {
next;
+
$crs = $1;
}
+
} else {
  +
print "\n ** error getting course and section number from " .
  +
"$crsName; skipping\n";
  +
push( @skipClassNames, $crsName );
  +
next;
  +
}
  +
$multiSectionCourses{$crs} = 0 if ( $crs );
  +
  +
# if we didn't get a section number, query for the section number
  +
if ( ! $sxn ) {
  +
print " * found no section for course $crs. section " .
  +
"(005, 10[13], all)? ";
  +
chomp($sxn = <STDIN>);
  +
$savedSxnNums{$crsName} = $sxn;
  +
$multiSectionCourses{$crs} = $sxn;
  +
}
  +
print " $crs-$sxn..";
 
 
## check for a campus extension to the course name
+
## check for a campus extension to the course name
my $ii = 0;
+
my $ii = 0;
foreach my $campExt ( @courseCampusExt ) {
+
foreach my $campExt ( @courseCampusExt ) {
if ( $crsName =~ /${crs}-${sxn}($campExt)/ ) {
+
if ( $crsName =~ /${crs}-${sxn}($campExt)/ ) {
$fileExt = $fileCampusExt[$ii];
+
$fileExt = $fileCampusExt[$ii];
last;
+
last;
}
+
}
$ii++;
+
$ii++;
}
+
}
 
 
if ( ! -r "$dataDir/${crs}_${sxn}${fileExt}.csv" ) {
 
  +
# quick check here to deal with special cases
print " ** error reading course-section file for $crsName; " .
 
  +
my $skipCheck = 0;
"skipping\n";
 
  +
if ( $crs =~ /^21[56]/ && $sxn eq 'all' ) {
push( @skipClassNames, $crsName );
 
  +
$sxn = '0[0-9]0';
next;
 
  +
$savedSxnNums{$crsName} = $sxn;
}
 
  +
$skipCheck = 1;
  +
} elsif ( $sxn eq 'all' ) {
  +
$sxn = '[0-9][0-9][0-9]';
  +
$skipCheck = 1;
  +
} elsif ( $sxn =~ /\D/ ) {
  +
$skipCheck = 1;
  +
}
  +
if ( ! $skipCheck && ! -r "$dataDir/${crs}_${sxn}${fileExt}.csv" ) {
  +
print " ** error reading course-section file " .
  +
"${crs}_${sxn}${fileExt}.csv for $crsName; " .
  +
"skipping\n";
  +
push( @skipClassNames, $crsName );
  +
next;
  +
}
 
 
$newCourseLists{$crsName} = [ ];
+
$newCourseLists{$crsName} = [ ];
 
 
 
# note roster files have the format
 
# note roster files have the format
Line 1,697: Line 1,783:
 
# 0 1 2 3 4 5
 
# 0 1 2 3 4 5
 
 
my @rosterLines = `/bin/cat $dataDir/${crs}_${sxn}${fileExt}.csv`;
+
my @rosterLines = `/bin/cat $dataDir/${crs}_${sxn}${fileExt}.csv`;
if ( @rosterLines ) {
+
if ( @rosterLines ) {
foreach ( @rosterLines ) {
+
foreach ( @rosterLines ) {
chomp();
+
chomp();
my @fields = csvSplit( $_ );
+
my @fields = csvSplit( $_ );
 
 
if ( defined( $newRosters{$fields[2]} ) ||
+
if ( defined( $newRosters{$fields[2]} ) ||
defined( $newMultipleRosters{$fields[2]} ) ) {
+
defined( $newMultipleRosters{$fields[2]} ) ) {
if ( defined( $newMultipleRosters{$fields[2]} ) ) {
+
if ( defined( $newMultipleRosters{$fields[2]} ) ) {
push( @{$newMultipleRosters{$fields[2]}}, $crsName );
+
push( @{$newMultipleRosters{$fields[2]}}, $crsName );
} else {
+
} else {
my $ocrsName = $newRosters{$fields[2]}->[0];
+
my $ocrsName = $newRosters{$fields[2]}->[0];
$newMultipleRosters{$fields[2]} = [$ocrsName, $crsName];
+
$newMultipleRosters{$fields[2]} = [$ocrsName, $crsName];
}
+
}
} else {
+
} else {
$newRosters{$fields[2]} = [ $crsName, $crs, $sxn,
+
$newRosters{$fields[2]} = [ $crsName, $crs, $fields[1],
$fields[5], $fields[3],
+
$fields[5], $fields[3],
$fields[4] ];
+
$fields[4] ];
push( @{$newCourseLists{$crsName}}, $fields[2] );
+
push( @{$newCourseLists{$crsName}}, $fields[2] );
}
+
}
}
+
}
} else {
+
} else {
print " ** found no data for ${crs}-$sxn ($crsName); skipping\n";
+
print " ** found no data for ${crs}-$sxn ($crsName); skipping\n";
push( @skipClassNames, $crsName );
+
push( @skipClassNames, $crsName );
next;
+
next;
}
+
}
 
}
 
}
 
 
 
print "done\n * reading roster data from webwork courses..\n ";
 
print "done\n * reading roster data from webwork courses..\n ";
 
foreach my $crsName ( @updateCrses ) {
 
foreach my $crsName ( @updateCrses ) {
my ( $crs, $sxn ) = ( $crsName =~ /(\d{3})-(\d{3})/ );
 
  +
my $sxn_disp = '';
print "$crs-$sxn..";
+
my ( $crs, $sxn ) = ( 0, 0 );
  +
if ( $crsName =~ /ma(\d{3})-(\d{3})/ ) {
  +
($crs, $sxn ) = ( $1, $2 );
  +
$sxn_disp = "-$sxn";
  +
} else {
  +
( $crs ) = ( $crsName =~ /(\d{3})-[fwsu]\d\d/ );
  +
$sxn = $savedSxnNums{$crsName};
  +
$sxn_disp = '';
  +
}
  +
print "$crs$sxn_disp..";
 
 
$oldDroppedStu{$crsName} = [ ];
+
$oldDroppedStu{$crsName} = [ ];
 
 
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
+
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
courseName => $crsName});
+
courseName => $crsName});
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
+
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
 
 
my @userIDList = $db->listUsers();
+
my @userIDList = $db->listUsers();
 
# exclude proctor users
 
# exclude proctor users
my @users = grep {$_->section() ne '999'} $db->getUsers(@userIDList);
+
my @users = grep {$_->section() ne '999'} $db->getUsers(@userIDList);
 
 
$oldCourseLists{$crsName} = [ ];
+
$oldCourseLists{$crsName} = [ ];
foreach ( @users ) {
+
foreach ( @users ) {
if ( $_->status() eq 'D' ) {
+
if ( $_->status() eq 'D' ) {
push( @{$oldDroppedStu{$crsName}}, $_->user_id() );
+
push( @{$oldDroppedStu{$crsName}}, $_->user_id() );
 
 
} else {
+
} else {
 
 
my $userPermLvl = $db->getPermissionLevel( $_->user_id() );
+
my $userPermLvl = $db->getPermissionLevel( $_->user_id() );
 
 
if ( $userPermLvl->permission() > 0 ) {
+
if ( $userPermLvl->permission() > 0 ) {
push( @adminUsers, $_->user_id() );
+
push( @adminUsers, $_->user_id() );
next;
+
next;
} else {
+
} else {
if ( defined($oldRosters{$_->user_id()}) ) {
+
if ( defined($oldRosters{$_->user_id()}) ) {
if ( defined($oldMultipleRosters{$_->user_id()}) ) {
+
if ( defined($oldMultipleRosters{$_->user_id()}) ) {
push( @{$oldMultipleRosters{$_->user_id()}},
+
push( @{$oldMultipleRosters{$_->user_id()}},
$crsName );
+
$crsName );
} else {
+
} else {
my $ocrsName = $oldRosters{$_->user_id()}->[0];
+
my $ocrsName = $oldRosters{$_->user_id()}->[0];
$oldMultipleRosters{$_->user_id()} = [ $ocrsName,
+
$oldMultipleRosters{$_->user_id()} = [ $ocrsName,
$crsName ];
+
$crsName ];
}
+
}
} else {
+
} else {
$oldRosters{$_->user_id()} = [ $crsName, $crs, $sxn,
+
$oldRosters{$_->user_id()} = [ $crsName, $crs,
$_->student_id(),
+
$_->section(),
$_->last_name(),
+
$_->student_id(),
$_->first_name() ];
+
$_->last_name(),
push( @{$oldCourseLists{$crsName}}, $_->user_id() );
+
$_->first_name() ];
}
+
push( @{$oldCourseLists{$crsName}}, $_->user_id() );
}
+
}
}
+
}
}
+
}
  +
}
 
 
 
# also get a list of the sets for this course
 
# also get a list of the sets for this course
my @userSets = ();
+
my @userSets = ();
my @globalSets = $db->listGlobalSets();
+
my @globalSets = $db->listGlobalSets();
foreach my $setID ( @globalSets ) {
+
foreach my $setID ( @globalSets ) {
push( @userSets, $setID ) if ( $db->countSetUsers($setID) );
+
push( @userSets, $setID ) if ( $db->countSetUsers($setID) &&
}
+
! grep(/^$setID$/, @groupSets) &&
$setNames{$crsName} = [ @userSets ];
+
( ! defined($skipAssignments{$crs})
  +
or $setID !~ /$skipAssignments{$crs}/ ) );
  +
}
  +
$setNames{$crsName} = [ @userSets ];
 
}
 
}
 
 
Line 1,796: Line 1,882:
 
### update loop: loop through each course we're updating
 
### update loop: loop through each course we're updating
 
foreach my $crsName ( @updateCrses ) {
 
foreach my $crsName ( @updateCrses ) {
if ( isIn( $crsName, @skipClassNames ) ) {
+
if ( isIn( $crsName, @skipClassNames ) ) {
print "[$crsName skipped]..";
+
print "[$crsName skipped]..";
next;
+
next;
}
+
}
my ( $crs, $sxn ) = ( $crsName =~ /(\d{3})-(\d{3})/ );
+
my $sxn_disp = '';
print "$crs-$sxn..";
+
my ( $crs, $sxn ) = ( 0, 0 );
  +
if ( $crsName =~ /(\d{3})-(\d{3})/ ) {
  +
($crs, $sxn ) = ( $1, $2 );
  +
$sxn_disp = "-$sxn";
  +
} else {
  +
( $crs ) = ( $crsName =~ /(\d{3})-[fwsu]\d\d/ );
  +
$sxn = $savedSxnNums{$crsName};
  +
$sxn_disp = '';
  +
}
  +
print "$crs$sxn_disp..";
 
 
 
# keep a list of adds, who need to have sets assigned in this course
 
# keep a list of adds, who need to have sets assigned in this course
my @usersSetAssign = ();
+
my @usersSetAssign = ();
  +
# and any for whom we need to copy work
  +
my @usersCopyWork = ();
 
 
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
+
my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
courseName => $crsName});
+
courseName => $crsName});
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
+
my $db = WeBWorK::DB->new( $ce->{dbLayout} );
 
 
 
### inner update loop: loop through each student in the new course roster
 
### inner update loop: loop through each student in the new course roster
foreach my $uniq ( @{$newCourseLists{$crsName}} ) {
+
foreach my $uniq ( @{$newCourseLists{$crsName}} ) {
 
 
next if ( isIn( $uniq, @adminUsers ) ||
+
next if ( isIn( $uniq, @adminUsers ) ||
defined( $newMultipleRosters{$uniq} ) );
+
defined( $newMultipleRosters{$uniq} ) );
 
 
 
# keep track of what's going on with old course enrollments: in
 
# keep track of what's going on with old course enrollments: in
Line 1,821: Line 1,907:
 
# only use the fact that a student is or is not enrolled in a
 
# only use the fact that a student is or is not enrolled in a
 
# section of the current course, not the list of section numbers.)
 
# section of the current course, not the list of section numbers.)
my %oldSectionNum = ();
+
my %oldSectionNum = ();
if ( defined( $oldRosters{$uniq} ) ) {
+
if ( defined( $oldRosters{$uniq} ) ) {
if ( defined( $oldMultipleRosters{$uniq} ) ) {
+
if ( defined( $oldMultipleRosters{$uniq} ) ) {
foreach my $oldCrsName ( @{$oldMultipleRosters{$uniq}} ) {
+
foreach my $oldCrsName ( @{$oldMultipleRosters{$uniq}} ) {
my ( $oldCrs, $oldSxn ) =
+
my ( $oldCrs, $oldSxn ) = ( 0, 0 );
( $oldCrsName =~ /(\d{3})-(\d{3})/ );
+
if ( $oldCrsName =~ /(\d{3})-(\d{3})/ ) {
if ( defined( $oldSectionNum{$oldCrs} ) ) {
+
($oldCrs, $oldSxn ) = ( $1, $2 );
push( @{$oldSectionNum{$oldCrs}}, $oldSxn );
+
} else {
} else {
+
( $oldCrs ) = ($oldCrsName =~ /(\d{3})-[fwsu]\d\d/);
$oldSectionNum{$oldCrs} = [ $oldSxn ];
+
$oldSxn = $savedSxnNums{$oldCrsName};
}
+
}
}
 
} else {
 
$oldSectionNum{$oldRosters{$uniq}->[1]} =
 
[ $oldRosters{$uniq}->[2] ];
 
}
 
}
 
 
 
  +
if ( defined( $oldSectionNum{$oldCrs} ) ) {
  +
push( @{$oldSectionNum{$oldCrs}}, $oldSxn );
  +
} else {
  +
$oldSectionNum{$oldCrs} = [ $oldSxn ];
  +
}
  +
}
  +
} else {
  +
$oldSectionNum{$oldRosters{$uniq}->[1]} =
  +
[ $oldRosters{$uniq}->[2] ];
  +
}
  +
}
 
# first, anyone who is in the new roster and wasn't in the class
 
# first, anyone who is in the new roster and wasn't in the class
 
# before needs to be added
 
# before needs to be added
if ( ( ! defined( $oldRosters{$uniq} ) ||
+
if ( ( ! defined( $oldRosters{$uniq} ) ||
! defined( $oldSectionNum{$crs} ) ) &&
+
! defined( $oldSectionNum{$crs} ) ) &&
! isIn( $uniq, @{$oldDroppedStu{$crsName}} ) ) {
+
! isIn( $uniq, @{$oldDroppedStu{$crsName}} ) ) {
my ( $cn, $c, $s, $umid, $lname, $fname ) =
+
my ( $cn, $c, $s, $umid, $lname, $fname ) =
@{$newRosters{$uniq}};
+
@{$newRosters{$uniq}};
 
 
my $newUser = $db->newUser;
+
my $newUser = $db->newUser;
my $newPermissionLevel = $db->newPermissionLevel;
+
my $newPermissionLevel = $db->newPermissionLevel;
my $newPassword = $db->newPassword;
+
my $newPassword = $db->newPassword;
 
 
$newUser->user_id( $uniq );
+
$newUser->user_id( $uniq );
$newPermissionLevel->user_id($uniq);
+
$newPermissionLevel->user_id($uniq);
$newPassword->user_id($uniq);
+
$newPassword->user_id($uniq);
my $salt =
+
my $salt =
join("",
+
join("",
('.','/','0'..'9','A'..'Z','a'..'z')[rand 64,rand 64]);
+
('.','/','0'..'9','A'..'Z','a'..'z')[rand 64,rand 64]);
$newPassword->password(crypt($umid, $salt));
+
$newPassword->password(crypt($umid, $salt));
$newUser->last_name($lname);
+
$newUser->last_name($lname);
$newUser->first_name($fname);
+
$newUser->first_name($fname);
$newUser->student_id($umid);
+
$newUser->student_id($umid);
$newUser->email_address("$uniq\@$mailDomain");
+
$newUser->email_address("$uniq\@$mailDomain");
$newUser->section($sxn);
+
$newUser->section($s);
$newUser->recitation($sxn);
+
$newUser->recitation($s);
$newUser->comment('');
+
$newUser->comment('');
$newUser->status($ce->status_name_to_abbrevs($ce->{default_status}));
+
$newUser->status($ce->status_name_to_abbrevs($ce->{default_status}));
$newPermissionLevel->permission(0);
+
$newPermissionLevel->permission(0);
 
 
eval( $db->addUser( $newUser ) );
+
eval( $db->addUser( $newUser ) );
# print " * addUser ($uniq, $umid, $lname, $fname)\n";
+
# print " * addUser ($uniq, $umid, $lname, $fname)\n";
if ( $@ ){
+
if ( $@ ){
# if ( 0 ) {
+
# if ( 0 ) {
print " * error adding user $uniq ($fname $lname) " .
+
print " * error adding user $uniq ($fname $lname) " .
"to $crs-$sxn: $@\n";
+
"to $crs-$sxn: $@\n";
next;
+
next;
} else {
+
} else {
$db->addPermissionLevel($newPermissionLevel);
+
$db->addPermissionLevel($newPermissionLevel);
$db->addPassword($newPassword);
+
$db->addPassword($newPassword);
# print " addPermissions($uniq, 0)\n";
+
# print " addPermissions($uniq, 0)\n";
# print " addPassword($uniq, " . $newPassword->password . ")\n";
+
# print " addPassword($uniq, " . $newPassword->password . ")\n";
push( @adds, [ $crs, $sxn, $uniq, $umid, $lname, $fname ]);
+
push( @adds, [ $crs, $s, $uniq, $umid, $lname, $fname ]);
}
+
}
 
 
# also store the student to assign sets to them at the end of
+
# also store the student to assign sets to them at the end of
# the course loop
+
# the course loop
push( @usersSetAssign, $uniq );
+
push( @usersSetAssign, $uniq )
  +
if (! $fileExt || $courseCampusBuildSets{$fileExt});
 
 
 
# next catch anyone who is in the old roster, but has a status of 'D':
 
# next catch anyone who is in the old roster, but has a status of 'D':
 
# we just reset them to 'C'; we don't try and catch their set data
 
# we just reset them to 'C'; we don't try and catch their set data
 
# if they were surfing between multiple sections...
 
# if they were surfing between multiple sections...
} elsif ( isIn( $uniq, @{$oldDroppedStu{$crsName}} ) ) {
+
} elsif ( isIn( $uniq, @{$oldDroppedStu{$crsName}} ) ) {
my $user = $db->getUser( $uniq );
+
my $user = $db->getUser( $uniq );
$user->status( 'C' );
+
$user->status( 'C' );
$db->putUser( $user );
+
$db->putUser( $user );
push( @reups, [ $crs, $sxn, $uniq, $user->student_id(),
+
push( @reups, [ $crs, $user->section(), $uniq,
$user->last_name(), $user->first_name() ] );
+
$user->student_id(),
  +
$user->last_name(), $user->first_name() ] );
 
 
 
# next, anyone who is in both one new and one old roster, and is in the
 
# next, anyone who is in both one new and one old roster, and is in the
Line 1,896: Line 1,993:
 
# they are enrolled in multiple sections), we don't tamper with their
 
# they are enrolled in multiple sections), we don't tamper with their
 
# data and just drop them from the old sections
 
# data and just drop them from the old sections
} elsif ( defined( $oldRosters{$uniq} ) &&
+
} elsif ( defined( $oldRosters{$uniq} ) &&
! defined( $oldMultipleRosters{$uniq} ) &&
+
! defined( $oldMultipleRosters{$uniq} ) &&
$oldRosters{$uniq}->[1] eq $crs &&
+
$oldRosters{$uniq}->[1] eq $crs &&
$oldRosters{$uniq}->[2] ne $sxn ) {
+
$oldRosters{$uniq}->[2] ne $newRosters{$uniq}->[2] ) {
  +
  +
my $odb;
  +
my $oCrsName = $oldRosters{$uniq}->[0];
  +
my $oCrs = $oldRosters{$uniq}->[1];
  +
my $oSxn = $oldRosters{$uniq}->[2];
  +
my $exists = 0;
  +
# if the webwork course includes multiple sections, then the
  +
# student already exists in the course and we just have to update
  +
# her/his section number and possibly status; in this case we use
  +
# the existing database and don't reset passwords and permissions.
  +
# this can also happen if a user was entered manually with incorrect
  +
# section/recitation data.
  +
# otherwise we need to get the database for the old course and pull
  +
# user data from there
  +
if ( $multiSectionCourses{$crs} ||
  +
$oCrsName eq $crsName ) {
  +
$odb = $db;
  +
$exists = 1;
  +
} else {
  +
# first, bring up a new course environment and db for the
  +
# student's old course
  +
my $oce =
  +
WeBWorK::CourseEnvironment->new({webwork_dir=>$wwHome,
  +
courseName=>$oCrsName});
  +
$odb = WeBWorK::DB->new( $oce->{dbLayout} );
  +
}
  +
  +
# the old student user information is then
  +
my $oldUser = $odb->getUser( $uniq );
  +
$oldUser->status('C');
  +
$oldUser->section( $newRosters{$uniq}->[2] );
  +
$oldUser->recitation( $newRosters{$uniq}->[2] );
 
 
# first, let's bring up a new course environment and db for the
 
  +
# save this as appropriate.
# student's old course
 
  +
if ( $exists ) {
my $oCrsName = $oldRosters{$uniq}->[0];
 
  +
eval( $db->putUser( $oldUser ) );
my $oCrs = $oldRosters{$uniq}->[1];
 
my $oSxn = $oldRosters{$uniq}->[2];
 
my $oce =
 
WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
 
courseName => $oCrsName});
 
my $odb = WeBWorK::DB->new( $oce->{dbLayout} );
 
 
 
# the old student user information is then
 
  +
if ( $@ ) {
my $oldUser = $odb->getUser( $uniq );
 
  +
print " * error moving user $uniq from $oCrs-$oSxn " .
$oldUser->status('C');
 
  +
"to $crs-$sxn: $@\n";
$oldUser->section( $sxn );
 
  +
next;
$oldUser->recitation( $sxn );
 
  +
}
my $oldPerm = $odb->getPermissionLevel( $uniq );
 
  +
} else {
my $oldPass = $odb->getPassword( $uniq );
 
  +
eval( $db->addUser( $oldUser ) );
# save this in the new course.
 
  +
if ( $@ ) {
eval( $db->addUser( $oldUser ) );
 
  +
print " * error moving user $uniq from $oCrs-$oSxn " .
if ( $@ ) {
 
  +
"to $crs-$sxn: $@\n";
print " * error moving user $uniq from $oCrs-$oSxn " .
 
  +
next;
"to $crs-$sxn: $@\n";
 
  +
} else {
next;
 
  +
my $oldPerm = $odb->getPermissionLevel( $uniq );
} else {
 
  +
my $oldPass = $odb->getPassword( $uniq );
$db->addPermissionLevel( $oldPerm );
+
$db->addPermissionLevel( $oldPerm );
$db->addPassword( $oldPass );
+
$db->addPassword( $oldPass );
 
 
# for now, we don't try and move scores
 
  +
# we create a new set of assignments for the student, and
if ( 0 ) {
 
  +
# then see what we can or should copy from the old course
  +
push( @usersSetAssign, $uniq )
  +
if (! $fileExt || $courseCampusBuildSets{$fileExt});
  +
# should we be moving data?
  +
if ( $copyWork && ! $exists &&
  +
( ! $fileExt || $copyWorkForCampuses ) ) {
  +
push( @usersCopyWork,
  +
[ $uniq, $oCrsName, $crsName ] );
  +
}
  +
# my $ruser =
  +
# $ce->{dbLayout}->{password}->{params}->{usernameRO};
  +
# my $rpass =
  +
# $ce->{dbLayout}->{password}->{params}->{passwordRO};
  +
# my $wuser =
  +
# $ce->{dbLayout}->{password}->{params}->{usernameRW};
  +
# my $wpass =
  +
# $ce->{dbLayout}->{password}->{params}->{passwordRW};
 
 
# then, we see what we can do with scores...
 
  +
# my $oldCrs = $oldRosters{$uniq}->[0];
# get a list of all of the sets from the old course and add them
 
  +
# my $newCrs = $newRosters{$uniq}->[0];
# to the new one
 
my @oldSetIDs = $odb->listUserSets( $uniq );
 
my @oldSetList = ();
 
foreach ( @oldSetIDs ) {
 
push( @oldSetList, [ $uniq, $_ ] );
 
}
 
my @oldUserSets = $odb->getUserSets( @oldSetList );
 
foreach ( @oldUserSets ) {
 
eval( $db->addUserSet( $_ ) );
 
if ( $@ ) {
 
print " * error adding set ", $_->set_id(),
 
" to user ", $uniq, ": $@\n";
 
next;
 
}
 
}
 
# we also want all versioned sets
 
my @oldVSetIDs = $odb->listUserSetVersions( $uniq );
 
my @oldVSetList = ();
 
foreach ( @oldVSetIDs ) {
 
push( @oldVSetList, [ $uniq, $_ ] );
 
}
 
my @oldVUserSets = $odb->getUserSets( @oldVSetList );
 
foreach ( @oldVUserSets ) {
 
$db->addVersionedUserSet( $_ );
 
}
 
 
 
# also get all of the problem data for these
 
  +
# my $cmd = "mysqldump -u $ruser --password=$rpass " .
foreach my $setID ( @oldSetIDs, @oldVSetIDs ) {
 
  +
# "--no-create-db " .
my @oldProblems =
 
  +
# "--no-create-info --where \"user_id='" . $uniq .
$db->getAllUserProblems($uniq,$setID);
 
  +
# "'\" webwork ${oldCrs}_user ${oldCrs}_password " .
foreach ( @oldProblems ) {
 
  +
# "${oldCrs}_permission ${oldCrs}_key " .
eval( $db->putUserProblem( $_ ) );
 
  +
# "${oldCrs}_set_user ${oldCrs}_problem_user | " .
if ( $@ ) {
 
  +
# "sed 's/" . $oldCrs . '/' . $newCrs . "/g' | " .
print " * error adding problems, from ",
 
  +
# "mysql -u $wuser --password=$wpass webwork";
"prob ", $_->problem_id(),
 
  +
# # print " * change command:\n $cmd\n";
" to set $setID for ",
 
  +
# # system( $cmd );
"user $uniq: $@\n";
 
  +
# # print " * (mv) putUser($uniq, " . $oldUser->status . ")\n";
last;
 
  +
}
}
 
  +
}
}
 
}
 
} else {
 
# we don't move the user data, just give them all a new set of hw
 
push( @usersSetAssign, $uniq );
 
}
 
 
 
push( @chgs, [ $oldRosters{$uniq}->[1] . "->" .
+
push( @chgs, [ $oldRosters{$uniq}->[1] . "->" .
$newRosters{$uniq}->[1],
+
$newRosters{$uniq}->[1],
$oldRosters{$uniq}->[2] . "->" .
+
$oldRosters{$uniq}->[2] . "->" .
$newRosters{$uniq}->[2], $uniq,
+
$newRosters{$uniq}->[2], $uniq,
@{$newRosters{$uniq}}[3..5] ] );
+
@{$newRosters{$uniq}}[3..5] ] );
}
+
}
}
+
}
}
+
### end inner update loop: foreach $uniq in @{$newCourseLists{$crsName}}
### end inner update loop: foreach $uniq in @{$newCourseLists{$crsName}}
 
 
 
 
# make sure that anyone who is in multiple old rosters is indicated as dropped
 
# make sure that anyone who is in multiple old rosters is indicated as dropped
 
# in this course section
 
# in this course section
foreach my $dupUniq ( keys %oldMultipleRosters ) {
+
foreach my $dupUniq ( keys %oldMultipleRosters ) {
foreach my $dupCrsName ( @{$oldMultipleRosters{$dupUniq}} ) {
+
foreach my $dupCrsName ( @{$oldMultipleRosters{$dupUniq}} ) {
if ( $crsName eq $dupCrsName &&
+
if ( $crsName eq $dupCrsName &&
! isIn( $dupUniq, @{$newCourseLists{$crsName}} ) ) {
+
! isIn( $dupUniq, @{$newCourseLists{$crsName}} ) ) {
# we know that the user is (also) in this course, or else we
+
# we know that the user is (also) in this course, or else we
# wouldn't have added the course to $oldMultipleRosters{uniq}
+
# wouldn't have added the course to $oldMultipleRosters{uniq}
my $dupUser = $db->getUser( $dupUniq );
+
my $dupUser = $db->getUser( $dupUniq );
$dupUser->status('D');
+
$dupUser->status('D');
$db->putUser( $dupUser );
+
$db->putUser( $dupUser );
# print " * (dup) putUser($dupUniq, " . $dupUser->status . ")\n";
+
# print " * (dup) putUser($dupUniq, " . $dupUser->status . ")\n";
push( @dels, [ $crs, $sxn, $dupUniq,
+
push( @dels, [ $crs, $dupUser->section(), $dupUniq,
$dupUser->student_id(),
+
$dupUser->student_id(),
$dupUser->last_name(),
+
$dupUser->last_name(),
$dupUser->first_name() ] );
+
$dupUser->first_name() ] );
} elsif ( $crsName eq $dupCrsName ) {
+
} elsif ( $crsName eq $dupCrsName ) {
# store skips with the course-section they are actually in
+
# store skips with the course-section they are actually in
push( @skps, [ $crs, $sxn, $dupUniq ] );
+
push( @skps, [ $crs, $sxn, $dupUniq ] );
}
+
}
}
+
}
}
+
}
 
 
 
# finally, anyone who is in the old roster but not the new needs to be dropped
 
# finally, anyone who is in the old roster but not the new needs to be dropped
 
# we're a little careful here, and don't drop anyone who has better than
 
# we're a little careful here, and don't drop anyone who has better than
 
# student privileges
 
# student privileges
foreach my $uniq ( @{$oldCourseLists{$crsName}} ) {
+
foreach my $uniq ( @{$oldCourseLists{$crsName}} ) {
if ( ! isIn( $uniq, @{$newCourseLists{$crsName}} ) &&
+
if ( ! isIn( $uniq, @{$newCourseLists{$crsName}} ) &&
! defined( $oldMultipleRosters{$uniq} ) ) {
+
! defined( $oldMultipleRosters{$uniq} ) ) {
 
 
my $userPermLvl = $db->getPermissionLevel($uniq);
+
my $userPermLvl = $db->getPermissionLevel($uniq);
next if ( $userPermLvl->permission > 0 );
+
next if ( $userPermLvl->permission > 0 );
my $delUser = $db->getUser( $uniq );
+
my $delUser = $db->getUser( $uniq );
$delUser->status( 'D' );
+
$delUser->status( 'D' );
$db->putUser( $delUser );
+
$db->putUser( $delUser );
# print " * putUser($uniq, " . $delUser->status . ")\n";
+
# print " * putUser($uniq, " . $delUser->status . ")\n";
push( @dels, [ $crs, $sxn, $uniq, $delUser->student_id(),
+
push( @dels, [ $crs, $sxn, $uniq, $delUser->student_id(),
$delUser->last_name(),
+
$delUser->last_name(),
$delUser->first_name() ] );
+
$delUser->first_name() ] );
}
+
}
} # end of loop through uniqs in the old course rosters
+
} # end of loop through uniqs in the old course rosters
 
 
 
# make set assignments to all new users
 
# make set assignments to all new users
if ( @usersSetAssign ) {
+
if ( @usersSetAssign ) {
my $fr = new FakeRequest();
+
my $fr = new FakeRequest();
$fr->db( $db );
+
$fr->db( $db );
$fr->ce( $ce );
+
$fr->ce( $ce );
my $instrCG = WeBWorK::ContentGenerator::Instructor->new($fr);
+
my $instrCG = WeBWorK::ContentGenerator::Instructor->new($fr);
$instrCG->assignSetsToUsers( $setNames{$crsName},
+
$instrCG->assignSetsToUsers( $setNames{$crsName},
[@usersSetAssign] );
+
[@usersSetAssign] );
}
+
}
  +
# are there any users for whom we need to copy work?
  +
if ( @usersCopyWork ) {
  +
# we are doing this manually, without using the WeBWorK database,
  +
# so bring up a DBI object
  +
my $old_course = $usersCopyWork[0]->[1];
  +
my $db = "DBI:mysql:webwork";
  +
my $ce = WeBWorK::CourseEnvironment->new(
  +
{ webwork_dir => $wwHome, courseName => $old_course } );
  +
my $ww_user = $ce->{dbLayout}->{password}->{params}->{username};
  +
my $ww_pass = $ce->{dbLayout}->{password}->{params}->{password};
  +
if ( ! $ww_user || ! $ww_pass ) {
  +
warn( " ** aborting copy work: failed to find WW user " .
  +
"or pass\n" );
  +
last;
  +
}
  +
  +
my $err;
  +
my $dbHandle = DBI->connect( $db, $ww_user, $ww_pass,
  +
{PrintError=>0, RaiseError=>0} ) or
  +
$err = DBI::errstr;
  +
if ( $err ) {
  +
warn( " ** aborting copy work: DB connect failed: " .
  +
"$err\n" );
  +
last;
  +
}
  +
  +
foreach my $copyData ( @usersCopyWork ) {
  +
my ( $cuniq, $cocrsname, $cncrsname ) = @{$copyData};
  +
my ( $error, $message ) =
  +
copyWork( $crs, $cuniq, $cocrsname, $cncrsname, $dbHandle );
  +
if ( $error ) {
  +
warn( " ** aborting copy work: error $message\n" );
  +
last;
  +
}
  +
}
  +
}
 
}
 
}
 
### end of update loop: foreach $crsName in ( @updateCrses ) loop
 
### end of update loop: foreach $crsName in ( @updateCrses ) loop
Line 2,046: Line 2,122:
 
print " * added students: \n" if ( @adds );
 
print " * added students: \n" if ( @adds );
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
$b->[0].$b->[1].$b->[4].$b->[5] } @adds ) {
+
$b->[0].$b->[1].$b->[4].$b->[5] } @adds ) {
print " $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
+
print " $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
# print "\n [ " . join(', ', @$_) . " ]";
+
# print "\n [ " . join(', ', @$_) . " ]";
 
}
 
}
 
print " * reenrolled students: \n" if ( @reups );
 
print " * reenrolled students: \n" if ( @reups );
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
$b->[0].$b->[1].$b->[4].$b->[5] } @reups ) {
+
$b->[0].$b->[1].$b->[4].$b->[5] } @reups ) {
print " $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
+
print " $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
 
}
 
}
 
# weed out of the dels students who were moved
 
# weed out of the dels students who were moved
Line 2,061: Line 2,137:
 
print "\n * dropped students: \n" if ( @reallyDels );
 
print "\n * dropped students: \n" if ( @reallyDels );
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
$b->[0].$b->[1].$b->[4].$b->[5] } @reallyDels ) {
+
$b->[0].$b->[1].$b->[4].$b->[5] } @reallyDels ) {
print " $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
+
print " $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
# print "\n [ " . join(', ', @$_) . " ]";
+
# print "\n [ " . join(', ', @$_) . " ]";
 
}
 
}
 
print "\n * moved students: \n" if ( @chgs );
 
print "\n * moved students: \n" if ( @chgs );
 
# foreach ( sort { $a->[4] cmp $b->[4] } @chgs ) {
 
# foreach ( sort { $a->[4] cmp $b->[4] } @chgs ) {
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
 
foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp
$b->[0].$b->[1].$b->[4].$b->[5] } @chgs ) {
+
$b->[0].$b->[1].$b->[4].$b->[5] } @chgs ) {
my $on = $_->[0] . "," . $_->[1];
+
my $on = $_->[0] . "," . $_->[1];
$on =~ s/(\d{3})->(\d{3}),(\d{3})->(\d{3})/$1-$3=>$2-$4/;
+
$on =~ s/(\d{3})->(\d{3}),(\d{3})->(\d{3})/$1-$3=>$2-$4/;
# print "$_->[4] ($on), ";
+
# print "$_->[4] ($on), ";
print " $on : $_->[2] ($_->[5] $_->[4])\n";
+
print " $on : $_->[2] ($_->[5] $_->[4])\n";
 
}
 
}
 
print "\n * students in multiple old sections: " if ( @skps );
 
print "\n * students in multiple old sections: " if ( @skps );
 
foreach ( sort { $a->[2] cmp $b->[2] } @skps ) {
 
foreach ( sort { $a->[2] cmp $b->[2] } @skps ) {
my $ocrsList = '';
+
my $ocrsList = '';
foreach my $cn ( @{$oldMultipleRosters{$_->[2]}} ) {
+
foreach my $cn ( @{$oldMultipleRosters{$_->[2]}} ) {
my ( $c, $s ) = ( $cn =~ /(\d{3})-(\d{3})/ );
+
my ( $c, $s ) = ( $cn =~ /(\d{3})-(\d{3})/ );
$ocrsList .= "$c-$s,";
+
$ocrsList .= "$c-$s,";
}
+
}
$ocrsList =~ s/,$//;
+
$ocrsList =~ s/,$//;
print "$_->[2] ([n] $_->[0]-$_->[1]; [o] $ocrsList), ";
+
print "$_->[2] ([n] $_->[0]-$_->[1]; [o] $ocrsList), ";
 
}
 
}
 
print "\n * students in multiple new sections (skipped): "
 
print "\n * students in multiple new sections (skipped): "
if ( %newMultipleRosters );
+
if ( %newMultipleRosters );
 
foreach ( sort { $a cmp $b } keys( %newMultipleRosters ) ) {
 
foreach ( sort { $a cmp $b } keys( %newMultipleRosters ) ) {
my $ncrsList = '';
+
my $ncrsList = '';
foreach my $cn ( @{$newMultipleRosters{$_}} ) {
+
foreach my $cn ( @{$newMultipleRosters{$_}} ) {
my ( $c, $s ) = ( $cn =~ /(\d{3})-(\d{3})/ );
+
my ( $c, $s );
$ncrsList .= "$c-$s,";
+
if ( $cn =~ /(\d{3})-(\d{3})/ ) {
}
+
$c = $1;
$ncrsList =~ s/,$//;
+
$s = $2;
print "$_ ($ncrsList), ";
+
} elsif ( $cn =~ /(\d{3})-[fwsu]\d\d/ ) {
  +
$c = $1;
  +
$s = 'xxx';
  +
} else {
  +
$c = '?';
  +
$s = '?';
  +
}
  +
$ncrsList .= "$c-$s,";
  +
}
  +
$ncrsList =~ s/,$//;
  +
print "$_ ($ncrsList), ";
 
}
 
}
 
print "\n" if ( @adds || @dels || @chgs || @reups || %newMultipleRosters );
 
print "\n" if ( @adds || @dels || @chgs || @reups || %newMultipleRosters );
 
print " * done.\n";
 
print " * done.\n";
  +
}
  +
  +
sub copyWork {
  +
my ( $crsNum, $user_id, $old_course, $new_course, $dbHandle ) = @_;
  +
  +
my $hsel = "select " . join(",", @copy_hwk_prob_user_fields) .
  +
" from `${old_course}_problem_user` where user_id=? and (";
  +
$hsel .= join( " and ", ( 'set_id not like ?' )x@copyNotLike ) . ")";
  +
my $err;
  +
  +
my $hsta = $dbHandle->prepare( $hsel ) or $err = $dbHandle->errstr();
  +
if ( $err ) {
  +
$dbHandle->disconnect();
  +
return ( 1, "Error preparing homework select command for $user_id in " .
  +
"$old_course: $err\n" );
  +
} else {
  +
if ( $hsta->execute( $user_id, @copyNotLike ) ) {
  +
my $hwValRef = $hsta->fetchall_arrayref();
  +
  +
## next go through and update the new course
  +
my $hup = "update `${new_course}_problem_user` set " .
  +
join( ", ",
  +
( map { "$_=?" }
  +
@copy_hwk_prob_user_fields[$copy_hwk_update_fields..$#copy_hwk_prob_user_fields] ) ) .
  +
" where " .
  +
join( " and ", ( map { "$_=?" }
  +
@copy_hwk_prob_user_fields[0..($copy_hwk_update_fields-1)] ) );
  +
my $hupsta = $dbHandle->prepare( $hup ) or
  +
$err = $dbHandle->errstr();
  +
# print $hup, "\n";
  +
# my $pause = <STDIN>;
  +
if ( $err ) {
  +
$dbHandle->disconnect();
  +
return ( 1, "Error preparing update homework command for " .
  +
"$user_id in $new_course: $err\n" );
  +
} else {
  +
foreach my $resRef ( @$hwValRef ) {
  +
  +
my @vals = ( @{$resRef}[$copy_hwk_update_fields..$#copy_hwk_prob_user_fields],
  +
@{$resRef}[0..($copy_hwk_update_fields-1)] );
  +
  +
# print " > " . join(", ", @vals) . "\n";
  +
if ( ! $hupsta->execute( @vals ) ) {
  +
$err = $dbHandle->errstr();
  +
$dbHandle->disconnect();
  +
return( 1,
  +
"Error updating homework values for $user_id " .
  +
"in $new_course, problem set " .
  +
$resRef->[$copy_problem_id_index] .
  +
": $err\n" );
  +
}
  +
}
  +
}
  +
  +
} else {
  +
$err = $dbHandle->errstr();
  +
$dbHandle->disconnect();
  +
return( 1, "Error executing homework select command for " .
  +
"$user_id in $old_course: $err\n" );
  +
}
  +
}
  +
  +
##----------------------------
  +
## get and copy old test data
  +
  +
my $cmd = "select COUNT(*) from `${old_course}_set_user` where " .
  +
"user_id=? and set_id like ?";
  +
my $state = $dbHandle->prepare( $cmd ) or $err = $dbHandle->errstr();
  +
if ( $err ) {
  +
$dbHandle->disconnect();
  +
return( 1, "Error preparing count command $user_id in " .
  +
"$old_course: $err\n");
  +
} else {
  +
foreach my $test ( @{$copyTests{$crsNum}} ) {
  +
my $numTests = 0;
  +
if ( $state->execute( $user_id, "$test,v%" ) ) {
  +
$numTests = $state->fetchrow_array();
  +
  +
if ( $numTests ) {
  +
my $setuserCmd = "select " .
  +
join(",", @copy_test_set_user_fields) .
  +
" from `${old_course}_set_user` where user_id=? and " .
  +
"set_id=?";
  +
my $setState = $dbHandle->prepare( $setuserCmd ) or
  +
$err = $dbHandle->errstr();
  +
  +
if ( $err ) {
  +
$dbHandle->disconnect();
  +
return( 1, "Error preparing set select statement " .
  +
"for $user_id, $test in $old_course: $err\n" );
  +
  +
} elsif ( $setState->execute( $user_id,
  +
"$test,v$numTests") ) {
  +
  +
my @setRes = $setState->fetchrow_array();
  +
  +
my $insertCmd = "insert into " .
  +
"`${new_course}_set_user` " .
  +
"(" . join(", ", @copy_test_set_user_fields) .
  +
") values (" .
  +
join(", ", map { "?" } @copy_test_set_user_fields) .
  +
")";
  +
my @insertVals = @setRes;
  +
my $newTest = "$test,v1";
  +
$insertVals[$copy_set_id_index] = $newTest;
  +
  +
my $siState = $dbHandle->prepare( $insertCmd ) or
  +
$err = $dbHandle->errstr();
  +
if ( $err ) {
  +
$dbHandle->disconnect();
  +
return( 1, "Error preparing set insertion " .
  +
"command for $user_id, $test in " .
  +
"$new_course: $err\n" );
  +
} elsif ( $siState->execute( @insertVals ) ) {
  +
  +
my $probuserCmd = "select " .
  +
join(",", @copy_test_prob_user_fields) .
  +
" from `${old_course}_problem_user` where " .
  +
"user_id=? and set_id=?";
  +
my $probState =
  +
$dbHandle->prepare( $probuserCmd ) or
  +
$err = $dbHandle->errstr();
  +
if ( $err ) {
  +
$dbHandle->disconnect();
  +
return( 1, "Error preparing problem select " .
  +
"statement for $user_id, $test in " .
  +
"$old_course: $err\n");
  +
  +
} elsif ($probState->execute($user_id,
  +
$setRes[$copy_set_id_index])) {
  +
  +
my $probRes = $probState->fetchall_arrayref();
  +
  +
my $pInsertCmd = "insert into `${new_course}" .
  +
"_problem_user` (" .
  +
join(", ", @copy_test_prob_user_fields) .
  +
") values" .
  +
" (" .
  +
join(", ",
  +
map {"?"} @copy_test_prob_user_fields) .
  +
")";
  +
  +
my $piState =
  +
$dbHandle->prepare( $pInsertCmd ) or
  +
$err = $dbHandle->errstr();
  +
if ( $err ) {
  +
$dbHandle->disconnect();
  +
return( 1, "Error preparing problem " .
  +
"insert statement for $user_id, " .
  +
"$test, $new_course: $err\n" );
  +
} else {
  +
  +
foreach my $resRef ( @$probRes ) {
  +
my @pInsertVals = @$resRef;
  +
$pInsertVals[$copy_problem_set_id_index] =
  +
$newTest;
  +
  +
if ( $piState->execute(@pInsertVals) ) {
  +
next;
  +
} else {
  +
$err = $dbHandle->errstr();
  +
$dbHandle->disconnect();
  +
return(
  +
1,
  +
"Error inserting problem " .
  +
"data for $user_id, $test, " .
  +
"$new_course, problem " .
  +
"$pInsertVals[$copy_problem_id_index]" .
  +
": $err\n" );
  +
}
  +
}
  +
}
  +
} else {
  +
$err = $dbHandle->errstr();
  +
$dbHandle->disconnect();
  +
return( 1, "Error executing problem select " .
  +
"command for $user_id, $test in " .
  +
"$old_course: $err\n" );
  +
}
  +
} else {
  +
$err = $dbHandle->errstr();
  +
$dbHandle->disconnect();
  +
return( 1, "Error executing set insertion " .
  +
"command for user $user_id, $test in " .
  +
"$new_course: $err\n" );
  +
}
  +
} else {
  +
$err = $dbHandle->errstr();
  +
$dbHandle->disconnect();
  +
return( 1, "Error executing select statement for " .
  +
"$user_id, $test in $old_course: $err\n" );
  +
}
  +
}
  +
} else {
  +
$err = $dbHandle->errstr();
  +
$dbHandle->disconnect();
  +
return( 1, "Error executing count for $user_id and $test in " .
  +
"$old_course: $err ($numTests)\n" );
  +
}
  +
}
  +
}
  +
return( 0, '' );
 
}
 
}
 
 
Line 2,106: Line 2,384:
 
my @fields = ();
 
my @fields = ();
 
while ( $line ) {
 
while ( $line ) {
my $term = '';
+
my $term = '';
if ( $line =~ /^"/ ) { #"
+
if ( $line =~ /^"/ ) { #"
$line = substr( $line, 1 ); # bite off quote
+
$line = substr( $line, 1 ); # bite off quote
my $ind = index( $line, '"' ); # "
+
my $ind = index( $line, '"' ); # "
$term = substr( $line, 0, $ind );
+
$term = substr( $line, 0, $ind );
$line = ( $term =~ "$line," ) ? '' : substr( $line, $ind+1 );
+
$line = ( $term =~ "$line," ) ? '' : substr( $line, $ind+1 );
 
# get rid of any trailing comma
 
# get rid of any trailing comma
$line =~ s/^,//;
+
$line =~ s/^,//;
 
 
} else {
+
} else {
my $ind = index( $line, ',' );
+
my $ind = index( $line, ',' );
if ( $ind > 0 ) {
+
if ( $ind > 0 ) {
$term = substr( $line, 0, $ind );
+
$term = substr( $line, 0, $ind );
$line = substr( $line, $ind );
+
$line = substr( $line, $ind );
$line =~ s/^,//;
+
$line =~ s/^,//;
} else {
+
} else {
$term = $line;
+
$term = $line;
$line = '';
+
$line = '';
}
+
}
}
+
}
$term =~ s/\s*(.*\S)\s*/$1/; # get rid of white space
+
$term =~ s/\s*(.*\S)\s*/$1/; # get rid of white space
push( @fields, $term );
+
push( @fields, $term );
 
}
 
}
 
return @fields;
 
return @fields;
Line 2,143: Line 2,421:
 
my @list = ();
 
my @list = ();
 
foreach ( @items ) {
 
foreach ( @items ) {
if ( $_ !~ /(\d+)|(\d+-\d+)/ ) {
+
if ( $_ !~ /(\d+)|(\d+-\d+)/ ) {
print " error in specified list!\n";
+
print " error in specified list!\n";
} elsif ( /-/ ) {
+
} elsif ( /-/ ) {
my ($min,$max) = split(/-/,$_);
+
my ($min,$max) = split(/-/,$_);
if ( $min > $max || $min < 1 || $max > $top ) {
+
if ( $min > $max || $min < 1 || $max > $top ) {
print " class number out of range!\n";
+
print " class number out of range!\n";
@list = ();
+
@list = ();
last;
+
last;
} else {
+
} else {
for ( my $i=$min; $i<=$max; $i++ ) {
+
for ( my $i=$min; $i<=$max; $i++ ) {
push(@list, $i);
+
push(@list, $i);
}
+
}
}
+
}
} else {
+
} else {
if ( $_ < 0 || $_ > $top ) {
+
if ( $_ < 0 || $_ > $top ) {
print " class number out of range!\n";
+
print " class number out of range!\n";
@list = ();
+
@list = ();
last;
+
last;
} else {
+
} else {
if ( @list && $_ == 0 ) {
+
if ( @list && $_ == 0 ) {
print " class number of zero is out of range!\n";
+
print " class number of zero is out of range!\n";
@list = ();
+
@list = ();
last;
+
last;
} else {
+
} else {
push(@list, $_);
+
push(@list, $_);
}
+
}
}
+
}
}
+
}
 
}
 
}
 
return @list;
 
return @list;
Line 2,195: Line 2,473:
 
 
 
if ( $indent + length($text) < $width ) {
 
if ( $indent + length($text) < $width ) {
$htext = " $text";
+
$htext = " $text";
 
} else {
 
} else {
foreach ( split(/\s+/, $text ) ) {
+
foreach ( split(/\s+/, $text ) ) {
if ( $indent + length($line) + length($_) >= ($width-1) ) {
+
if ( $indent + length($line) + length($_) >= ($width-1) ) {
$htext .= $line . "\n$ldr";
+
$htext .= $line . "\n$ldr";
$line = $_;
+
$line = $_;
$indent = $hang;
+
$indent = $hang;
} else {
+
} else {
$line .= " $_";
+
$line .= " $_";
}
+
}
}
+
}
$htext .= $line if ( $line );
+
$htext .= $line if ( $line );
 
}
 
}
 
$htext =~ s/\n$ldr$//;
 
$htext =~ s/\n$ldr$//;
Line 2,237: Line 2,515:
 
$self->{authz} = shift() if ( @_ );
 
$self->{authz} = shift() if ( @_ );
 
return $self->{authz};
 
return $self->{authz};
  +
}
  +
sub param {
  +
my $self = shift();
  +
$self->{$_[0]} = $_[1] if ( @_ > 1 );
  +
return $self->{$_[0]};
 
}
 
}
 
1;
 
1;

Revision as of 09:47, 14 August 2014

#!/usr/bin/perl -w
use strict;
#
# wwManage: manage webwork gateways/homework courses
# 
my $version = '1.7492';
my $lastmod = '9 Jan 2014';
# changelog:
#    1.74: add updateTermRoster function
#    1.73: improve handling of courses like ma215-s12
#    1.72: add nobuild feature for roster updates
#    1.711: add flexibility in dealing with courses like ma215-w11
#    1.71: add links in template directories of created courses
#    1.702: remove -o option, add comments, add $mailDomain variable
#    1.701: add domain extensions to e-mail addresses
#    1.70: allow inclusion of course coordinators when batch adding
#          courses
#    1.691: bug fix: correct e-mail addresses when adding courses
#    1.69: update to avoid roster saving, make batch course add the default,
#          allow for other campus extensions on roster files
#    1.68: correct year for winter terms
#    1.67: tweak definitions for current/new terms, restrict ls in listArchive,
#          handling of CSV files
#    1.66: update proctorDir
#    1.65: add option to just use existing set definition files when 
#          adding assignments
#    1.6:  update addproctors to allow add of course-specific proctors
#    1.55: take out copy of template courses in addCourses2, as that seems
#          to be introducing an error in WeBWorK
#    1.54: bugfix
#    1.53: ignore blank lines in proctor list files
#    1.52: update path to proctor page
#    1.51: clean up handling of admin addition to roster when instructor = admin
#    1.5:  debug and finish adding updateRosters() functionality (except for
#         moving course/set data)
#    1.42: add list archive feature
#    1.41: allow access to old paths with -o or --old flag
#    1.4:  update addCourses to back away from calling the addscript,
#         add archive/delete functions
#    1.32: correct use lib commands to find WeBWorK modules at compile time
#    1.31: correct prompt for delProctors()
#    1.3:  revise addProctors() to have smart path, add delProctors(),
#         make set assignment solicit which courses, add updateRosters()
#    1.23: make smart path selection
#    1.22: revise addCourses() to make filenames display for TAs and profs
#    1.21: revise addCourses() to make instructors have TA permissions
#    1.2:  add 'add proctors' function, correct @groupSets for new g/w
#    1.1:  include jan in build dates for Winter term courses, 
#         take out code to make proctored tests unpublished, 
#         eliminate noecho for admin password
#         allow no password in input for add courses, in which case we use
#           the instructors ID# for the password
#
# (c)2008 Gavin LaRose/Regents of the University of Michigan
# 
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# 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 the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
#-------------------------------------------------------------------------------
# global variables
#
my ( $archiveDir, $dataDir, $wwHome, $rosterDir, $htuser, $htgroup,
     $proctorDir, $wwCourseDir ); 
$archiveDir = '/opt/webwork/Old';
$dataDir = '/path/to/classlists/data';
$proctorDir = '/path/to/gateways/data';
 
# where do we put output webwork rosters?
$rosterDir = "/path/to/data/NEWTERM/CRS";
# do we save them at all?
my $saveWWrosters = 0;

#-------------------------
# copy data parameters
# do we copy data for student work between sections?
my $copyWork = 1;
# skip campuses?
my $copyWorkForCampuses = 0;
# default tests to copy
my %copyTests = ( 105 => [ 'ProctoredEntrGW', 'InstrProctoredEntrGW' ],
                  115 => [ 'ProctoredDerivGW', 'InstrProctoredDerivGW' ],
                  116 => [ 'ProctoredEntrGW', 'InstrProctoredEntrGW',
                           'ProctoredIntegralGW', 'InstrProctoredIntegralGW' ] 
    );
# assignments that aren't homeworks
my @copyNotLike = ( '105%', '%GW' );
# set fields to copy
my @copy_test_set_user_fields =
    ( qw( user_id set_id set_header hardcopy_header open_date due_date 
          answer_date visible enable_reduced_scoring assignment_type 
          attempts_per_version time_interval versions_per_interval 
          version_time_limit version_creation_time problem_randorder 
          version_last_attempt_time problems_per_page hide_score 
          hide_score_by_problem hide_work time_limit_cap restrict_ip 
          relax_restrict_ip restricted_login_proctor ) );
## we don't have to copy any of these for homework
my @copy_hwk_set_user_fields = ( );
## index of the set_id in the @copy_test_set_user_fields array
my $copy_set_id_index = 1;

## problem fields to copy
my @copy_test_prob_user_fields = 
    ( qw( user_id set_id problem_id source_file value max_attempts 
          problem_seed status attempted last_answer num_correct
          num_incorrect sub_status flags ) );
## homework problem fields to copy (the first $copy_hwk_update_fields
##    identify the problem and aren't copied)
my @copy_hwk_prob_user_fields = 
    ( qw( user_id set_id problem_id problem_seed status attempted 
          num_correct num_incorrect sub_status ) );
#        last_answer num_correct num_incorrect sub_status ) );
my $copy_problem_set_id_index = 1;
my $copy_problem_id_index = 2;
# update from this index in @hwk_prob_user_fields
my $copy_hwk_update_fields = 3;

# we need this because we're not using the WeBWorK database object
#    to copy work
use DBI;
#-------------------------

# a default file giving the courses and instructors to create when
#    building classes; format is
#    course#, section#, username, lastname, firstnames, id#
#    or
#    course#, section#, username, lastname, firstnames, id#, password
my $instrFile = 'instr.csv';

# these extensions on an instructor file flag that we should look
#    for alternate roster names: CRS_SXN_EXT.csv, instead of CRS_SXN.csv
my @fileCampusExt = ( '_ext' );
# and these extensions on course names similarly; the order of these
#    extensions is the same as in @fileCampusExt.  dropping the -, this
#    is also prepended to the domain in the e-mail addresses assigned
#    to users of these courses.
my @courseCampusExt = ( '-ext' );
# admin users for these extensions are:
my %courseCampusAdmins = 
    ( '-ext' => { 'user_id' => 'username',
                  'student_id' => 'idnumber',
                  'last_name' => 'lastname',
                  'first_name' => 'firstname' }, );
# we may not want to build assignments when doing roster updates for
#    these campuses
my %courseCampusBuildSets = ( '-ext' => 0 );

# course.conf additions to add, by campus
my %courseConfAdditions = 
    ( '-ext' => '$permissionLevels{view_proctored_tests} = "student";' . "\n");

# default e-mail domain
my $mailDomain = 'school.edu';

$wwHome = '/opt/webwork/webwork2';
$wwCourseDir = "$wwHome/courses";

# links to put in template directories in created courses
my %templateDirLinks = ( Library => '/opt/webwork/problembanks/' .
                             'NationalProblemLibrary',
                         Other => '/opt/webwork/problembanks/Other' );

# set environment variables to allow use of WeBWorK scripts
$ENV{WEBWORK_ROOT} = $wwHome;
$ENV{MOD_PERL_API_VERSION} = 2;

# such as the following
my $addScript = "$wwHome/bin/addcourse";
my $delScript = "$wwHome/bin/delcourse";
# command line for addcourse is (assume sql_single layout) 
#   addcourse [opts] courseID, where opts is 
#   --db-layout=layout --users=file --professors=id,id --templates-from=course
# command line for delcourse is delcourse courseID, and removes the course 
#   from the database and deletes the course directory
# load needed webwork libraries
use lib '/var/www/webwork/pg/lib';
use lib '/var/www/webwork/webwork2/lib';

use WeBWorK::PG::ImageGenerator;
use WeBWorK::CourseEnvironment;
use WeBWorK::DB;
use WeBWorK::DB::Record::User;
use WeBWorK::DB::Record::Password;
use WeBWorK::DB::Record::PermissionLevel;
use WeBWorK::ContentGenerator;              # get these to get set importing
use WeBWorK::ContentGenerator::Instructor;  #   functions
use WeBWorK::ContentGenerator::Instructor::ProblemSetList;
use WeBWorK::Utils::CourseManagement;

# define "current" academic term; this is the immediately completed term,
#   used for archiving old courses; also define new term
my @times = localtime();  my $curTerm;  my $newTerm;
my $month = $times[4] + 1;
my $year = substr($times[5],-2);
if ( $month > 9 || $month < 2 ) {  # month b/t oct & jan, inclusive
    $curTerm = "F$year";
    $newTerm = "W" . sprintf("%02d", ($month > 9 ? ($year+1) : $year));
} elsif ( $month < 6 ) {  # month before june
    $curTerm = "W$year";
    $newTerm = "S$year";
} elsif ( $month < 8 ) {  # month before august
    $curTerm = "S$year";
    $newTerm = "U$year";
} else {
    $curTerm = "U$year";
    $newTerm = "F$year";
}
# override newterm
# $newTerm = "F10";

$rosterDir =~ s/NEWTERM/$newTerm/;

# output format: format for each line of webwork course lists
#                id,  lname, fname,C , , sxn, rec, uniq           , uniq
my $wwclFormat = "%8s ,%20s ,%20s ,C , , %3s ,%3s ,%8s\@$mailDomain ,%8s\n";

my $myName = "wwManage";
# an admin user to add to all classes
my $adminUser = "username";
my $adminID = 'idnumber';    # fake id/password
my $adminLname = "lastname";
my $adminFname = "firstname";

$htuser = "apache";
$htgroup = "apache";

# list writing format variables
my ( $i1, $i2, $i3, $n1, $n2, $n3 );

# output format

my @stu_output_data;
format FN = 
@<<<<<<<<<<<<<<<<<<<<<<<<  Math @<<<<<<<  @<<<<<<<<<<@||||||||
@stu_output_data
.

# these sets are ignored when assignments are made; format
#   crs_num => pattern
my %skipAssignments = ( 215 => '^homework.*',
                        217 => '^((webHW.*)|(JoyOfSets)|(MathHygiene))' );

# these sets aren't assigned to everyone; they just need to be imported
#   when we're adding assignments to a course
my @groupSets = ( qw( topic_factoring topic_frac_exp_powers
                      topic_frac_exp_products topic_fractions_quotients
                      topic_fractions_sums topic_graph_concepts
                      topic_lines topic_solving_linsys
                      chain_rule exponentials powers_sums product_rule
                      quotient_rule symbolic trig_func_logs 
                      simple_definite tan_line
                      ax_substitution basic_antidif by_parts 
                      exponentials_int logarithms_int polynomials_int
                      rational_functions_int roots_int substitution
                      trig_functions_int
                      topic_expanding topic_exponents topic_factoring
                      topic_frac_exp_powers topic_frac_exp_products
                      topic_fractions_quotients topic_fractions_sums
                      topic_graph_concepts topic_lines topic_solving_linsys
                      ) );

# this term ordering is a bit arbitrary, and makes the fall term from
# the previous calendar year be grouped with those other terms in the 
# current year
my %termOrder = ( 'F' => 1, 'W' => 2, 'S' => 3, 'U' => 4 );

#-------------------------------------------------------------------------------
# main
# 

main(@ARGV);
# suppress residual errors (why is this necessary?)
open( DN, ">/dev/null" );
*STDERR = *DN;

sub main {
# unbuffer output
    select STDERR; $| = 1;
    select STDOUT; $| = 1;

    warn(" ** $myName called with arguments: none expected.  (Ignoring.)\n")
        if ( @_ );
    printHdr();               # welcome to the machine

    my $action = getAction();

    while ( $action ) {
        if ( $action == 2 )    { delCourses();     }
        elsif ( $action == 1 ) { listCourses();    }
        elsif ( $action == 3 ) { addCourses2();    }
        elsif ( $action == 4 ) { addAssignments(); }
        elsif ( $action == 5 ) { addProctors();    }
        elsif ( $action == 6 ) { delProctors('global'); }
        elsif ( $action == 7 ) { delProctors('course'); }
        elsif ( $action == 8 ) { updateRosters();  }
        elsif ( $action == 9 ) { updateTermRosters();  }
        elsif ( $action == 10 ) { listArchives();   }

        print "\n";
        $action = getAction();
    }
}

#-------------------------------------------------------------------------------
# subroutines
#
sub printHdr {
    print "\n$myName: ver $version (last mod $lastmod)\n";
    print "  * update script for WeBWorK gateway/homework courses * \n";
    print "  * added courses will be for term $newTerm * \n\n";
    return 1;
}

sub getAction {
    print <<eol;
Main Menu:
Select: 1.  list defined courses
        2.  delete and archive course(s) from list of defined courses
        3.  add course(s) to system
        4.  create assignments in course
        5.  add proctors to courses
        6.  delete global proctors from courses
        7.  delete course proctors from courses
        8.  update rosters from course CSV files
        9.  update rosters for all courses in a term from course CSV files
        10. list archived courses
        0.  quit
eol
    my $action = -1;
    while ( $action !~ /^([0-9])|(10)$/ ) {
        print "  selection> ";
        chomp($action = <STDIN>);
        warn " ** value must be between 0 and 10.\n" 
            if ( $action !~ /^([0-9])|(10)$/ );
    }
    print "\n";
    return $action;
}

sub listCourses {
# pre:  input is $classRef, a reference to a hash of courses to list, such
#       that $classRef->{ crsName } = [ crs#, sxn# ], or no input is provided
# post: a list of those courses in %$classRef is printed, or the list of all
#       classes in the system is obtained and listed.

    my %classList;
    if ( @_ ) {
        my $classRef = shift;
        %classList = %$classRef;    # this defines the current list of classes
    } else {                        #   under consideration
        %classList = getClasses();
    }
    if ( %classList ) {
        print "  * courses in list * \n";
        my @keyList = sort keys %classList;
        my $num1 = int(scalar(@keyList)/3);
        my ($num2, $num3);
        if ( $num1 == scalar(@keyList)/3 ) {
            $num2 = $num1;
            $num3 = $num1;
        } else {
            $num3 = $num1;
            $num2 = $num1+(scalar(@keyList) - (3*$num1+1));
            $num1 = $num1+1;
        }
        my $i;
        my $stdout = select(STDOUT);
        my $oldFormat = $~;
        $~ = "CLIST";
        select $stdout;
        for($i=1; $i<=$num3; $i++) {
            $i1 = $i;             $n1 = $keyList[$i-1];
            $i2 = $i+$num1;       $n2 = $keyList[$i-1+$num1];
            $i3 = $i+$num1+$num2; $n3 = $keyList[$i-1+$num1+$num2];
            write;
        }
        if ( $num2 == $i ) {
            $stdout = select(STDOUT);
            $~ = "CLIST2";
            select $stdout;
            $i1 = $i;       $n1 = $keyList[$i-1];
            $i2 = $i+$num1; $n2 = $keyList[$i-1+$num1];
            write;
        } elsif ( $num1 == $i ) {
            $stdout = select(STDOUT);
            $~ = "CLIST1";
            select $stdout;
            $i1 = $i; $n1 = $keyList[$i-1];
            write;
        }
        $stdout = select(STDOUT);
        $~ = $oldFormat;
        select $stdout;
    } else {
        die(" ** error getting list of defined courses * \n");
    }
    return 1;
}
format CLIST =
  @>>. @<<<<<<<<<<<<<<<<<<  @>>. @<<<<<<<<<<<<<<<<<<  @>>. @<<<<<<<<<<<<<<<<<<
  $i1, $n1,                 $i2, $n2,                 $i3, $n3
.
format CLIST1 =
  @>>. @<<<<<<<<<<<<<<<<<<
  $i1, $n1
.
format CLIST2 = 
  @>>. @<<<<<<<<<<<<<<<<<<  @>>. @<<<<<<<<<<<<<<<<<<
  $i1, $n1,                 $i2, $n2
.

sub listArchives { 
# pre: 
# post: a list of the archived courses found in $archiveDir is displayed

    my @termList = `/bin/ls $archiveDir`;
    @termList = grep { $_ !~ /.*\.tar\.bz2/ } @termList;
    for ( my $i=0; $i<@termList; $i++ ) { chomp($termList[$i]); }

    @termList = sort byTerm @termList;
    my %archiveList = ( );
    foreach my $term ( @termList ) {
        my @aList = `/bin/ls $archiveDir/$term`;

        for ( my $i=0; $i<@aList; $i++ ) {
            chomp($aList[$i]);
            $aList[$i] =~ s/^ma(.*?)(-?[fwsuFWSU]\d\d)?\.tar\.gz$/$1/;
        }
        $archiveList{$term} = [ @aList ];
    }
    if ( @termList ) {
        print " * courses archived:\n";
        my $numListed = 0;
        foreach my $term ( @termList ) {
            print "    $term:", 
                hangIndent(9,75,9,join(', ', @{$archiveList{$term}})), "\n";
            $numListed += @{$archiveList{$term}};
        }
        if ( $numListed > 100 ) {
            print "    [cr to continue]";
            my $pause = <STDIN>;
        }
    } else {
        print " * no archived courses to list *\n";
    }
    print "\n";
    return 1;
}

sub byTerm {
    my ( $aTerm, $aYear )  = ( $a =~ /([FWSU])(\d\d)/i );
    my ( $bTerm, $bYear )  = ( $b =~ /([FWSU])(\d\d)/i );
    $aTerm = uc($aTerm); $bTerm = uc($bTerm);
    if ( $aTerm eq 'F' ) { $aYear = sprintf("%02d", $aYear+1); }
    if ( $bTerm eq 'F' ) { $bYear = sprintf("%02d", $bYear+1); }
    return $bYear . $termOrder{$bTerm} cmp $aYear . $termOrder{$aTerm};
}

sub getClasses {
    my $crsNum = shift();
# pre:  $crsNum is an optional input to restrict the list of classes
#       generated to only classes with that course number
# post: a reference to hash of classes defined in the system is returned:
#       $hash{ crsName } = [ crs#, sxn# ]
#
    my %cl = ();
    my $error = ;

    $crsNum = 'any' if ( ! defined( $crsNum ) );

# generate a list of courses by looking in the course directory in 
# the webwork install
    my @courses = `/bin/ls -dF $wwCourseDir/*`;
    foreach my $courseName ( @courses ) {
        next if ( $courseName !~ /\/$/ || $courseName =~ /CVS/ );
        chomp($courseName);
        $courseName =~ s/.*\/([^\/]+)\/$/$1/;
        my $cNum = ;
        my $sNum = ;
        if ( $courseName =~ /^ma(\d{3})-(.+)$/i ) {
            $cNum = $1; 
            $sNum = $2;
        } elsif ( $courseName =~ /^ma(\d{3})[fwsu]\d{2}$/ ) {
            $cNum = $1;
            $sNum = 'all';
        } else { 
            $cNum = $courseName;
            $sNum = '001';
        }
# save the class information if it has the correct course
# number
        $cl{ $courseName } = [ $cNum, $sNum ]
            if ( $crsNum eq 'any' || $cNum eq $crsNum );
    }
    return %cl;
}

sub delCourses {
# pre: 
# post: we prompt for a list of course-sections to archive and delete,
#       from the courses available in the system.  and then we archive 
#       and delete them.

    print " * archive and delete course(s) from system *\n";
    print " * select courses to archive and delete delete *\n";
    my %classList = getClasses();
    my @classes = sort keys %classList;
    listCourses( \%classList );
    print " * archive, delete which (0 to abort|n1,n2-n3,n4)> ";
    my $delStr = <STDIN>;
    chomp($delStr);
    my @delList = getList($delStr, scalar(@classes));
    while ( ! @delList ) {
        print " * archive, delete which (0 to abort|n1,n2-n3,n4)> ";
        chomp($delStr = <STDIN>);
        @delList = getList( $delStr, scalar(@classes) );
    }
# case of abort delete
    return 0 if ( $delList[0] == 0 );

# ok, otherwise we have a list of course numbers; get a list of names
    my @delClasses = ();
    foreach ( @delList ) { push( @delClasses, $classes[$_-1] ); }

# go through list creating options hashes to pass to archiveCourse
    my @options = ();
    my %dbOpts = ();
    foreach my $cl ( @delClasses ) {
        my $ce = WeBWorK::CourseEnvironment->new( { webwork_dir=>$wwHome,
                                                    courseName=>$cl } );
        push( @options, { courseID => $cl, ce => $ce, dbOptions => \%dbOpts } );
    }

# make sure we have the correct archive term
    my $arTerm = ;
    my $guessTerm = $curTerm;
    if ( $delClasses[0] =~ /-([fwsu][0-9][0-9])/ ) {
        $guessTerm = uc($1);
    }
    print " * archive term [$guessTerm] > ";
    $arTerm = <STDIN>;
    chomp($arTerm);
    if ( $arTerm eq  ) { $arTerm = $guessTerm; }

    my $clstring = hangIndent(8,60,0,join(', ', @delClasses));
    print " * ready to archive and delete classes\n        ",
        $clstring, "\n * abort? ([cr] = no) > ";
    my $ans = <STDIN>;
    chomp( $ans );
    if ( $ans !~ /^$/ ) { return 0; }

    my @archives = ();
    print " * archiving courses: ";
    foreach my $opt ( @options ) {
        print $opt->{courseID}, "..";
        eval { WeBWorK::Utils::CourseManagement::archiveCourse(%$opt); };
        if ( $@ ) {
            my $error = $@;
            print STDERR "$error\n";
            exit;
        }
        push( @archives, $opt->{courseID} . ".tar.gz" );
    }
    print "done.\n * moving archive files to archive directory: ";
    my $saveDir = $archiveDir;
    if ( ! -d "$archiveDir/$arTerm" ) {
        $saveDir = "$archiveDir/$arTerm" if ( mkdir "$archiveDir/$arTerm" );
    } else {
        $saveDir = "$archiveDir/$arTerm";
    }
    foreach ( @archives ) {
        if ( rename( "$wwCourseDir/$_", "$saveDir/$_" ) ) {
            print ".";
        } else {
            print STDERR " * ERROR moving $_\n";
        }
    }

    print "done.\n * deleting courses: ";
    foreach my $opt ( @options ) {
        print $opt->{courseID}, "..";
        eval { WeBWorK::Utils::CourseManagement::deleteCourse(%$opt); };
        if ( $@ ) {
            my $error = $@;
            print STDERR "$error\n";
            exit;
        }
    }
    print "\n * done\n";

    return 0;
}

sub addCourses2 {
# pre:  
# post: we prompt for a list of course-sections to add, in the format
#         CRS,SXN,"UNIQNAME","LastName","FirstName","[Middle]",ID,"password"
#       e.g., 115,027,"GLAROSE","LaRose","Peter","G",12345678,"something",
#       and add those courses to the system, copying templates from a 
#       selected course.
#       password may be omitted from lists

    print " * add course(s) to system *\n";
    my ( $addArray, $fileExt ) = getAddCourses();
    my @adds = @{$addArray};
# now $adds[$i] = [ CRS, SXN, uniqname, Last, First, [Middle], id[, passwd ]

    if ( @adds ) {
# go through and make a list of added course fields
        my %addClasses = ();  # $addClasses{105-001} = [ @adds_fields ]
# a list of the courses these are associated with
        my @addCourseList = ();

        my $crsNum = ;
        foreach ( sort @adds ) {
    # @fields = 116,003,glarose,LaRose,Gavin,[Middle],23860714,password
    #   note quotes are stripped in getAddCourses
            my @fields = split(/[,\t]/);
            $fields[1] = sprintf("%03d", $fields[1]); # get to 00x
            chomp($fields[-1]);
        # promote id to password if we didn't get the password field
            if ( @fields < 8 ) { $fields[7] = $fields[6]; }

            $addClasses{"$fields[0]-$fields[1]"} = [ @fields ];

            $crsNum = $fields[0] if ( ! $crsNum );

            push( @addCourseList, $crsNum )
                if ( ! grep(/^$crsNum$/, @addCourseList ) );
        }

        my %options = ( );

# now we need to get the users file lists...  
        my $ext = 0;
        my %fileNames = buildUserLists( \%addClasses, $fileExt );

# figure out if we're adding any coordinators to these
        my %addCoordUsers = ();
        print " * got user lists for course adds\n";
        foreach my $c ( @addCourseList ) {
            print "  * add course coordinator to $c [uniq|n|N to all] > ";
            my $u = <STDIN>;
            chomp($u);
            if ( $u eq 'N' ) {
                last;
            } elsif ( $u eq 'n' ) {
                next;
            } else {
                if ( grep( /^$u$/, ( map { $addClasses{$_}->[2] }
                                     keys( %addClasses ) ) ) ) {
                    my ( $csu ) = grep( /^$c-\d{3}$u$/, 
                                        ( map { $_ . $addClasses{$_}->[2] }
                                          keys( %addClasses ) ) );
                    $csu =~ s/$u$//;
                    my @dat = @{ $addClasses{$csu} };
                    $addCoordUsers{$c} = [ @dat ];
                } else {
                    print "  * coordinator data: Last,First,Middle,ID# > ";
                    my $dat = <STDIN>;
                    chomp($dat);
                    $addCoordUsers{$c} = [ $c, '000', $u, split(/,\s*/, $dat) ];
                }
            }
        }

# this returns $fileNames{ crs-sxn } = userlist filename
# abort if we had an error
        return 0 if ( defined( $fileNames{Error} ) && $fileNames{Error} );

# all set now: we can go ahead and invoke the addcourse script
        print " * ready to add classes. [cr] to continue > ";
        my $ans = <STDIN>;
        print " * adding courses: ";

        ## do we have a course or e-mail domain extension?
        my $crsExt = ;
        my $domExt = ;
        if ( $fileExt ) {
            foreach ( my $i=0; $i<@fileCampusExt; $i++ ) {
                if ( $fileExt eq $fileCampusExt[$i] ) {
                    $crsExt = $courseCampusExt[$i];
                    # $domExt = $crsExt;
                    # $domExt =~ s/^-(.+)/$1\./;
                    last;
                }
            }
        }

        foreach my $cs ( sort keys %addClasses ) {
            print "$cs..";
            my $courseID = "ma${cs}${crsExt}-$newTerm";
#          my $courseID = "ma${cs}";
            $courseID = lc($courseID);

            my $instrUniq  = $addClasses{$cs}->[2];
            my $instrIdnum = $addClasses{$cs}->[6];

    # get a minimal course environment and hack to get record formats
            my $ce = WeBWorK::CourseEnvironment->new({webwork_dir=>$wwHome,
                                                      courseName=>$courseID});
            my $dbLayout = $ce->{dbLayoutName};
            my %courseOptions = ( dbLayoutName => $dbLayout );
            my $userCl = $ce->{dbLayouts}->{$dbLayout}->{user}->{record};
            my $passCl = $ce->{dbLayouts}->{$dbLayout}->{password}->{record};
            my $permCl = $ce->{dbLayouts}->{$dbLayout}->{permission}->{record};

            my @users = ();
            my ($sxn, $rcn);
            foreach my $uline ( `/bin/cat $fileNames{$cs}` ) {
                my %urec;
                my $userId;
                my $passWd;
                my @fields = csvSplit( $uline );

                if ( $saveWWrosters ) {
            # lines are 
            #     12345678 , Last , First ,C , , CRS ,SXN , email , uniq

            # this is cribbed from addcourse, and includes extra fields from
            # there.  note that the userlist we get from the file does not 
            # include the professor; we add that user below
                    my $email = ( $fields[7] =~ /@/ ) ? $fields[7] :
                        "$fields[7]\@${domExt}$mailDomain";
                    %urec = ( 'student_id' => $fields[0],
                              'last_name' => $fields[1],
                              'first_name' => $fields[2],
                              'status' => 'C',
                              'comment' => ,
                              'section' => $fields[5],
                              'recitation' => $fields[6],
                              'email_address' => $email,
                              'user_id' => $fields[8],
                              'password' => $fields[0],
                              'permission' => 0 );
                    $userId = $fields[8];
                    $passWd = $fields[0];
                } else {
            # lines are 
            #     CRS,SXN,uniq,Last,First Middle,12345678
                    %urec = ( 'student_id' => $fields[5],
                              'last_name'  => $fields[3],
                              'first_name' => $fields[4],
                              'status'     => 'C',
                              'comment'    => ,
                              'section'    => $fields[1],
                              'recitation' => $fields[1],
                              'email_address' => "$fields[2]\@${domExt}$mailDomain",
                              'user_id'    => $fields[2],
                              'password'   => $fields[5],
                              'permission' => 0 );
                    $userId = $fields[2];
                    $passWd = $fields[5];
                }

                my $User = new $userCl( %urec );
                my $plevel = 0;
                if ( $userId eq $instrUniq ) {
                    $plevel = 5;
                } elsif ( $userId eq $adminUser ) {
                    $plevel = 10;
                }
                my $PermLevel = new $permCl( user_id=>$userId,
                                             permission=>$plevel );
                my $Password =  new $passCl( user_id=>$userId,
                                             password=>cryptPass($passWd) );
                push( @users, [ $User, $Password, $PermLevel ] );

            }

            my $addedCampusAdmin = 0;

            my $emDomain;
            if ( ! $saveWWrosters ) {
                ## also add the admin user and instructor, because they
                ##    haven't been created in the course of the
                ##    buildUserLists routine

                my $plevel = ($instrUniq eq $adminUser || $crsExt) ? 10 : 5;
                if ( $crsExt && $instrUniq eq $courseCampusAdmins{$crsExt}->{user_id} ) {
                    $plevel = 10;
                    $addedCampusAdmin = 1;
                }

                $emDomain = "${domExt}$mailDomain";
                my $User = new $userCl( ( 'student_id' => $instrIdnum,
                                         'last_name'  => $addClasses{$cs}->[3],
                                         'first_name' => $addClasses{$cs}->[4],
                                         'status'     => 'C',
                                         'comment'    => ,
                                         'section'    => $addClasses{$cs}->[1],
                                         'recitation' => $addClasses{$cs}->[1],
                                         'email_address' => "$instrUniq\@$emDomain",
                                         'user_id'    => $instrUniq,
                                         'password'   => $instrIdnum,
                                         'permission' => $plevel ) );
                my $PermLevel = new $permCl( user_id    => $instrUniq,
                                             permission => $plevel );
                my $Password  = new $passCl(user_id    => $instrUniq,
                                            password => cryptPass($instrIdnum));
                push( @users, [ $User, $Password, $PermLevel ] );

                if ( $instrUniq ne $adminUser ) {
                    $User = new $userCl( ( 'student_id' => $adminID,
                                          'last_name'  => $adminLname,
                                          'first_name' => $adminFname,
                                         'status'     => 'C',
                                         'comment'    => ,
                                         'section'    => ,
                                         'recitation' => ,
                                         'email_address' => "$adminUser\@$emDomain",
                                         'user_id'    => $adminUser,
                                         'password'   => $adminID,
                                         'permission' => 10 ) );
                    $PermLevel = new $permCl( user_id    => $adminUser,
                                              permission => 10 );
                    $Password  = new $passCl( user_id    => $adminUser,
                                              password => cryptPass($adminID));
                    push( @users, [ $User, $Password, $PermLevel ] );
                }

                my ( $c, $s ) = split( /-/, $cs );
                if ( defined( $addCoordUsers{$c} ) &&
                     $instrUniq ne $addCoordUsers{$c}->[2] ) {
                    my $cUser = new $userCl( 
                        ( 'student_id' => $addCoordUsers{$c}->[6],
                          'last_name'  => $addCoordUsers{$c}->[3],
                          'first_name' => join(' ', ($addCoordUsers{$c}->[4],
                                                     $addCoordUsers{$c}->[5])),
                          'status'     => 'C',
                          'comment'    => ,
                          'section'    => ,
                          'recitation' => ,
                          'email_address' => $addCoordUsers{$c}->[2] . 
                              "\@$emDomain",
                          'user_id'    => $addCoordUsers{$c}->[2],
                          'password'   => $addCoordUsers{$c}->[6],
                          'permission' => 10 ) );
                    my $cPermLevel = new $permCl(
                        user_id    => $addCoordUsers{$c}->[2],
                        permission => 10 );
                    my $cPassword  = new $passCl(
                        user_id  => $addCoordUsers{$c}->[2],
                        password => cryptPass($adminID));
                    push( @users, [ $cUser, $cPassword, $cPermLevel ] );
                }

            }

            ## furthermore, we have to add any campus administrator
            ##   if there should be such a beast.  this is really a bit
            ##   too convoluted.
            if ( $crsExt && ! $addedCampusAdmin ) {
                my $User = new $userCl( 
                    ( 'student_id' => $courseCampusAdmins{$crsExt}->{student_id},
                      'last_name'  => $courseCampusAdmins{$crsExt}->{last_name},
                      'first_name' => $courseCampusAdmins{$crsExt}->{first_name},
                      'status'     => 'C',
                      'comment'    => ,
                      'section'    => $addClasses{$cs}->[1],
                      'recitation' => $addClasses{$cs}->[1],
                      'email_address' => $courseCampusAdmins{$crsExt}->{user_id} . "\@$emDomain",
                      'user_id' => $courseCampusAdmins{$crsExt}->{user_id},
                      'password'   => $courseCampusAdmins{$crsExt}->{student_id},
                      'permission' => 10 ) );
                my $PermLevel = new $permCl( user_id    => $courseCampusAdmins{$crsExt}->{user_id},
                                             permission => 10 );
                my $Password  = new $passCl(user_id    => $courseCampusAdmins{$crsExt}->{user_id},
                                            password => cryptPass($courseCampusAdmins{$crsExt}->{student_id}));
                push( @users, [ $User, $Password, $PermLevel ] );
            }

        # ok, now go ahead and add
            eval( WeBWorK::Utils::CourseManagement::addCourse(
                        courseID       => $courseID,
                        ce             => $ce,
                        courseOptions  => \%courseOptions,
                        dbOptions      => { },
                        users          => \@users,
                        %options
                ));
            if ( $@ ) {
                my $error = $@;
                print STDERR "$error\n";
                exit;
            }

# edit file name printing
            my $printfor = "\$pg{specialPGEnvironmentVars}{PRINT_FILE_NAMES" .
                "_FOR} = ['$adminUser','" . $addClasses{$cs}->[2]. "'];\n";
            if ( defined( $courseConfAdditions{$crsExt} ) ) {
                $printfor .= $courseConfAdditions{$crsExt};
            }
            my @confFile = `/bin/cat $wwHome/courses/$courseID/course.conf`;
            my $cFile = join(, @confFile);
        #    $cFile =~ s/^(\#\s*\S+PRINT_FILE_NAMES_FOR.*)$/$1\n$printfor/s;
            $cFile .= $printfor;
            if ( open(OF, ">$wwHome/courses/$courseID/course.conf") ) {
                print OF $cFile;
                close(OF);
            } else {
                warn(" ** error writing conf file for course $courseID\n");
            }
# and make sure that all of the files have the right user and group
            system("/bin/chown", "-R", "$htuser:$htgroup", 
                   "$wwHome/courses/$courseID");
# lastly, make sure that the appropriate links exist in the templates 
# directory of the created course
            foreach my $lk ( keys( %templateDirLinks ) ) {
                system( "/bin/ln", "-s" , $templateDirLinks{$lk}, 
                        "$wwHome/courses/$courseID/templates/$lk" );
            }
        }
    } else {
        print " ** no courses specified to add *\n";
        return 0;
    }
}

sub getAddCourses {
# pre:  
# post: a reference to an array of courses to add and a file extension is
#       returned.  each entry in the array is a reference to an array of
#       fields: 
#         $adds[$i] = [ CRS, SXN, uniqname, Last, First, [Middle], id, passwd ]
#
    print "   interactive (0) or batch (1) add [1]> ";
    my $ans = <STDIN>;
    chomp($ans);
    $ans = 1 if ( $ans eq "" );

    my @adds = ();
    my $fileExt = ;

    if ( $ans ) {
        my $default = ;
        $default = "[$instrFile] "
            if ( -f $instrFile || -f "$dataDir/$instrFile" );

        print "   file giving courses to add (format: crs,sxn,uniq,lname," .
            "fname mname,id,passwd\n     comma or tab separated) $default> ";
        my $file = <STDIN>;
        chomp($file);
        if ( ! $file && $default ) { 
            $file = $instrFile;
        } else {
            while ( ! -f $file && ! -f "$dataDir/$file" ) {
                print "  can't locate file $file; file > ";
                chomp($file = <STDIN>);
            }
        }

        # check for special file names
        foreach my $campExt ( @fileCampusExt ) {
            if ( $file =~ /$campExt\./ ) {
                $fileExt = $campExt;
                last;
            }
        }

        $file = "$dataDir/$file" if ( ! -f $file );

        @adds = `/bin/cat $file`;
        @adds = modifyEntries(\@adds);
# we assume that the passwords are provided at this point
#      addPasswords(\@adds);
        die(" ** error: can't read $file\n") if ( ! @adds );
        print "\n";
    } else {
        my $confirm = 0;
        while ( ! $confirm ) {
            print "   course-section to add (e.g., 115-021) > ";
            my $cs = <STDIN>;
            chomp($cs);
            print "   instructor uniqname > ";
            my $uniq = <STDIN>;
            chomp($uniq);
            print "   instructor name ( First, MI, Last ) > ";
            my $name = <STDIN>;
            chomp($name);
            my ($fname, $mi, $lname) = split(/,\s*/,$name); 
            my $continue = 0;
            my ($passwd, $passwd1, $passwd2);
            while ( ! $continue ) {
                print "   course password > ";
                system('/usr/bin/stty -echo');
                chomp($passwd1 = <STDIN>);
                print "\n";
                system('/usr/bin/stty echo');
                print "             again > ";
                system('/usr/bin/stty -echo');
                chomp($passwd2 = <STDIN>);
                print "\n";
                system('/usr/bin/stty echo');
                if ( $passwd1 eq $passwd2 ) {
                    chomp($passwd = $passwd1);
                    $continue = 1;
                } else {
                    print "   passwords don't match.  again: \n";
                }
            }
            if ( $cs eq  ) {
                warn " ** error: empty class specified *\n";
                return( () );
            }
            print "   adding course math $cs, taught by $name ($uniq)\n";
            my ( $crs, $sxn ) = split(/-/, $cs);
            $adds[0] = "$crs,$sxn,$uniq,$lname,$fname,$mi,$passwd\n";
        }
    }
    return \@adds, $fileExt;
}

sub cleanEntries {
# turn input of the form
#    crs,sxn,"unq","lname","first mi","id"[,passwd]
# into 
#    crs,sxn,unq,lname,first mi[,passwd]
#
    my $addRef = shift;
#    for ( my $i=0; $i<@$addRef; $i++ ) {
#      my @ent = split(/,/, $addRef->[$i]);
#      for ( my $j=0; $j<@ent; $j++ ) {
#          chomp($ent[$j]);
#          $ent[$j] =~ s/^"(.*)"$/$1/;  # this is subtle
#          $ent[$j] =~ s/"//g; #"       # this is the brute force version
#      }
#      $addRef->[$i]=join(',', @ent);
#    }

    for ( my $i=0; $i<@{$addRef}; $i++ ) {
        $addRef->[$i] =~ s/"//g; #"
        $addRef->[$i] =~ s/[^\w,]/ /g;
        $addRef->[$i] =~ s/\s*$//;
    }
#    chomp($addRef->[scalar(@{$addRef})]);
    return 1;
}

sub modifyEntries {
    my $addRef = shift();

    cleanEntries( $addRef );     # get rid of quotes, remove trailing cr
    my @newEnt = ();
    for ( my $i=0; $i<@$addRef; $i++ ) {
        next if (! $addRef->[$i]);
        my @fields = split(/,/, $addRef->[$i]);
        my ($fname, $mi) = ($fields[4] =~ /(.*)\s+(\S+)$/);
        if ( ! defined($fname) || ! $fname ) {
            $fname = $fields[4];  $mi = ;  # using ' ' relies on edu taking
        }                                     # all spaces as a field separator
        $fname =~ s/\s*//g;      # get rid of spaces in names
        $fields[3] =~ s/\s*//g;
        push( @newEnt, join(',', ( @fields[0..3], $fname, $mi, $fields[5] )) );
        $newEnt[-1] .= ",$fields[6]" if ( @fields == 7 );
    }
    return @newEnt
}

# sub addPasswords {
# # create and append passwords to the end of input instructor add array
#     my $addRef = shift();
#     my ( @threes, @fours );
#     loadDict($threedictfile, $fourdictfile, \@threes, \@fours);
#     for ( my $i=0; $i<@$addRef; $i++ ) {
#      my @data = split(/,/, $addRef->[$i]);
#      if ( @data < 7 ) {
#          push(@data, getpass(\@threes, \@fours));
#          $addRef->[$i] = join(',', @data);
#      }
#     }
#     return 1;
# }

sub buildUserLists { 
    my ( $addRef, $ext ) = @_;
    my %adds = %{$addRef};

# pre:  $adds{105-001} = [ 105,001,uniqname,Last,First,[Middle],ID,password ]
#       $ext is optional, and indicates the extension for CSV roster filenames
# post: we go through the datadir and find the user file for each course-
#       section specified in %adds, and create a webwork user list file for 
#       each course-section.  we return the list of file names as a hash:
#       %fileNames{105-001} = filename

    $ext =  if ( ! defined( $ext ) || ! $ext );
    my %fileNames = ();

    ## if we're not saving files, just return the filelist of roster files
    if ( ! $saveWWrosters ) {
        print "  * getting roster filenames: ";
        foreach my $cs ( sort keys %adds ) {
            print "$cs..";
            my ( $cl, $sc ) = split(/-/, $cs);
        # set some sensible section and recitation numbers
            my $rcn = $sc;
            my $sxn = ( $cl =~ /21[56]/ ) ? substr($sc,0,2) . '0' : $sc;

            my $clistName = "$cs$ext.csv";
            $clistName =~ s/-/_/;
            while ( ! -f $clistName && ! -f "$dataDir/$clistName" ) {
                print "\n * cannot find course list name $clistName for " .
                    "course $cs\n";
                print " * name (blank to exit add) > ";
                chomp( $clistName = <STDIN> );
                if ( ! $clistName ) {
                    print " * aborting add. *\n";
                    return( ( 'Error' => 1 ) );
                }
            }
            $clistName = "$dataDir/$clistName" if ( ! -f $clistName );
            $fileNames{ $cs } = $clistName;
        }
        print "\n  * done\n";
        return %fileNames;
    }

    ## otherwise, go ahead and write all the webwork roster files
    print "  * getting user lists for classes\n";

# if we have an admin user, get a password
    my $adminPw = ;
    if ( $adminUser ) {
#      print "     $adminUser password > ";
#      system("stty -echo");
#      chomp( $adminPw = <STDIN> );
        $adminPw = $adminID;
#      print "\n                 again > ";
#      my $pwCheck = <STDIN>;
#      chomp($pwCheck);
#      while ( $adminPw ne $pwCheck ) {
#          print "\n     passwords don't match; again: password > ";
#          chomp( $adminPw = <STDIN> );
#          print "\n                                      again > ";
#          chomp( $pwCheck = <STDIN> );
#      }
#      system("stty echo");
#      print "\n";
    }

# where do we put the new files?
    my $destDir = $rosterDir;
    my $baseDir = $rosterDir;
    my $crs = ( keys %adds )[0];
    $crs =~ s/-\d{3}$//;
    $destDir =~ s/CRS/$crs/;
    $baseDir =~ s/\/CRS//;

    my $printDest = substr($destDir,-40);

    print "  * destination dir for WeBWorK roster files\n   [..$printDest] > ";
    my $dir = <STDIN>;
    chomp( $dir );
    $dir = $destDir if ( ! $dir );
    if ( $dir eq $destDir && ! -d $baseDir ) {
        die " ** error creating base directory (exiting)\n ** $baseDir\n"
            if ( ! mkdir $baseDir );
    }
    if ( ! -d $dir ) {
        if ( mkdir $dir ) {
            print "   * (created new directory)\n";
        } else {
            die " ** error creating directory (exiting)\n ** $dir\n";
        }
    }

# ok, go and get all of the files for the new users
    print "  * writing files: ";
    foreach my $cs ( sort keys %adds ) {
        print "$cs..";
        my ( $cl, $sc ) = split(/-/, $cs);
    # set some sensible section and recitation numbers
        my $rcn = $sc;
        my $sxn = ( $cl =~ /21[56]/ ) ? substr($sc,0,2) . '0' : $sc;

        my $clistName = "$cs$ext.csv";
        $clistName =~ s/-/_/;
        while ( ! -f $clistName && ! -f "$dataDir/$clistName" ) {
            print "\n * cannot find course list name $clistName for " .
                "course $cs\n";
            print " * name (blank to exit add) > ";
            chomp( $clistName = <STDIN> );
            if ( ! $clistName ) {
                print " * aborting add. *\n";
                return( ( 'Error' => 1 ) );
            }
        }
        $clistName = "$dataDir/$clistName" if ( ! -f $clistName );

    # got name; read contents and reformat appropriately
        my @roster = `/bin/cat $clistName`;
        @roster = modifyEntries( \@roster );

    # start off with the instructor
        my $dataList = sprintf( $wwclFormat, $adds{$cs}->[7], $adds{$cs}->[3],
                                $adds{$cs}->[4] . " " . $adds{$cs}->[5],
                                $sxn, $rcn, $adds{$cs}->[2], $adds{$cs}->[2] );
    # add the administrator, if any, if the instructor isn't the admin user
        $dataList .= sprintf( $wwclFormat, $adminPw, 'Administrator', 'An',
                              $sxn, $rcn, 'math-itc', $adminUser ) 
            if ( $adminUser && $adminUser ne $adds{$cs}->[2] );

        foreach my $stuEntry ( @roster ) {
            my @fields = split( /,/, $stuEntry );
            my $uniq = $fields[2];

            my $lname = $fields[3]; $lname =~ s/\"//g;
            my $fmname = "$fields[4] $fields[5]"; $fmname =~ s/\"//g;
            my $umid = $fields[6];  $umid =~ s/\"//g; # fix emacs' hiliting:"

            $dataList .= sprintf( $wwclFormat, $fields[6], $fields[3], 
                                  $fields[4] . " " . $fields[5], $sxn, $rcn,
                                  $fields[2], $fields[2] );
        }
    # output data to file
        $fileNames{ $cs } = "$dir/$cs.lst";
        open( OF, ">$dir/$cs.lst" ) or 
            die("\n ** error writing user list file $cs.lst (exiting)\n");
        print OF $dataList;
        close( OF );
    }

# all done!
    print "\n  * all files written\n";
    return %fileNames;
}

sub addAssignments {
# pre: 
# post: we prompt for a course to work with, and add assignments based
#       on the set.def files in the templates directory of a template 
#       course
    print " * add assignments to courses in the system *\n";

# get a list of defined courses
    my %classList = getClasses();
    my @classNameList = sort keys( %classList );
    print " * currently defined classes *\n";
    listCourses( \%classList );

# get the course(s) to add to
    print "  * course(s) to which to add assignments (n1,n2-n3,n4) > ";
    my $cnum = <STDIN>;
    chomp($cnum);
    my %assignmentClassList;
    my @addTo;
    if ( ! $cnum ) {
        print " ** error: no classes specified for assignment add *\n";
        return 0;
    } else {
        @addTo = getList( $cnum, scalar(@classNameList) );
        while ( ! @addTo ) {
            print " * course(s) to which to add assignments (n1,n2-n3,n4) > ";
            chomp( $cnum = <STDIN> );
            @addTo = getList( $cnum, scalar(@classNameList) );
        }
        foreach ( @addTo ) {
            $assignmentClassList{$classNameList[$_-1]} =
                $classList{$classNameList[$_-1]};
        }
    }

# get template class for assignments
    print "  * template course giving assignments\n    (enter number; " .
        "0|-1 to exit|use existing) > ";
    my $templNum = <STDIN>;
    chomp( $templNum );
    while( $templNum !~ /^-?\d+$/ || $templNum < -1 || 
           $templNum > @classNameList ) {
        print "  * please enter a number (-1 - " . scalar(@classNameList) . 
            ") > ";
        chomp( $templNum = <STDIN> );
    }
# leave if need be
    if ( $templNum == 0 ) {
        print " * aborting set assignment.\n";
        return 1;
    }
# save the name of the template class
    my $templateClass;
    if ( $templNum > 0 ) {
        $templateClass = $classNameList[ $templNum-1 ];
    } else {
        ## if we're using existing template files, say the template
        ##    class is the first in the list, for now
        $templateClass = $classNameList[ $addTo[0]-1 ];
    }

# ok, we have a template class.  get a list of def files
    my @defFiles = `/bin/ls $wwHome/courses/$templateClass/templates/*.def`;
    my @assignDefFiles = ();  # sets to import and assign to everyone
    my @importDefFiles = ();  # sets to just import
    for ( my $i=0; $i<@defFiles; $i++ ) { 
        chomp( $defFiles[$i] ); 
        $defFiles[$i] =~ s/.*\/(set.+\.def)/$1/;
        my ($setName) = ($defFiles[$i] =~ /set(.+)\.def/);
        if ( isIn( $setName, @groupSets ) ) {
            push( @importDefFiles, $defFiles[$i] );
        } else {
            push( @assignDefFiles, $defFiles[$i] );
        }
    }

    if ( ! @defFiles ) {
        print "  * found no set definition files for $templateClass " .
            "(aborting add).\n";
        return 0;
    } else {
        print "  * found " . scalar( @defFiles ) . " template assignments " .
          "(in $templateClass)\n";

        my %assignmentData = ();
# ok, now we have to deal with possible gateway tests
        print "  * for gateway tests: enter g/w params, or read from file ",
            "(0|[f]) > ";
        my $ans = <STDIN>;
        chomp( $ans );
        if ( $ans eq '0' ) {
            foreach my $setFile ( @defFiles ) {
                next if ( $setFile !~ /gateway/i && $setFile !~ /GW/ );
# we want to set: in the webwork table course_set,
#   assignment_type = 'gateway' (or 'proctored_gateway')
#   attempts_per_version = 1
#   time_interval = 0 or #
#   versions_per_interval = 0 or 2
#   version_time_limit = #
#   problem_randorder = 0 or 1
#   problems_per_page = n
                my $setName = $setFile;
                $setName =~ s/set?(.+)\.def/$1/;
                print "     * for set $setName: \n";
                print "       assignment type ([cr], [g]ateway, or " .
                    "[p]roctored_gateway) > ";
                my $type = <STDIN>;
                chomp( $type );
                if ( ! $type ) {
                    $type = 'default';
                } else {
                    $type = ( $type eq 'g' ) ? 'gateway' : 'proctored_gateway';
                }
                print "       time interval for new versions ([cr] for " .
                    "fake day) > ";
                my $timeInterval = <STDIN>;
                chomp( $timeInterval );
                $timeInterval = 43200 if ( ! $timeInterval );
                print "       number of tests per interval (0 for infty) > ";
                my $numTests = <STDIN>;
                chomp( $numTests );
                $numTests = 0 if ( ! $numTests );
                print "       time limit per test (in min) > ";
                my $timeLimit = <STDIN>;
                chomp( $timeLimit );
                $timeLimit *= 60;
#              print "       order problems randomly (0|1) > ";
#              my $ordering = <STDIN>;
                my $ordering = 1;
                chomp( $ordering );
                print "       problems per page ([cr] = all) > ";
                my $pppage = <STDIN>;
                chomp( $pppage );
                $pppage = 0 if ( ! $pppage );

                $assignmentData{ $setFile } = { 
                    open_date => 
                    assignment_type => $type,
                    attempts_per_version => 1,
                    time_interval => $timeInterval,
                    versions_per_interval => $numTests,
                    version_time_limit => $timeLimit,
                    problem_randorder => $ordering, 
                    published => 1, 
                    problems_per_page => $pppage, };
            }
        }

# sanity check
        if ( ! %assignmentClassList ) {
            warn(" ** error: no classes found for course number $cnum\n");
            return 0;
        }

# now we have the set definition files, we can go through each course
# and make the assignments using our fake Instructor object
        print " * making set assignments to courses:\n   ";
        foreach my $csName ( sort keys %assignmentClassList ) {
            next if ( $csName =~ /-sample/ );
            print "$csName..";
    # make sure that the course has the required set definition files 
            if ( $templNum > 0 && $csName ne $templateClass ) {
                system( "/bin/cp " .
                        "$wwHome/courses/$templateClass/templates/set*.def " .
                        "$wwHome/courses/$csName/templates/" );
                system( "/bin/chown $htuser:$htgroup " .
                        "$wwHome/courses/$csName/templates/set*.def" );
            }
    # get the course environment for this course
            my $csce = 
                WeBWorK::CourseEnvironment->new( { webwork_dir => $wwHome,
                                                   courseName => $csName } );
    # and create an appropriate database object
            my $db = WeBWorK::DB->new( $csce->{dbLayout} );
    # build a fake request object so that we can get an 
    #   instructor::problemsetlist object
            my $fr = FakeRequest->new();
            $fr->ce( $csce );
            $fr->db( $db );
            $fr->param( 'user', $adminUser );
            my $wwInstrPSL = 
                WeBWorK::ContentGenerator::Instructor::ProblemSetList->new($fr);
    # import the sets
            $wwInstrPSL->importSetsFromDef( , 'all', @assignDefFiles );
            $wwInstrPSL->importSetsFromDef( , 'none', @importDefFiles );

    # then make any gateway adjustments that we need to 
            foreach my $setFile ( @defFiles ) {
                next if ( ! defined( $assignmentData{ $setFile } ) );
        # find the setName
                my ($setName) = ( $setFile =~ m|^set([.\w-]+)\.def$| );
        # get and update the global set
                eval {
                    my $set = $db->getGlobalSet( $setName );
                    foreach my $field ( %{$assignmentData{ $setFile }} ) {
                        $set->{$field} = $assignmentData{$setFile}->{$field};
                    }
                    $db->putGlobalSet( $set );
                };
                if ( $@ ) {
                    print "Error updating g/w set $setName: $@\n";
                    print "Continue? ([cr]|n) ";
                    my $ans = <STDIN>;
                    exit if ( $ans =~ /n/i );
                }
            }
        }
        print "\n * done.\n";
    }
}

sub addProctors {
# pre: 
# post: we prompt for a course to work with, and add proctors from a 
#       list
    print " * add proctors to courses in the system *\n";

# get a list of defined courses
    my %classList = getClasses();
    my @classNameList = sort keys( %classList );

    my @procCrses = ();

    print " * currently defined classes *\n";
    listCourses( \%classList );

    print "  * courses to which to add proctors (n1,n2-n3,n4|crs-trm)> ";
    my $procList = <STDIN>;
    chomp($procList);

    if ( ! $procList ) {
        print " ** error: no classes specified for proctor add *\n";
        return 0;

    } else {
        if ( $procList =~ /-[fwsu]\d\d$/ ) {
            my ( $crs,$trm ) = split(/-/, $procList );
            @procCrses = grep( /ma${crs}-\d\d\d-${trm}$/, @classNameList );
        } else {
            my @procCrsList = getList($procList, scalar(@classNameList));
            while ( ! @procCrsList ) {
                print "  * courses to which to add proctors (n1,n2-n3,n4)> ";
                chomp($procList = <STDIN>);
                @procCrsList = getList($procList, scalar(@classNameList));
            }
            foreach ( @procCrsList ) {
                push( @procCrses, $classNameList[$_-1] );
            }
        }
    }

# now $procCrses[i] = crsName for all courses to which we add proctors

    my $printDir = substr($proctorDir,-40);
    print "  * file giving proctors (name\\t+uniq\\t+passwd)\n" .
        "    [default in $printDir] > ";
    my $procFile = <STDIN>;
    chomp($procFile);
    $procFile = "$proctorDir/$procFile" if ( ! -f $procFile );
    while ( ! -r $procFile ) {
        print "   * cannot read $procFile; file > ";
        chomp($procFile = <STDIN>);
    }
    my @tmpList = `/bin/cat $procFile`;
    my @proctorList = ();
    foreach (@tmpList) {
        push( @proctorList, $_ ) if ( /\S/ && /^[^#]/ );
    }
# check file format
    my $fmtok = 1;
    my $badline = ;
    foreach ( @proctorList ) {
        my @f = split(/\t+/);
        if ( @f != 3 ) {
            $fmtok = 0;
            $badline = $_;
            last;
        }
    }
    if ( ! $fmtok ) {
        print " * error: file format doesn't appear to be " .
            "name\t+uniq\t+password\n$badline";
        return 0;
    }

# now @proctorList is a list of possible proctors to add; each line is
#    name\t+uniq\t+password
# or
#    name\t+uniq\t+password\t+crs,sxn[,sxn]
# find the number of proctors and course specific proctors
    my @globalProctors = ();
    my @courseSpecific = ();
    foreach ( @proctorList ) {
        my @fields = split(/\t+/);
        if ( @fields == 4 ) {
            push( @courseSpecific, $_ );
        } else {
            push( @globalProctors, $_ );
        }
    }

    if ( @proctorList ) {
        print " * adding ", scalar(@proctorList), " proctors to courses: \n";
        print " *        ", scalar(@globalProctors), " global proctors, \n";
        print " *        ", scalar(@courseSpecific), " course proctors:\n     ";

        foreach my $cName ( @procCrses ) {
            print "$cName..";

# get a database object to be able to add the users
            my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
                                                      courseName  => $cName});
            my $db = WeBWorK::DB->new( $ce->{dbLayout} );

# get a list of existing users so that we are sure we're not adding 
# a proctor who is in a course already
            my @userList = $db->listUsers();

            foreach my $line ( @proctorList ) {
                chomp($line);
                my @fields = split( /\t+/, $line );
                my $name   = $fields[0];
                my $uniq   = $fields[1];
                my $passwd = $fields[2];

                my ( $crsnum, $sxnnum ) = ( ,  );
                if ( @fields == 4 ) {
                    $crsnum = substr($fields[3], 0, 3);
                    $sxnnum = [ split(/,/, substr($fields[3],4)) ];
                }

                # if this is a course proctor, skip if we're not doing 
                #    the correct course
                if ( $crsnum ) {
                    my $keep = 0;
                    foreach my $s ( @{$sxnnum} ) {
                        if ( $cName =~ /ma$crsnum-$s/ ) {
                            $keep = 1;
                            last;
                        }
                    }
                    next if ( ! $keep );
                }

                if ( isIn($uniq, @userList) ) {
                    print " * user $uniq ($name) already exists!  skipping..\n";
                    next;
                }

                my ( $fname, $lname ) = ( ,  );
                if ( $name =~ /\s/ ) {
                    ( $fname, $lname ) = ( $name =~ /(.*)\s(\S+)/ );
                } else {
                    $lname = $name;
                }

                my $newUser = $db->newUser;
                my $newPermissionLevel = $db->newPermissionLevel;
                my $newPassword = $db->newPassword;

                $newUser->user_id($uniq);
                $newPermissionLevel->user_id($uniq);
                $newPassword->user_id($uniq);
                my $salt = 
                    join("", 
                         ('.','/','0'..'9','A'..'Z','a'..'z')[rand 64,rand 64]);
                $newPassword->password(crypt($passwd, $salt));
                $newUser->last_name($lname);
                $newUser->first_name($fname);
                $newUser->student_id($passwd);
                $newUser->email_address("$uniq\@$mailDomain");
                if ( $crsnum ) {
                    $newUser->section('900');  # distinguish course proctors
                } else {                       #    with section 900
                    $newUser->section('999');
                }
                $newUser->recitation('999');
                $newUser->comment();
        #      $newUser->status($ce->status_name_to_abbrevs($ce->{default_status}));
                $newUser->status($ce->status_name_to_abbrevs("Proctor"));
                $newPermissionLevel->permission(3);

                eval { $db->addUser($newUser) };
                if ($@) {
                    print " * error adding user $uniq ($name): $@\n";
                    next;
                } else {
                    $db->addPermissionLevel($newPermissionLevel);
                    $db->addPassword($newPassword);
                }
            }
        }
        print "\n * done.\n";

    } else {
        print " ** error: no proctors found in file\n";
        return 0;
    }
}

sub delProctors {
# pre: 
# post: we prompt for a course to work with, and delete proctors in those 
#       course(s)
    my $type = shift();
    my $snum = ;
    if ( $type eq 'global' ) {
        $snum = '999';
    } else {
        $snum = '900';
    }
    print " * delete proctors from courses in the system *\n";

# get a list of defined courses
    my %classList = getClasses();
    my @classNameList = sort keys( %classList );

    my @procCrses = ();

    print " * currently defined classes *\n";
    listCourses( \%classList );

    print "  * courses from which to del proctors (n1,n2-n3,n4|crs-trm)> ";
    my $procList = <STDIN>;
    chomp($procList);

    if ( ! $procList ) {
        print " ** error: no classes specified for proctor add *\n";
        return 0;

    } else {
        if ( $procList =~ /-[fwsu]\d\d$/ ) {
            my ( $crs,$trm ) = split(/-/, $procList );
            @procCrses = grep( /ma${crs}-\d\d\d-${trm}$/, @classNameList );
        } else {
            my @procCrsList = getList($procList, scalar(@classNameList));
            while ( ! @procCrsList ) {
                print "  * courses from which to del proctors (n1,n2-n3,n4)> ";
                chomp($procList = <STDIN>);
                @procCrsList = getList($procList, scalar(@classNameList));
            }
            foreach ( @procCrsList ) {
                push( @procCrses, $classNameList[$_-1] );
            }
        }
    }
# now $procCrses[i] = crsName for all courses to which we add proctors
    my $crses = join(',', sort(@procCrses));

# get list of proctors from first course and make sure that we should
# proceed with delete
    my $cName = $procCrses[0];
    my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
                                              courseName  => $cName});
    my $db = WeBWorK::DB->new( $ce->{dbLayout} );

    my @userIDList = $db->listUsers();
    my @procUsers = grep {$_->section() eq $snum} $db->getUsers( @userIDList );

    print " * found ", scalar(@procUsers), " ($type) proctors in $cName\n";
    print " * ready to delete these proctors from courses $crses.  " .
        "continue? ([n]|y) > ";
    my $ans = <STDIN>;
    chomp($ans);
    if ( $ans !~ /^y$/i ) {
        print " ** ok.  exiting delete.\n";
        return 0;
    } else {
        print " * deleting proctors from $cName..";
        foreach ( @procUsers ) {
            $db->deleteUser( $_->user_id() );
        }
        foreach $cName ( @procCrses ) {
            next if $cName eq $procCrses[0];
            print "$cName.. ";
            $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
                                                   courseName  => $cName});
            $db = WeBWorK::DB->new( $ce->{dbLayout} );
            my @userIDList = $db->listUsers();
            my @procUsers = grep {$_->section() eq $snum} 
                $db->getUsers( @userIDList );
            foreach ( @procUsers ) {
                $db->deleteUser( $_->user_id() );
            }
        }
        print "\n * done.\n";
    }
}

sub updateTermRosters {
# pre: 
# post: we update rosters for all courses in a given term

    print " * update rosters for all courses in a term *\n";
    print "  * term to update ([fwsu]\\d\\d) > ";
    my $term = <STDIN>;
    chomp( $term );

    print "  * campus extension ([cr] for none) > ";
    my $ext = <STDIN>;
    chomp( $ext );

    my %classList = getClasses();
    my @classNameList = sort keys( %classList );
    my $matchPat = ( $ext ) ? "-$ext-$term" : "\\d-$term";

    my @allUpdateCrses = grep( /$matchPat$/, @classNameList );

# sort these by course and do the updates in batch
    my $prevcrs = 0;
    my @updateCrses = ();

    my ( $crs, $sxn );
    foreach my $crsName ( @allUpdateCrses ) {
        ( $crs, $sxn ) = ( 0, 0 );
        if ( $crsName =~ /ma(\d{3})-(\d{3})/ ) {
            $crs = $1;
            $sxn = $2;
        } elsif ( $crsName =~ /ma(\d{3})-[fwsu]\d\d/ ) {
            $crs = $1;
        } else {
            # this gets dealt with in doRosterUpdate
            next;
        }
        if ( ! $prevcrs || $crs ne $prevcrs ) {
            if ( @updateCrses ) {
                print " * updating by course number: $prevcrs\n";
                # print "   * update for " . join(", ", @updateCrses) . "\n";
                doRosterUpdate( @updateCrses );
            }
            @updateCrses = ( $crsName );
            $prevcrs = $crs;
        } else {
            push( @updateCrses, $crsName );
        }
    }
    if ( @updateCrses ) {
        print " * updating by course number: $prevcrs\n";
        # print "   * update for " . join(", ", @updateCrses) . "\n";
        doRosterUpdate( @updateCrses );
    }
}

sub updateRosters {
# pre:
# post: we get a list of courses for which to update rosters, and update
#    those

    print " * update rosters for courses in the system *\n";

# get list of courses to update
    my %classList = getClasses();
    my @classNameList = sort keys( %classList );
    my @updateCrses = ();

    print " * currently defined classes *\n";
    listCourses( \%classList );
    print "  * courses to update (n1,n2-n3,n4) > ";
    my $updList = <STDIN>;
    chomp($updList);

    if ( ! $updList ) {
        print " ** error: no classes specified *\n";
        return 0;
    } else {

        my @updateIndices = getList( $updList, scalar(@classNameList) );
        while ( ! @updateIndices ) {
            print "  * courses to update (give n1,n2-n3,n4) > ";
            chomp( $updList = <STDIN> );
            @updateIndices = getList( $updList, scalar(@classNameList) );
        }
        foreach ( @updateIndices ) {
            push( @updateCrses, $classNameList[$_-1] );
        }
    }

    doRosterUpdate( @updateCrses );
}

sub doRosterUpdate {
# pre:  a list of courses to update is provided
# post: we update the rosters of the requested courses based on the 
#       roster data in $dataDir

    my @updateCrses = @_;

# ok, now we have a list of course names; read in the current and old rosters
    print " * reading data for course rosters.. \n";
# oldRosters are read from the WeBWorK courses
#   oldRosters{uniq} = [ crsName, crs, sxn, umid, last, first ]
# newRosters are read from the data directory
#   newRosters{uniq} = [ crsName, crs, sxn, umid, last, first ]
# and then we have lists of students who are in multiple rosters
#   newMultipleRosters{uniq} = [ list of crsNames ] 
#   oldMultipleRosters{uniq} = [ list of crsNames ]
# and lists of students by courses
#   newCourseLists{crsName} = [ list of uniqs ];
#   oldCourseLists{crsName} = [ list of uniqs ];
# to be able to add sets to new users, we also assemble
#   setNames{crsName} = [ list of set names ];
# and, finally, watch for dropped students, too
#   oldDroppedStu{crsName} = [ list of uniqs ];

    my %oldRosters = ();
    my %newRosters = ();
    my %oldMultipleRosters = ();
    my %newCourseLists = ();
    my %oldCourseLists = ();
    my %newMultipleRosters = ();
    my %setNames = ();
    my %oldDroppedStu = ();

# webwork courses that include multiple sections
#    multiSectionCourses{crsName} = 0 | sxnstring
    my %multiSectionCourses = ();

    my @skipClassNames = ();

# people we don't move or alter: adminUsers = ( list of uniqs )
    my @adminUsers = ();

# section numbers we save
    my %savedSxnNums = ();

# the file extension must be the same for all courses that we are updating
    my $fileExt = ;
    foreach my $crsName ( @updateCrses ) {

# the course name is maCCC-SSS-TTT, maCCC-SSS-EXT-TTT, or maCCC-TTT
        my ( $crs, $sxn ) = ( 0, 0 );
        if ( $crsName =~ /(\d{3})-(\d{3})/ ) {
            $crs = $1;
            $sxn = $2;
        } elsif ( $crsName =~ /(\d{3})-[fwsu]\d\d/ ) {
            $crs = $1;
        } else {
            print "\n ** error getting course and section number from " .
                "$crsName; skipping\n";
            push( @skipClassNames, $crsName );
            next;
        }
        $multiSectionCourses{$crs} = 0 if ( $crs );

# if we didn't get a section number, query for the section number
        if ( ! $sxn ) {
            print " * found no section for course $crs. section " .
                "(005, 10[13], all)? ";
            chomp($sxn = <STDIN>);
            $savedSxnNums{$crsName} = $sxn;
            $multiSectionCourses{$crs} = $sxn;
        }
        print "   $crs-$sxn..";

        ## check for a campus extension to the course name
        my $ii = 0;
        foreach my $campExt ( @courseCampusExt ) {
            if ( $crsName =~ /${crs}-${sxn}($campExt)/ ) {
                $fileExt = $fileCampusExt[$ii];
                last;
            }
            $ii++;
        }

        # quick check here to deal with special cases
        my $skipCheck = 0;
        if ( $crs =~ /^21[56]/ && $sxn eq 'all' ) {
            $sxn = '0[0-9]0';
            $savedSxnNums{$crsName} = $sxn;
            $skipCheck = 1;
        } elsif ( $sxn eq 'all' ) {
            $sxn = '[0-9][0-9][0-9]';
            $skipCheck = 1;
        } elsif ( $sxn =~ /\D/ ) {
            $skipCheck = 1;
        }
        if ( ! $skipCheck && ! -r "$dataDir/${crs}_${sxn}${fileExt}.csv" ) {
            print " ** error reading course-section file " .
                "${crs}_${sxn}${fileExt}.csv for $crsName; " .
                "skipping\n";
            push( @skipClassNames, $crsName );
            next;
        }

        $newCourseLists{$crsName} = [ ];

# note roster files have the format
# crs,sxn,"uniq","lname","fmnames","uniq"
# 116,023,"dbegun","Begun","Dana Lynne","15293340"
#  0   1     2        3        4             5

        my @rosterLines = `/bin/cat $dataDir/${crs}_${sxn}${fileExt}.csv`;
        if ( @rosterLines ) {
            foreach ( @rosterLines ) {
                chomp();
                my @fields = csvSplit( $_ );

                if ( defined( $newRosters{$fields[2]} ) || 
                     defined( $newMultipleRosters{$fields[2]} ) ) {
                    if ( defined( $newMultipleRosters{$fields[2]} ) ) {
                        push( @{$newMultipleRosters{$fields[2]}}, $crsName );
                    } else {
                        my $ocrsName = $newRosters{$fields[2]}->[0];
                        $newMultipleRosters{$fields[2]} = [$ocrsName, $crsName];
                    }
                } else {
                    $newRosters{$fields[2]} = [ $crsName, $crs, $fields[1], 
                                                $fields[5], $fields[3], 
                                                $fields[4] ];
                    push( @{$newCourseLists{$crsName}}, $fields[2] );
                }
            }
        } else {
            print " ** found no data for ${crs}-$sxn ($crsName); skipping\n";
            push( @skipClassNames, $crsName );
            next;
        }
    }

    print "done\n * reading roster data from webwork courses..\n   ";
    foreach my $crsName ( @updateCrses ) {
        my $sxn_disp = ;
        my ( $crs, $sxn ) = ( 0, 0 );
        if ( $crsName =~ /ma(\d{3})-(\d{3})/ ) {
            ($crs, $sxn ) = ( $1, $2 );
            $sxn_disp = "-$sxn";
        } else {
            ( $crs ) = ( $crsName =~ /(\d{3})-[fwsu]\d\d/ );
            $sxn = $savedSxnNums{$crsName};
            $sxn_disp = ;
        }
        print "$crs$sxn_disp..";

        $oldDroppedStu{$crsName} = [ ];

        my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
                                                  courseName  => $crsName});
        my $db = WeBWorK::DB->new( $ce->{dbLayout} );

        my @userIDList = $db->listUsers();
    # exclude proctor users
        my @users = grep {$_->section() ne '999'} $db->getUsers(@userIDList);

        $oldCourseLists{$crsName} = [ ];
        foreach ( @users ) {
            if ( $_->status() eq 'D' ) {
                push( @{$oldDroppedStu{$crsName}}, $_->user_id() );

            } else {

                my $userPermLvl = $db->getPermissionLevel( $_->user_id() );

                if ( $userPermLvl->permission() > 0 ) {
                    push( @adminUsers, $_->user_id() );
                    next;
                } else {
                    if ( defined($oldRosters{$_->user_id()}) ) {
                        if ( defined($oldMultipleRosters{$_->user_id()}) ) {
                            push( @{$oldMultipleRosters{$_->user_id()}}, 
                                  $crsName );
                        } else {
                            my $ocrsName = $oldRosters{$_->user_id()}->[0];
                            $oldMultipleRosters{$_->user_id()} = [ $ocrsName,
                                                                   $crsName ];
                        }
                    } else {
                        $oldRosters{$_->user_id()} = [ $crsName, $crs, 
                                                       $_->section(),
                                                       $_->student_id(), 
                                                       $_->last_name(),
                                                       $_->first_name() ];
                        push( @{$oldCourseLists{$crsName}}, $_->user_id() );
                    }
                }
            }
        }

    # also get a list of the sets for this course
        my @userSets = ();
        my @globalSets = $db->listGlobalSets();
        foreach my $setID ( @globalSets ) {
            push( @userSets, $setID ) if ( $db->countSetUsers($setID) &&
                                           ! grep(/^$setID$/, @groupSets) &&
                                           ( ! defined($skipAssignments{$crs})
                                             or $setID !~ /$skipAssignments{$crs}/ ) );
        }
        $setNames{$crsName} = [ @userSets ];
    }

# all done; do update
# $adds[i] (, dels) = [ crs, sxn, uniq, umid, lname, fname ]
    my @adds = ();   # spiffy new students
    my @dels = ();   # dropped students
    my @reups = ();  # students who had status 'D' and were upgraded to 'C'
# chgs[i] = [ ocrs->ncrs, osxn->nsxn, uniq,  umid, lname, fname ]
    my @chgs = ();
# $skps[i] = [ crs, sxn, uniq ]
    my @skps = ();

    print "done\n * doing update..\n   ";

### update loop: loop through each course we're updating
    foreach my $crsName ( @updateCrses ) {
        if ( isIn( $crsName, @skipClassNames ) ) {
            print "[$crsName skipped]..";
            next;
        }
        my $sxn_disp = ;
        my ( $crs, $sxn ) = ( 0, 0 );
        if ( $crsName =~ /(\d{3})-(\d{3})/ ) {
            ($crs, $sxn ) = ( $1, $2 );
            $sxn_disp = "-$sxn";
        } else {
            ( $crs ) = ( $crsName =~ /(\d{3})-[fwsu]\d\d/ );
            $sxn = $savedSxnNums{$crsName};
            $sxn_disp = ;
        }
        print "$crs$sxn_disp..";

    # keep a list of adds, who need to have sets assigned in this course
        my @usersSetAssign = ();
    # and any for whom we need to copy work
        my @usersCopyWork  = ();

        my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
                                                  courseName  => $crsName});
        my $db = WeBWorK::DB->new( $ce->{dbLayout} );

    ### inner update loop: loop through each student in the new course roster
        foreach my $uniq ( @{$newCourseLists{$crsName}} ) {

            next if ( isIn( $uniq, @adminUsers ) ||
                      defined( $newMultipleRosters{$uniq} ) );

    # keep track of what's going on with old course enrollments: in 
    #   particular, get a list of the sections in each course that 
    #   the student is enrolled in.  (in the following we actually 
    #   only use the fact that a student is or is not enrolled in a 
    #   section of the current course, not the list of section numbers.)
            my %oldSectionNum = ();
            if ( defined( $oldRosters{$uniq} ) ) { 
                if ( defined( $oldMultipleRosters{$uniq} ) ) {
                    foreach my $oldCrsName ( @{$oldMultipleRosters{$uniq}} ) {
                        my ( $oldCrs, $oldSxn ) = ( 0, 0 );
                        if ( $oldCrsName =~ /(\d{3})-(\d{3})/ ) {
                            ($oldCrs, $oldSxn ) = ( $1, $2 );
                        } else {
                            ( $oldCrs ) = ($oldCrsName =~ /(\d{3})-[fwsu]\d\d/);
                            $oldSxn = $savedSxnNums{$oldCrsName};
                        }

                        if ( defined( $oldSectionNum{$oldCrs} ) ) {
                            push( @{$oldSectionNum{$oldCrs}}, $oldSxn );
                        } else {
                            $oldSectionNum{$oldCrs} = [ $oldSxn ];
                        }
                    }
                } else {
                    $oldSectionNum{$oldRosters{$uniq}->[1]} = 
                        [ $oldRosters{$uniq}->[2] ];
                }
            }
    # first, anyone who is in the new roster and wasn't in the class 
    #   before needs to be added
            if ( ( ! defined( $oldRosters{$uniq} ) ||
                   ! defined( $oldSectionNum{$crs} ) ) &&
                 ! isIn( $uniq, @{$oldDroppedStu{$crsName}} ) ) {
                my ( $cn, $c, $s, $umid, $lname, $fname ) =
                    @{$newRosters{$uniq}};

                my $newUser = $db->newUser;
                my $newPermissionLevel = $db->newPermissionLevel;
                my $newPassword = $db->newPassword;

                $newUser->user_id( $uniq );
                $newPermissionLevel->user_id($uniq);
                $newPassword->user_id($uniq);
                my $salt = 
                    join("", 
                         ('.','/','0'..'9','A'..'Z','a'..'z')[rand 64,rand 64]);
                $newPassword->password(crypt($umid, $salt));
                $newUser->last_name($lname);
                $newUser->first_name($fname);
                $newUser->student_id($umid);
                $newUser->email_address("$uniq\@$mailDomain");
                $newUser->section($s);
                $newUser->recitation($s);
                $newUser->comment();
                $newUser->status($ce->status_name_to_abbrevs($ce->{default_status}));
                $newPermissionLevel->permission(0);

                eval( $db->addUser( $newUser ) );
#              print "  * addUser ($uniq, $umid, $lname, $fname)\n";
                if ( $@ ){
#              if ( 0 ) {
                    print " * error adding user $uniq ($fname $lname) " . 
                        "to $crs-$sxn: $@\n";
                    next;
                } else {
                    $db->addPermissionLevel($newPermissionLevel);
                    $db->addPassword($newPassword);
#                  print "    addPermissions($uniq, 0)\n";
#                  print "    addPassword($uniq, " . $newPassword->password . ")\n";
                    push( @adds, [ $crs, $s, $uniq, $umid, $lname, $fname ]);
                }

        # also store the student to assign sets to them at the end of 
        #   the course loop
                push( @usersSetAssign, $uniq )
                    if (! $fileExt || $courseCampusBuildSets{$fileExt});

    # next catch anyone who is in the old roster, but has a status of 'D': 
    #   we just reset them to 'C'; we don't try and catch their set data 
    #   if they were surfing between multiple sections...
            } elsif ( isIn( $uniq, @{$oldDroppedStu{$crsName}} ) ) {
                my $user = $db->getUser( $uniq );
                $user->status( 'C' );
                $db->putUser( $user );
                push( @reups, [ $crs, $user->section(), $uniq, 
                                $user->student_id(),
                                $user->last_name(), $user->first_name() ] );

    # next, anyone who is in both one new and one old roster, and is in the 
    #   same course but not in the new section, needs to be swapped between
    #   the sections.  if they already exist in this section (e.g., b/c 
    #   they are enrolled in multiple sections), we don't tamper with their
    #   data and just drop them from the old sections
            } elsif ( defined( $oldRosters{$uniq} ) &&
                      ! defined( $oldMultipleRosters{$uniq} ) && 
                      $oldRosters{$uniq}->[1] eq $crs &&
                      $oldRosters{$uniq}->[2] ne $newRosters{$uniq}->[2] ) {

                my $odb;
                my $oCrsName = $oldRosters{$uniq}->[0];
                my $oCrs = $oldRosters{$uniq}->[1];
                my $oSxn = $oldRosters{$uniq}->[2];
                my $exists = 0;
        # if the webwork course includes multiple sections, then the 
        #   student already exists in the course and we just have to update
        #   her/his section number and possibly status; in this case we use
        #   the existing database and don't reset passwords and permissions.
        #   this can also happen if a user was entered manually with incorrect
        #   section/recitation data.
        # otherwise we need to get the database for the old course and pull
        #   user data from there
                if ( $multiSectionCourses{$crs} || 
                     $oCrsName eq $crsName ) {
                    $odb = $db;
                    $exists = 1;
                } else {
            # first, bring up a new course environment and db for the
            #   student's old course 
                    my $oce = 
                        WeBWorK::CourseEnvironment->new({webwork_dir=>$wwHome,
                                                         courseName=>$oCrsName});
                    $odb = WeBWorK::DB->new( $oce->{dbLayout} );
                }

        # the old student user information is then
                my $oldUser = $odb->getUser( $uniq );
                $oldUser->status('C');
                $oldUser->section( $newRosters{$uniq}->[2] );
                $oldUser->recitation( $newRosters{$uniq}->[2] );

        # save this as appropriate.
                if ( $exists ) {
                    eval( $db->putUser( $oldUser ) );

                    if ( $@ ) {
                        print " * error moving user $uniq from $oCrs-$oSxn " .
                            "to $crs-$sxn: $@\n";
                        next;
                    }
                } else {
                    eval( $db->addUser( $oldUser ) );
                    if ( $@ ) {
                        print " * error moving user $uniq from $oCrs-$oSxn " .
                            "to $crs-$sxn: $@\n";
                        next;
                    } else {
                        my $oldPerm = $odb->getPermissionLevel( $uniq );
                        my $oldPass = $odb->getPassword( $uniq );
                        $db->addPermissionLevel( $oldPerm );
                        $db->addPassword( $oldPass );

            # we create a new set of assignments for the student, and
            #    then see what we can or should copy from the old course
                        push( @usersSetAssign, $uniq ) 
                            if (! $fileExt || $courseCampusBuildSets{$fileExt});
            # should we be moving data?
                        if ( $copyWork && ! $exists && 
                             ( ! $fileExt || $copyWorkForCampuses ) ) {
                            push( @usersCopyWork,
                                  [ $uniq, $oCrsName, $crsName ] );
                        }
#              my $ruser = 
#                  $ce->{dbLayout}->{password}->{params}->{usernameRO};
#              my $rpass = 
#                  $ce->{dbLayout}->{password}->{params}->{passwordRO};
#              my $wuser = 
#                  $ce->{dbLayout}->{password}->{params}->{usernameRW};
#              my $wpass = 
#                  $ce->{dbLayout}->{password}->{params}->{passwordRW};

#              my $oldCrs = $oldRosters{$uniq}->[0];
#              my $newCrs = $newRosters{$uniq}->[0];

#              my $cmd = "mysqldump -u $ruser --password=$rpass " .
#                  "--no-create-db " .
#                      "--no-create-info --where \"user_id='" . $uniq . 
#                      "'\" webwork ${oldCrs}_user ${oldCrs}_password " .
#                      "${oldCrs}_permission ${oldCrs}_key " .
#                      "${oldCrs}_set_user ${oldCrs}_problem_user | " .
#                      "sed 's/" . $oldCrs . '/' . $newCrs . "/g' | " .
#                      "mysql -u $wuser --password=$wpass webwork";
# #                print "  * change command:\n    $cmd\n";
# #                system( $cmd );
# #                print "  * (mv) putUser($uniq, " . $oldUser->status . ")\n";
                    }
                }

                push( @chgs, [ $oldRosters{$uniq}->[1] . "->"  .
                               $newRosters{$uniq}->[1], 
                               $oldRosters{$uniq}->[2] . "->"  .
                               $newRosters{$uniq}->[2], $uniq, 
                               @{$newRosters{$uniq}}[3..5] ] );
            }
        }
        ### end inner update loop: foreach $uniq in @{$newCourseLists{$crsName}}

# make sure that anyone who is in multiple old rosters is indicated as dropped
# in this course section
        foreach my $dupUniq ( keys %oldMultipleRosters ) {
            foreach my $dupCrsName ( @{$oldMultipleRosters{$dupUniq}} ) {
                if ( $crsName eq $dupCrsName && 
                     ! isIn( $dupUniq, @{$newCourseLists{$crsName}} ) ) {
            # we know that the user is (also) in this course, or else we
            #    wouldn't have added the course to $oldMultipleRosters{uniq}
                    my $dupUser = $db->getUser( $dupUniq ); 
                    $dupUser->status('D');
                    $db->putUser( $dupUser );
#                  print "  * (dup) putUser($dupUniq, " . $dupUser->status . ")\n";
                    push( @dels, [ $crs, $dupUser->section(), $dupUniq, 
                                   $dupUser->student_id(),
                                   $dupUser->last_name(), 
                                   $dupUser->first_name() ] );
                } elsif ( $crsName eq $dupCrsName ) {
            # store skips with the course-section they are actually in
                    push( @skps, [ $crs, $sxn, $dupUniq ] );
                }
            }
        }

# finally, anyone who is in the old roster but not the new needs to be dropped
# we're a little careful here, and don't drop anyone who has better than 
# student privileges
        foreach my $uniq ( @{$oldCourseLists{$crsName}} ) {
            if ( ! isIn( $uniq, @{$newCourseLists{$crsName}} ) &&
                 ! defined( $oldMultipleRosters{$uniq} ) ) {

                my $userPermLvl = $db->getPermissionLevel($uniq);
                next if ( $userPermLvl->permission > 0 );
                my $delUser = $db->getUser( $uniq );
                $delUser->status( 'D' );
                $db->putUser( $delUser );
#              print "  * putUser($uniq, " . $delUser->status . ")\n";
                push( @dels, [ $crs, $sxn, $uniq, $delUser->student_id(),
                               $delUser->last_name(), 
                               $delUser->first_name() ] );
            }
        } # end of loop through uniqs in the old course rosters

# make set assignments to all new users
        if ( @usersSetAssign ) {
            my $fr = new FakeRequest();
            $fr->db( $db );
            $fr->ce( $ce );
            my $instrCG = WeBWorK::ContentGenerator::Instructor->new($fr);
            $instrCG->assignSetsToUsers( $setNames{$crsName}, 
                                         [@usersSetAssign] );
        }
# are there any users for whom we need to copy work?
        if ( @usersCopyWork ) {
     # we are doing this manually, without using the WeBWorK database,
     #    so bring up a DBI object
            my $old_course = $usersCopyWork[0]->[1];
            my $db = "DBI:mysql:webwork";
            my $ce = WeBWorK::CourseEnvironment->new(
                { webwork_dir => $wwHome, courseName  => $old_course } );
            my $ww_user = $ce->{dbLayout}->{password}->{params}->{username};
            my $ww_pass = $ce->{dbLayout}->{password}->{params}->{password};
            if ( ! $ww_user || ! $ww_pass ) {
                warn( "  ** aborting copy work: failed to find WW user " .
                      "or pass\n" );
                last;
            }

            my $err;
            my $dbHandle = DBI->connect( $db, $ww_user, $ww_pass, 
                                         {PrintError=>0, RaiseError=>0} ) or
                                             $err = DBI::errstr;
            if ( $err ) {
                warn( "  ** aborting copy work: DB connect failed: " .
                      "$err\n" );
                last;
            }

            foreach my $copyData ( @usersCopyWork ) {
                my ( $cuniq, $cocrsname, $cncrsname ) = @{$copyData};
                my ( $error, $message ) = 
                    copyWork( $crs, $cuniq, $cocrsname, $cncrsname, $dbHandle );
                if ( $error ) {
                    warn( "  ** aborting copy work: error $message\n" );
                    last;
                }
            }
        }
    } 
### end of update loop: foreach $crsName in ( @updateCrses ) loop

# print a summary of results
    print "done\n";
    print "  * added students: \n" if ( @adds );
    foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp 
                     $b->[0].$b->[1].$b->[4].$b->[5] } @adds ) {
        print "    $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
#      print "\n  [ " . join(', ', @$_) . " ]";
    } 
    print "  * reenrolled students: \n" if ( @reups );
    foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp 
                     $b->[0].$b->[1].$b->[4].$b->[5] } @reups ) {
        print "    $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
    }
# weed out of the dels students who were moved 
    my @moved = map { $_->[2] } @chgs;
    my @reallyDels = ();
    foreach ( @dels ) {push( @reallyDels, $_ ) if ( ! isIn($_->[2],@moved) );}
    print "\n  * dropped students: \n" if ( @reallyDels );
    foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp 
                     $b->[0].$b->[1].$b->[4].$b->[5] } @reallyDels ) {
        print "    $_->[0]-$_->[1] : $_->[2] ($_->[5] $_->[4])\n";
#      print "\n  [ " . join(', ', @$_) . " ]";
    } 
    print "\n  * moved students: \n" if ( @chgs );
#     foreach ( sort { $a->[4] cmp $b->[4] } @chgs ) {
    foreach ( sort { $a->[0].$a->[1].$a->[4].$a->[5] cmp 
                     $b->[0].$b->[1].$b->[4].$b->[5] } @chgs ) {
        my $on = $_->[0] . "," . $_->[1];
        $on =~ s/(\d{3})->(\d{3}),(\d{3})->(\d{3})/$1-$3=>$2-$4/;
#      print "$_->[4] ($on), ";
        print "    $on : $_->[2] ($_->[5] $_->[4])\n";
    }
    print "\n  * students in multiple old sections: " if ( @skps );
    foreach ( sort { $a->[2] cmp $b->[2] } @skps ) {
        my $ocrsList = ;
        foreach my $cn ( @{$oldMultipleRosters{$_->[2]}} ) {
            my ( $c, $s ) = ( $cn =~ /(\d{3})-(\d{3})/ );
            $ocrsList .= "$c-$s,";
        }
        $ocrsList =~ s/,$//;
        print "$_->[2] ([n] $_->[0]-$_->[1]; [o] $ocrsList), ";
    }
    print "\n  * students in multiple new sections (skipped): " 
        if ( %newMultipleRosters ); 
    foreach ( sort { $a cmp $b } keys( %newMultipleRosters ) ) {
        my $ncrsList = ;
        foreach my $cn ( @{$newMultipleRosters{$_}} ) {
            my ( $c, $s );
            if ( $cn =~ /(\d{3})-(\d{3})/ ) {
                $c = $1;
                $s = $2;
            } elsif ( $cn =~ /(\d{3})-[fwsu]\d\d/ ) {
                $c = $1;
                $s = 'xxx';
            } else {
                $c = '?';
                $s = '?';
            }
            $ncrsList .= "$c-$s,";
        }
        $ncrsList =~ s/,$//;
        print "$_ ($ncrsList), ";
    }
    print "\n" if ( @adds || @dels || @chgs || @reups || %newMultipleRosters );
    print " * done.\n";
}

sub copyWork {
    my ( $crsNum, $user_id, $old_course, $new_course, $dbHandle ) = @_;

    my $hsel = "select " . join(",", @copy_hwk_prob_user_fields) . 
        " from `${old_course}_problem_user` where user_id=? and (";
    $hsel .= join( " and ", ( 'set_id not like ?' )x@copyNotLike ) . ")";
    my $err;

    my $hsta = $dbHandle->prepare( $hsel ) or $err = $dbHandle->errstr();
    if ( $err ) {
        $dbHandle->disconnect();
        return ( 1, "Error preparing homework select command for $user_id in " .
                 "$old_course: $err\n" );
    } else {
        if ( $hsta->execute( $user_id, @copyNotLike ) ) {
            my $hwValRef = $hsta->fetchall_arrayref();

        ## next go through and update the new course
            my $hup = "update `${new_course}_problem_user` set " .
                join( ", ", 
                      ( map { "$_=?" } 
                        @copy_hwk_prob_user_fields[$copy_hwk_update_fields..$#copy_hwk_prob_user_fields] ) ) .
                " where " .
                join( " and ", ( map { "$_=?" } 
                                 @copy_hwk_prob_user_fields[0..($copy_hwk_update_fields-1)] ) );
            my $hupsta = $dbHandle->prepare( $hup ) or
                $err = $dbHandle->errstr();
        # print $hup, "\n";
        # my $pause = <STDIN>;
            if ( $err ) {
                $dbHandle->disconnect();
                return ( 1, "Error preparing update homework command for " .
                         "$user_id in $new_course: $err\n" );
            } else {
                foreach my $resRef ( @$hwValRef )  {

                    my @vals = ( @{$resRef}[$copy_hwk_update_fields..$#copy_hwk_prob_user_fields],
                                 @{$resRef}[0..($copy_hwk_update_fields-1)] );

                    # print "  > " . join(", ", @vals) . "\n";
                    if ( ! $hupsta->execute( @vals ) ) {
                        $err = $dbHandle->errstr();
                        $dbHandle->disconnect();
                        return( 1,
                                "Error updating homework values for $user_id " .
                                "in $new_course, problem set " .
                                $resRef->[$copy_problem_id_index] .
                                ": $err\n" );
                    }
                }
            }

        } else {
            $err = $dbHandle->errstr();
            $dbHandle->disconnect();
            return( 1, "Error executing homework select command for " .
                    "$user_id in $old_course: $err\n" );
        }
    }

    ##----------------------------
    ## get and copy old test data

    my $cmd = "select COUNT(*) from `${old_course}_set_user` where " .
        "user_id=? and set_id like ?";
    my $state = $dbHandle->prepare( $cmd ) or $err = $dbHandle->errstr();
    if ( $err ) {
        $dbHandle->disconnect();
        return( 1, "Error preparing count command $user_id in " .
                "$old_course: $err\n");
    } else {
        foreach my $test ( @{$copyTests{$crsNum}} ) {
            my $numTests = 0;
            if ( $state->execute( $user_id, "$test,v%" ) ) {
                $numTests = $state->fetchrow_array();

                if ( $numTests ) {
                    my $setuserCmd = "select " .
                        join(",", @copy_test_set_user_fields) .
                        " from `${old_course}_set_user` where user_id=? and " .
                        "set_id=?";
                    my $setState = $dbHandle->prepare( $setuserCmd ) or
                        $err = $dbHandle->errstr();

                    if ( $err ) {
                        $dbHandle->disconnect();
                        return( 1, "Error preparing set select statement " .
                                "for $user_id, $test in $old_course: $err\n" );

                    } elsif ( $setState->execute( $user_id,
                                                  "$test,v$numTests") ) {

                        my @setRes = $setState->fetchrow_array();

                        my $insertCmd = "insert into " .
                            "`${new_course}_set_user` " .
                            "(" . join(", ", @copy_test_set_user_fields) . 
                            ") values (" .
                            join(", ", map { "?" } @copy_test_set_user_fields) .
                            ")";
                        my @insertVals = @setRes;
                        my $newTest = "$test,v1";
                        $insertVals[$copy_set_id_index] = $newTest;

                        my $siState = $dbHandle->prepare( $insertCmd ) or
                            $err = $dbHandle->errstr();
                        if ( $err ) {
                            $dbHandle->disconnect();
                            return( 1, "Error preparing set insertion " .
                                    "command for $user_id, $test in " .
                                    "$new_course: $err\n" );
                        } elsif ( $siState->execute( @insertVals ) ) {

                            my $probuserCmd = "select " . 
                                join(",", @copy_test_prob_user_fields) .
                                " from `${old_course}_problem_user` where " .
                                "user_id=? and set_id=?";
                            my $probState =
                                $dbHandle->prepare( $probuserCmd ) or
                                $err = $dbHandle->errstr();
                            if ( $err ) {
                                $dbHandle->disconnect();
                                return( 1, "Error preparing problem select " .
                                        "statement for $user_id, $test in " .
                                        "$old_course: $err\n");

                            } elsif ($probState->execute($user_id, 
                                                 $setRes[$copy_set_id_index])) {

                                my $probRes = $probState->fetchall_arrayref();

                                my $pInsertCmd = "insert into `${new_course}" . 
                                    "_problem_user` (" . 
                                    join(", ", @copy_test_prob_user_fields) . 
                                    ") values" .
                                    " (" . 
                                    join(", ", 
                                         map {"?"} @copy_test_prob_user_fields) .
                                    ")";

                                my $piState = 
                                    $dbHandle->prepare( $pInsertCmd ) or
                                    $err = $dbHandle->errstr();
                                if ( $err ) {
                                    $dbHandle->disconnect();
                                    return( 1, "Error preparing problem " .
                                            "insert statement for $user_id, " .
                                            "$test, $new_course: $err\n" );
                                } else {

                                    foreach my $resRef ( @$probRes ) {
                                        my @pInsertVals = @$resRef;
                                        $pInsertVals[$copy_problem_set_id_index] = 
                                            $newTest;

                                        if ( $piState->execute(@pInsertVals) ) {
                                            next;
                                        } else {
                                            $err = $dbHandle->errstr();
                                            $dbHandle->disconnect();
                                            return( 
                                                1, 
                                                "Error inserting problem " .
                                                "data for $user_id, $test, " .
                                                "$new_course, problem " .
                                                "$pInsertVals[$copy_problem_id_index]" .
                                                ": $err\n" );
                                        }
                                    }
                                }
                            } else {
                                $err = $dbHandle->errstr();
                                $dbHandle->disconnect();
                                return( 1, "Error executing problem select " .
                                        "command for $user_id, $test in " .
                                        "$old_course: $err\n" );
                            }
                        } else {
                            $err = $dbHandle->errstr();
                            $dbHandle->disconnect();
                            return( 1, "Error executing set insertion " .
                                    "command for user $user_id, $test in " .
                                    "$new_course: $err\n" );
                        }
                    } else {
                        $err = $dbHandle->errstr();
                        $dbHandle->disconnect();
                        return( 1, "Error executing select statement for " .
                                "$user_id, $test in $old_course: $err\n" );
                    }
                }
            } else {
                $err = $dbHandle->errstr();
                $dbHandle->disconnect();
                return( 1, "Error executing count for $user_id and $test in " .
                        "$old_course: $err ($numTests)\n" );
            }
        }
    }
    return( 0,  );
}

sub csvSplit {
    my $line = shift();

    chomp($line);  # be safe...

    my @fields = ();
    while ( $line ) {
        my $term = ;
        if ( $line =~ /^"/ ) { #"
            $line = substr( $line, 1 );     # bite off quote
            my $ind = index( $line, '"' );  # "
            $term = substr( $line, 0, $ind );
            $line = ( $term =~ "$line," ) ?  : substr( $line, $ind+1 );
     # get rid of any trailing comma
            $line =~ s/^,//;

        } else {
            my $ind = index( $line, ',' );
            if ( $ind > 0 ) {
                $term = substr( $line, 0, $ind );
                $line = substr( $line, $ind );
                $line =~ s/^,//;
            } else {
                $term = $line;
                $line = ;
            }
        }
        $term =~ s/\s*(.*\S)\s*/$1/;  # get rid of white space
        push( @fields, $term );
    }
    return @fields;
}

sub isIn {
    my $v = shift();
    foreach ( @_ ) { return 1 if ( $v eq $_ ); }
    return 0;
}

sub getList {
    my ($str, $top) = @_;
    my @items = split(/,\s*/, $str);
    my @list = ();
    foreach ( @items ) {
        if ( $_ !~ /(\d+)|(\d+-\d+)/ ) {
            print "  error in specified list!\n";
        } elsif ( /-/ ) {
            my ($min,$max) = split(/-/,$_);
            if ( $min > $max || $min < 1 || $max > $top ) {
                print "  class number out of range!\n";
                @list = ();
                last;
            } else {
                for ( my $i=$min; $i<=$max; $i++ ) {
                    push(@list, $i);
                }
            }
        } else {
            if ( $_ < 0 || $_ > $top ) {
                print "  class number out of range!\n";
                @list = ();
                last;
            } else {
                if ( @list && $_ == 0 ) {
                    print "  class number of zero is out of range!\n";
                    @list = ();
                    last;
                } else {
                    push(@list, $_);
                }
            }
        }
    }
    return @list;
}

sub cryptPass($) {
    my ($clearPassword) = @_;
    my $salt = join("", ('.','/','0'..'9','A'..'Z','a'..'z')[rand 64, rand 64]);
    my $cryptPassword = crypt($clearPassword, $salt);
    return $cryptPassword;
}

sub hangIndent {
    my ( $hang, $width, $shorten, $text ) = @_;
# pre:  $hang and $width are numbers, $hang < $width; $text is a string
#       if $shorten, the first line is shortened by $shorten
# post: $text is reformatted to have maximum width $width and a hanging
#       indent of $hang each line after the first; the reformatted text
#       is returned
    my $htext = ;
    my $line = ;
    my $indent = ($shorten ? $shorten : 0);
    my $ldr = ' 'x$hang;

    if ( $indent + length($text) < $width ) {
        $htext = " $text";
    } else {
        foreach ( split(/\s+/, $text ) ) {
            if ( $indent + length($line) + length($_) >= ($width-1) ) {
                $htext .= $line . "\n$ldr";
                $line = $_;
                $indent = $hang;
            } else {
                $line .= " $_";
            }
        }
        $htext .= $line if ( $line );
    }
    $htext =~ s/\n$ldr$//;
    return $htext;
}

#-------------------------------------------------------------------------------
# fake WeBWorK packages that we don't want to build en masse in order to 
# get access to the importSetFromDef routine in ProblemSetList.pm
#

package FakeRequest;
sub new {
    my $class = shift();
    my $authz = new FakeAuthz;
    return( bless( { ce => , db => , authz => $authz }, $class ) );
}
sub ce {
    my $self = shift();
    $self->{ce} = shift() if ( @_ );
    return $self->{ce};
}
sub db {
    my $self = shift();
    $self->{db} = shift() if ( @_ );
    return $self->{db};
}
sub authz {
    my $self = shift();
    $self->{authz} = shift() if ( @_ );
    return $self->{authz};
}
sub param {
    my $self = shift();
    $self->{$_[0]} = $_[1] if ( @_ > 1 );
    return $self->{$_[0]};
}
1;

package FakeAuthz;
sub new { 
    my $class = shift();
    return( bless( { }, $class ) );
}
sub hasPermissions {
    return 1;
}
1;

# end of script
#-------------------------------------------------------------------------------