UpdateRosters

#!/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
#-------------------------------------------------------------------------------