#!/usr/bin/perl -w
use strict;
#
# updateRosters [-s|-c]
# update a webwork classlist to correspond to the roster data found in
# $dataDir
# -s : assume the webwork roster has section & recitation # = section num
# (e.g., 115-103 has sxn=103, rct=103)
# -c : assume the webwork roster has the section # = course # and
# recitation # = section # (e.g., 115-103 has sxn=115, rct=103)
# otherwise, assume that section # = section # rounded down, recitation #
# = section number (e.g., 215-021 has sxn=020, rct=021)
#
# last modified 14 Jan 2011
# version 2.313
# changelog:
# 2.313: read default crs & sxn from roster name
# 2.311: avoid umd rosters
# 2.31: correct to clear any non-numeric character at the end
# of system classlist files (it's coming in with a \v)
# 2.3: update to allow -s flag to have section, recitation =
# section number, or -c flag for section = course number,
# recitation = section number
# 2.22: update to allow 115 et al., which use sxn=115, rct=sxn_num
# 2.21: take out conditional in getClass()
# 2.2 : allow multiple courses to synced into a single roster
# 2.1 : update to more sensibly deal with different courses
# 2.02: made paths smart
# 2.01: changed output to output only new drops
# 2.0: changed to output add, chg, del and all rosters
# 1.21: added hints to prompts
# 1.2: added sync of section and recitation numbers
# 1.1: added prompt for which sections
#
# (c)2013 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/>.
#-------------------------------------------------------------------------------
# data
#
# location of files CRS_SXN.csv
# we assume in selectRosters that the recitation sections are numbered 1-4,
# and that the corresponding section numbers are 0xy, where y=1-4.
my ( $dataDir );
if ( -d '/opt/www' ) {
$dataDir = '/afs/lsa.umich.edu/user/g/l/glarose/Private/classlists/data';
} else {
$dataDir = '/home/glarose/IFS-Home/LSA-Files/Private/classlists/data';
}
my $defaultName = '*.lst'; # default name for a webwork classlist file
my @wwfields = (); # 'global' variables for sorting & output
my %roster = ();
my $secNum = 0;
if ( @ARGV && $ARGV[0] eq '-s' ) {
$secNum = 's';
} elsif ( @ARGV && $ARGV[0] eq '-c' ) {
$secNum = 'c';
}
select STDERR; $| = 1;
select STDOUT; $| = 1;
#
#-------------------------------------------------------------------------------
# main
#
my ($class, $classFile) = getClass();
my @rosters;
if ( (@rosters = selectRosters($class)) ) {
my ( $addRef, $chgRef, $delRef, $allRef ) =
syncRoster($class, $classFile, @rosters);
print "\n";
outputRoster( $class, 'add', %$addRef );
outputRoster( $class, 'chg', %$chgRef );
outputRoster( $class, 'del', %$delRef );
outputRoster( $class, 'all', %$allRef );
} else {
die " ** updateRosters: can't find class rosters for $class in dataDir\n";
}
#
#-------------------------------------------------------------------------------
# subroutines
#
sub getClass {
# pre: nothing
# post: a class and class file have been established
my @list =
`/bin/ls $defaultName | egrep -v '(_add)|(_chg)|(_del)' 2> /dev/null`;
for ( my $i=0; $i<@list; $i++ ) { chomp($list[$i]); }
my ( $class, $classFile );
if ( @list || $list[0] ) {
if ( @list > 1 ) {
($class, $classFile) = promptForClass( @list );
} else {
chomp($classFile = $list[0]);
($class) = ($classFile =~ /(.+)\.lst$/);
my ( $crs, $sxn ) = (, );
if ( $classFile =~ /(\d{3})-(\d{3})/i ) {
($crs, $sxn) = ($1, $2);
} elsif ( $classFile =~ /(\d{3})-[fwsu](\d{2})/i ) {
$crs = $1;
$sxn = 'all';
} elsif ( $classFile =~ /(\d{3})-all.lst/ ) {
$crs = $1;
$sxn = 'all';
}
if ( $crs ) {
print " found class file $classFile for class $crs",
($sxn eq 'all' ? ' (all sections)' : "-$sxn"),
'. use these? ([y]|n) > ';
my $ans = <STDIN>;
chomp($ans);
# $class = $crs;
if ( $ans =~ /n/i ) { ($class, $classFile) = promptForClass(); }
} else {
( $class, $classFile ) = promptForClass();
}
}
} else {
($class, $classFile) = promptForClass();
}
return( $class, $classFile );
}
sub promptForClass {
# pre: input is nothing, or a list of class files to select from
# post: the class and class file are returned
my( $class, $classFile );
if ( @_ ) {
my @fileList = sort { $b cmp $a } @_;
print " found webwork class files:\n";
for ( my $i=1; $i<=@fileList; $i++ ) {
print " $i. " . $fileList[$i-1] . "\n";
}
print " enter selection or alternate file name > ";
my $ans = <STDIN>; chomp($ans);
while ( ! -f $ans && ( $ans !~ /^\d+$/ || $ans > @fileList ) ) {
if ( ! -f $ans ) {
print " cannot find $ans for reading; file or number > ";
} else {
print " please enter a number 0-", scalar(@fileList), ' > ';
}
chomp($ans = <STDIN>);
}
if ( $ans && $ans !~ /\D/ ) {
$classFile = $fileList[$ans-1];
} else {
$classFile = $ans;
}
my ( $crs, $sxn ) = (, );
if ( $classFile =~ /(\d{3})-(\d{3}|all)/i ) {
($crs, $sxn) = ($1, $2);
} elsif ( $classFile =~ /(\d{3})-[fwsu](\d{2})/i ) {
$crs = $1;
$sxn = 'all';
}
if ( $crs ) {
print " course-section (e.g., 115-027, 216-all, 215-101,103) " .
"[$crs-$sxn] > ";
chomp($ans = <STDIN>);
if ( $ans !~ /^$/ ) {
while ( $ans !~ /^((\d{3})-((\d{3})|(all)),?)+$/ ) {
print " unrecognized course-section format; again > ";
chomp($ans = <STDIN>);
}
($crs, $sxn) = ( $ans =~ /(\d{3})-(.+)/ );
}
} else {
print " course-section (e.g., 115-027, 216-all, 215-101,103) > ";
chomp($ans = <STDIN>);
while ( $ans !~ /^(\d{3})-(((\d{3})|(all)),?)+$/ ) {
print " unrecognized course-section format; again > ";
chomp($ans = <STDIN>);
}
($crs, $sxn) = ( $ans =~ /(\d{3})-(.+)/ );
}
$class = "$crs-$sxn";
} else {
my ( $crs, $sxn );
print " course to work with (e.g., 115) > ";
chomp( $crs = <STDIN> );
while ( $crs !~ /^\d{3}$/ ) {
print " unrecognized class format; again > ";
chomp($crs = <STDIN>);
}
print " section(s) to work with (e.g., 027; all; 101,102) > ";
chomp( $sxn = <STDIN> );
while ( $sxn !~ /^((\d{3})(,\d{3})*)|(all)$/ ) {
print " unrecognized section format; again > ";
chomp($sxn = <STDIN>);
}
$class = "$crs-$sxn";
print " webwork roster file > ";
chomp( $classFile = <STDIN> );
}
if ( -f $classFile ) {
return ($class, $classFile);
} else {
die " ** updateRosters: can't locate class file $classFile\n";
}
}
sub selectRosters {
my $class = shift();
# pre: $class is a class name, e.g. 115-027 or 216-all
# post: a list of roster files to consider is returned
my ( $crs, $sxn ) = ( $class =~ /(\d{3})-(.+)/ );
my @rosters = ();
if ( $sxn eq 'all' ) {
if ( $crs eq '215' || $crs eq '216' ) {
@rosters = `/bin/ls $dataDir/${crs}_??[1-4].csv 2> /dev/null`;
} else {
@rosters = `/bin/ls $dataDir/${crs}_???.csv 2> /dev/null`;
}
} elsif ( $sxn !~ /,/ ) {
@rosters = `/bin/ls $dataDir/${crs}_${sxn}.csv 2> /dev/null`;
} else {
my @slist = split(/,/, $sxn);
foreach ( @slist ) {
push( @rosters, `/bin/ls $dataDir/${crs}_$_.csv 2> /dev/null` );
}
}
if ( @rosters ) {
for ( my $i=0; $i<@rosters; $i++ ) { chomp($rosters[$i]); }
} else {
die " ** updateRosters: can't find rosters for course $crs-$sxn\n";
}
return @rosters;
}
sub syncRoster {
my ( $class, $classFile, @rosters ) = @_;
# pre: $class is a class number, $classFile is the webwork class roster file,
# and @rosters is the list of system roster files.
# post: return a new roster hash, %wwRost = { $id => [ @webworkRosterFields ] }
# the return rosters
my %adds = (); my %dels = (); my %chgs = ();
my ( $crs, $sxn ) = ( $class =~ /(\d{3})-(.+)/ );
# read in class rosters
my $rost = join(' ', @rosters);
my %sysRost = ();
foreach my $line ( `/bin/cat $rost` ) {
my @fields = split(/,/, $line);
chomp($fields[-1]);
my $lchar = (split(//, $fields[-1]))[-1]; # we're getting a character
if ( $lchar !~ /^\d$/ ) { # code 13 through as the
chop( $fields[-1] ); # last character after
} # the chomp()
for ( my $i=0; $i<@fields; $i++ ) { $fields[$i] =~ s/\"//g; }
$sysRost{$fields[-1]} = [ @fields ];
}
# class roster fields are
# crs, sxn, uniqname, last, first middle, id#
# read in webwork roster
my %wwRost = ();
foreach my $line ( `/bin/cat $classFile` ) {
my @fields = split(/\s*,\s*/, $line);
chomp($fields[-1]);
for ( my $i=0; $i<@fields; $i++ ) { $fields[$i] =~ s/\s+$//; }
# skip comment lines & ta/prof entries
next if ( $line =~ /^#/ ||
($fields[-1] =~ /^\d+$/ && $fields[-1] >= 5) );
$wwRost{$fields[0]} = [ @fields ];
}
# ww roster fields are
# id, last, first middle, C, , sxn, recitation, e-mail, username
# sync them up
my @drops = ();
my @changes = ();
foreach my $id ( keys %wwRost ) {
next if ( $wwRost{$id}->[-1] =~ /^practice/ ||
$wwRost{$id}->[5] eq '000' || $wwRost{$id}->[6] eq '000' );
if ( ! defined( $sysRost{$id} ) ) {
if ( $wwRost{$id}->[3] ne 'D' ) {
$wwRost{$id}->[3] = 'D';
$dels{$id} = $wwRost{$id};
push( @drops, "$wwRost{$id}->[2] $wwRost{$id}->[1] " .
"($wwRost{$id}->[8], XXX" .
"-$wwRost{$id}->[5]/$wwRost{$id}->[6])" );
}
} else { # check for correct section data
my $sxn;
my $rct;
if ( $secNum ) {
if ( $secNum eq 'c' ) {
$sxn = $sysRost{$id}->[0];
} else {
$sxn = $sysRost{$id}->[1];
}
$rct = $sysRost{$id}->[1];
} else {
$sxn = substr($sysRost{$id}->[1],0,2) . "0";
$rct = $sysRost{$id}->[1];
}
if ( $sxn ne $wwRost{$id}->[5] || $rct ne $wwRost{$id}->[6] ) {
push( @changes, "$wwRost{$id}->[2] $wwRost{$id}->[1] " .
"($wwRost{$id}->[8], $wwRost{$id}->[5]/" .
"$wwRost{$id}->[6] -> $sxn/$rct)" );
# make sure that we have an enrolled status
$wwRost{$id}->[3] = 'C';
$wwRost{$id}->[5] = $sxn;
$wwRost{$id}->[6] = $rct;
$chgs{$id} = $wwRost{$id};
}
}
}
my @adds = ();
foreach my $id ( keys %sysRost ) {
if ( ! defined( $wwRost{$id} ) ) {
my $sxn;
my $rct;
if ( $secNum ) {
if ( $secNum eq 'c' ) {
$sxn = $sysRost{$id}->[0];
} else {
$sxn = $sysRost{$id}->[1];
}
$rct = $sysRost{$id}->[1];
} else {
$sxn = substr($sysRost{$id}->[1],0,2) . "0";
$rct = $sysRost{$id}->[1];
}
$wwRost{$id} = [ $id, $sysRost{$id}->[3], $sysRost{$id}->[4],
'C', ' ', $sxn, $rct,
"$sysRost{$id}->[2]\@umich.edu",
$sysRost{$id}->[2] ];
$adds{$id} = $wwRost{$id};
push( @adds, "$sysRost{$id}->[4] $sysRost{$id}->[3] " .
"($sysRost{$id}->[5], $sxn-$rct)" );
}
}
# report on sync
print "\ndone sync of rosters.\n";
if ( @drops ) {
print " dropped students:\n";
foreach ( @drops ) { print " $_\n"; }
}
if ( @changes ) {
print " changed students:\n";
foreach ( @changes ) { print " $_\n"; }
}
if ( @adds ) {
print " added students:\n";
foreach ( @adds ) { print " $_\n"; }
}
return ( \%adds, \%chgs, \%dels, \%wwRost );
}
sub outputRoster {
my $class = shift;
my $flag = shift;
%roster = @_;
# pre: $class is the class, flag an indicator of the type of roster,
# and %roster is a hash of webwork roster entries
# post: an output file is asked for and the new roster printed
my @datef = localtime();
my $datestr = substr($datef[5],1) . sprintf("%02d", ($datef[4]+1)) .
sprintf("%02d", $datef[3]);
$class =~ s/[0-9],.*/x/;
my $outFile = "${class}_$flag$datestr.lst";
my $killIt = 0;
while ( -f $outFile && ! $killIt ) {
print "$outFile exists; overwrite? [cr]|newname > ";
chomp($killIt = <STDIN>);
if ( $killIt =~ /^$/ ) { $killIt = 1; }
else { $outFile = $killIt; $killIt = 0; }
}
open( WWR, ">$outFile" ) or
die " ** updateRosters: can't open $outFile for writing\n";
foreach ( sort byroster keys %roster ) {
@wwfields = @{$roster{$_}};
if ( $class =~ /^115/ ) { $wwfields[5] = '115'; }
write WWR;
}
close( WWR );
print "$flag roster written to $outFile\n";
return 1;
}
sub byroster {
return( ($roster{$a}->[5] . $roster{$a}->[6] . $roster{$a}->[1] .
$roster{$a}->[2]) cmp ($roster{$b}->[5] . $roster{$b}->[6] .
$roster{$b}->[1] . $roster{$b}->[2]) );
}
format WWR =
@<<<<<<< ,@<<<<<<<<<<<<<<< ,@<<<<<<<<<<<<<<<<<<<<<<< ,@<,@<,@<<<,@<<<,@<<<<<<<<<
<<<<<<<<<<<<<<<< ,@<<<<<<<<
@wwfields
.
#
# end script
#-------------------------------------------------------------------------------