WwManage
Jump to navigation
Jump to search
#!/usr/bin/perl -w use strict; # # wwManage: manage webwork gateways/homework courses # my $version = '1.702'; my $lastmod = '13 Jan 2011'; # changelog: # 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'; # 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/gateways/webwork/data/NEWTERM/CRS"; # do we save them at all? my $saveWWrosters = 0; # 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 = ( '_umd' ); # and these extensions on course names similarly; the order of these # extensions is the same as in @fileCampusExt my @courseCampusExt = ( '-umd' ); # admin users for these extensions are: my %courseCampusAdmins = ( '-umd' => { 'user_id' => 'username', 'student_id' => '007', 'last_name' => 'Last', 'first_name' => 'First' }, ); # default e-mail domain my $mailDomain = 'umich.edu'; $wwHome = '/opt/webwork/webwork2'; $wwCourseDir = "$wwHome/courses"; # 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 '/opt/webwork/pg/lib'; use lib '/opt/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'; 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 aren't assigned to everyone; they just need to be imported # when we're adding assignments to a course # precal assignments also include "substitution", but this is the same # name as the integral topic my @groupSets = ( qw( exponents frac_exponents fractions graphs lines multistep solving_linsys polynomials solving_quadratics 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 ) ); # 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 ) { 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. list archived courses 0. quit eol my $action = -1; while ( $action !~ /^[0-9]$/ ) { print " selection> "; chomp($action = <STDIN>); warn " ** value must be between 0 and 8.\n" if ( $action !~ /^[0-8]$/ ); } 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 $wwHome/courses/*`; 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 print " * archive term [$curTerm] > "; my $arTerm = <STDIN>; chomp($arTerm); if ( $arTerm eq ) { $arTerm = $curTerm; } 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],12345678,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.."; # in the long run, we probably want the term, too 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; 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; } 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\@$mailDomain", '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\@$mailDomain", '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] . "\@$mailDomain", '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} . "\@$mailDomain", '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\n"; 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 finally make sure that all of the files have the right user and group system("/bin/chown", "-R", "$htuser:$htgroup", "$wwHome/courses/$courseID"); } } 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 } = { 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 ); 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 my $set = $db->getGlobalSet( $setName ); foreach my $field ( %{$assignmentData{ $setFile }} ) { $set->{$field} = $assignmentData{$setFile}->{$field}; } $db->putGlobalSet( $set ); } } 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 (give n1,n2-n3,n4)> "; my $procList = <STDIN>; chomp($procList); if ( ! $procList ) { print " ** error: no classes specified for proctor add *\n"; return 0; } else { my @procCrsList = getList($procList, scalar(@classNameList)); while ( ! @procCrsList ) { print " * courses to which to add proctors (give 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/ ); } # 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 (give n1,n2-n3,n4)> "; my $procList = <STDIN>; chomp($procList); if ( ! $procList ) { print " ** error: no classes specified for proctor add *\n"; return 0; } else { my @procCrsList = getList($procList, scalar(@classNameList)); while ( ! @procCrsList ) { print " * courses to which to del proctors (give 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 updateRosters { # pre: # post: we update the rosters of the requested courses based on the # roster data in $dataDir 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] ); } } # 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 = (); my @skipClassNames = ();
# people we don't move or alter: adminUsers = ( list of uniqs ) my @adminUsers = (); foreach my $crsName ( @updateCrses ) { my $fileExt = ; my ( $crs, $sxn ) = ( $crsName =~ /(\d{3})-(\d{3})/ ); print "$crs-$sxn.."; if ( ! defined($crs) || ! defined($sxn) ) { print " ** error getting course and section number from " . "$crsName; skipping\n"; push( @skipClassNames, $crsName ); next; } ## 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++; } if ( ! -r "$dataDir/${crs}_${sxn}${fileExt}.csv" ) { print " ** error reading course-section file 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, $sxn, $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 ( $crs, $sxn ) = ( $crsName =~ /(\d{3})-(\d{3})/ ); print "$crs-$sxn.."; $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, $sxn, $_->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) ); } $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 ( $crs, $sxn ) = ( $crsName =~ /(\d{3})-(\d{3})/ ); print "$crs-$sxn.."; # keep a list of adds, who need to have sets assigned in this course my @usersSetAssign = (); 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 ) = ( $oldCrsName =~ /(\d{3})-(\d{3})/ ); 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($sxn); $newUser->recitation($sxn); $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, $sxn, $uniq, $umid, $lname, $fname ]); } # also store the student to assign sets to them at the end of # the course loop push( @usersSetAssign, $uniq ); # 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, $sxn, $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 $sxn ) { # first, let's bring up a new course environment and db for the # student's old course my $oCrsName = $oldRosters{$uniq}->[0]; 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 my $oldUser = $odb->getUser( $uniq ); $oldUser->status('C'); $oldUser->section( $sxn ); $oldUser->recitation( $sxn ); my $oldPerm = $odb->getPermissionLevel( $uniq ); my $oldPass = $odb->getPassword( $uniq ); # save this in the new course. eval( $db->addUser( $oldUser ) ); if ( $@ ) { print " * error moving user $uniq from $oCrs-$oSxn " . "to $crs-$sxn: $@\n"; next; } else { $db->addPermissionLevel( $oldPerm ); $db->addPassword( $oldPass ); # for now, we don't try and move scores if ( 0 ) { # then, we see what we can do with scores... # get a list of all of the sets from the old course and add them # 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 foreach my $setID ( @oldSetIDs, @oldVSetIDs ) { my @oldProblems = $db->getAllUserProblems($uniq,$setID); foreach ( @oldProblems ) { eval( $db->putUserProblem( $_ ) ); if ( $@ ) { print " * error adding problems, from ", "prob ", $_->problem_id(), " to set $setID for ", "user $uniq: $@\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] . "->" . $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, $sxn, $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] ); } } ### 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 ) = ( $cn =~ /(\d{3})-(\d{3})/ ); $ncrsList .= "$c-$s,"; } $ncrsList =~ s/,$//; print "$_ ($ncrsList), "; } print "\n" if ( @adds || @dels || @chgs || @reups || %newMultipleRosters ); print " * done.\n"; } 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}; } 1; package FakeAuthz; sub new { my $class = shift(); return( bless( { }, $class ) ); } sub hasPermissions { return 1; } 1; # end of script #-------------------------------------------------------------------------------