#!/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 .
#
#-------------------------------------------------------------------------------
# global variables
#
my ( $archiveDir, $dataDir, $wwHome, $rosterDir, $htuser, $htgroup,
$proctorDir, $wwCourseDir ); $archiveDir = '/opt/webwork/Old';
$dataDir = '/path/to/classlists/data';
$proctorDir = '/path/to/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?
$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 < ";
chomp($action = );
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 = ;
}
} 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 = ;
chomp($delStr);
my @delList = getList($delStr, scalar(@classes));
while ( ! @delList ) {
print " * archive, delete which (0 to abort|n1,n2-n3,n4)> ";
chomp($delStr = );
@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 = ;
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 = ;
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 = ;
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 = ;
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 = ;
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 = ;
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 = ;
chomp($file);
if ( ! $file && $default ) {
$file = $instrFile;
} else {
while ( ! -f $file && ! -f "$dataDir/$file" ) {
print " can't locate file $file; file > ";
chomp($file = );
}
}
# 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 = ;
chomp($cs);
print " instructor uniqname > ";
my $uniq = ;
chomp($uniq);
print " instructor name ( First, MI, Last ) > ";
my $name = ;
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 = );
print "\n";
system('/usr/bin/stty echo');
print " again > ";
system('/usr/bin/stty -echo');
chomp($passwd2 = );
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 = );
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 = );
$adminPw = $adminID;
# print "\n again > ";
# my $pwCheck = ;
# chomp($pwCheck);
# while ( $adminPw ne $pwCheck ) {
# print "\n passwords don't match; again: password > ";
# chomp( $adminPw = );
# print "\n again > ";
# chomp( $pwCheck = );
# }
# 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 = ;
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 = );
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 = ;
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 = );
@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 = ;
chomp( $templNum );
while( $templNum !~ /^-?\d+$/ || $templNum < -1 ||
$templNum > @classNameList ) {
print " * please enter a number (-1 - " . scalar(@classNameList) .
") > ";
chomp( $templNum = );
}
# 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 = ;
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 = ;
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 = ;
chomp( $timeInterval );
$timeInterval = 43200 if ( ! $timeInterval );
print " number of tests per interval (0 for infty) > ";
my $numTests = ;
chomp( $numTests );
$numTests = 0 if ( ! $numTests );
print " time limit per test (in min) > ";
my $timeLimit = ;
chomp( $timeLimit );
$timeLimit *= 60;
# print " order problems randomly (0|1) > ";
# my $ordering = ;
my $ordering = 1;
chomp( $ordering );
print " problems per page ([cr] = all) > ";
my $pppage = ;
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 = ;
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 = ;
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 = );
@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 = ;
chomp($procFile);
$procFile = "$proctorDir/$procFile" if ( ! -f $procFile );
while ( ! -r $procFile ) {
print " * cannot read $procFile; file > ";
chomp($procFile = );
}
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 = ;
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 = );
@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 = ;
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 = ;
chomp( $term );
print " * campus extension ([cr] for none) > ";
my $ext = ;
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 = ;
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 = );
@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 = );
$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 = ;
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
#-------------------------------------------------------------------------------