WwclearAnonymous

#!/usr/bin/perl -w
#
# wwclearAnonymous: 
#    clear all versioned sets from practice users in @courses for which
#    the practice users are not currently logged in
#
# by Gavin LaRose, <glarose@umich.edu>
my $version = '1.21';
my $lastmod = '9 Aug 2010';
#
# changelog: 1.21: update copyright
#            1.2: correct for new database API
#            1.1: add logging capability
#
#  (c)2010 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/>.
#
#------------------------------------------------------------------------------ 
# configuration
#
use strict;
$ENV{PATH} = '/bin:/usr/bin';

# to get data from databases
my $wwHome = '/var/www/webwork/webwork2';
use lib '/var/www/webwork/webwork2/lib';
use WeBWorK::CourseEnvironment;
use WeBWorK::DB;
use WeBWorK::Utils;

# my @courses = ( qw( ma105-demo ) );
my @courses = ( qw( mathprep ) );

# should we log data about the number of tests taken?
my $keepLog = 1;

# the format of the log file is 
#    year mo da : course (#tests; #users), ..
# where #tests is the total number of tests deleted and #users the (maximum) 
# number of guest logins that had tests to delete when the script was run.  
# thus an entry will be like
#    2006 10 18 : ma105-demo (3; 1), ma115-demo (5; 2), ma116-demo (0; 0)
# if the script is run more than one time on a given day it will update the
# totals in the file.  this means that the number of tests is incremented 
# and if the maximum number of users is greater than that in the file the 
# maximum is also updated; if there are no tests in any of the courses, no 
# log entry is written
# my $logFile = '/var/www/data/gateways/demo_tests.txt';
my $logFile = '/var/www/data/webwork/demo_tests.txt';

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

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

sub main {
# data logging: logData{course} = { user => numtests }
    my %logData = () if ( $keepLog );

    foreach my $crs ( @courses ) {
	 $logData{$crs} = { } if ( $keepLog );

# bring up a course environment and database object
	 my $ce = WeBWorK::CourseEnvironment->new({webwork_dir => $wwHome,
						   courseName  => $crs});
	 my $db = WeBWorK::DB->new($ce->{dbLayout});

# get a list of all practice users
	 my @prUsers = grep {/^practice/} ( $db->listUsers() );

    # check to see which users are logged in
	 my @prKeys = $db->getKeys( @prUsers );
	 my @loggedIn = ();
	 foreach my $key ( @prKeys ) {
	     if ( defined($key) && 
		  time() <= $key->timestamp() + $ce->{sessionKeyTimeout} ) {
		 push( @loggedIn, $key->user_id() );
	     }
	 }

	 my @delUsers = ();
    # don't delete sets for those users
	 foreach my $user ( @prUsers ) {
	     my $skip = 0;
	     foreach my $in ( @loggedIn ) {
		 if ( $user eq $in ) {
		     $skip = 1;
		     last;
		 }
	     }
	     push( @delUsers, $user ) if ( ! $skip );
	 }

    # get and delete versioned sets for remaining practice users
	 # we have to get a list of all sets assigned, and then figure
	 #    out which of those are versioned
	 my @versionedSets = ();
	 if ( @delUsers ) {
	     my $user = $delUsers[0];
	     my @usIDs = map {[$user, $_]} ($db->listUserSets( $user ));
	     my @userSets = $db->getMergedSets( @usIDs );
	     @versionedSets = grep {$_->assignment_type =~ /gateway/} @userSets;
	     # and condense this down to just the assignment names
	     @versionedSets = map { $_->set_id } @versionedSets;
	 }

	 foreach my $user ( @delUsers ) {

	     my @setVersions = ();
	     foreach my $setID ( @versionedSets ) {
		 push(@setVersions, (map {[$setID,$_]} 
				     ($db->listSetVersions($user,$setID))));
	     }

	     $logData{$crs}->{$user} = scalar( @setVersions ) if ( $keepLog );

	     foreach my $setvID ( @setVersions ) {
		 $db->deleteSetVersion( $user, $setvID->[0], $setvID->[1] );
	     }
	 }
    }
    writeLogData( \%logData ) if ( $keepLog );
}

#
#------------------------------------------------------------------------------ 
# subroutines

sub writeLogData {
    my $dataRef = shift();
    my %logData = %$dataRef;

# build a new logData array logNums{crs} = [ numTests, numUsers ]
    my %logNums = ();
    my $totNumTests = 0;
    foreach my $crs ( keys ( %logData ) ) {
	 my $numTests = 0;
	 my $numUsers = 0;
	 foreach my $user ( keys ( %{$logData{$crs}} ) ) {
	     $numTests += $logData{$crs}->{$user};
	     $numUsers++ if ( $logData{$crs}->{$user} );
	 }
	 $totNumTests += $numTests;
	 $logNums{$crs} = [ $numTests, $numUsers ];
    }

    if ( $totNumTests ) {
	 my @timeVars = localtime();
	 my $year = $timeVars[5] + 1900;
	 my $month = sprintf("%02d", $timeVars[4] + 1);
	 my $day = sprintf("%02d", $timeVars[3]);

	 my $lineFmt = '\d{4} \d{2} \d{2} : ';
	 foreach my $crs ( @courses ) { $lineFmt .= $crs . ' \(\d+; \d+\), '; }
	 $lineFmt =~ s/, $//;

	 my @logLines = ();
	 @logLines = `/bin/cat $logFile` if ( -f $logFile );

	 open( LF, ">$logFile" ) or die("wwclearAnonymous: Cannot open log " .
					"file $logFile for writing.\n");

	 my $addedLogData = 0;
	 foreach my $line ( @logLines ) {
	     if ( $line =~ /^($lineFmt)/ ) {

		 if ( $line =~ /^$year $month $day/ )  {
		     my $newLine = "$year $month $day : ";
		     foreach my $crs ( @courses ) {
			 my ( $numTests, $numUsers ) = 
			     ( $line =~ /$crs \((\d+); (\d+)\)/ );

			 if ( defined( $numTests ) && defined( $numUsers ) &&
			      defined( $logData{$crs} ) ) {
			     $numTests += $logNums{$crs}->[0];
			     $numUsers = 
				 $logNums{$crs}->[1] if ( $numUsers < 
							  $logNums{$crs}->[1] );
			 }
			 $newLine .= "$crs ($numTests; $numUsers), ";
		     }
		     $newLine =~ s/, $//;
		     print LF $newLine, "\n";
		     $addedLogData = 1;

		 } else {
		     print LF $line;
		 }
	     } else {
	 # bad line format; skip line
		 next;
	     }
	 }
	 if ( ! $addedLogData ) {
	     my $newLine = "$year $month $day : ";
	     foreach my $crs ( @courses ) {
		 if ( defined( $logNums{$crs} ) ) {
		     $newLine .= "$crs (" . $logNums{$crs}->[0] . "; " . 
			 $logNums{$crs}->[1] . "), ";
		 } else { 
		     $newLine .= "$crs (0; 0), ";
		 }
	     }
	     $newLine =~ s/, $//;
	     print LF $newLine, "\n";
	 }
	 close(LF);
	 return 1;
    } else {
	 return 1;  # don't log anything if there are no tests taken
    }
}
#
#------------------------------------------------------------------------------