Difference between revisions of "WwScoreGetter"
m |
m |
||
Line 103: | Line 103: | ||
#------------------------------------------------------------------------------- |
#------------------------------------------------------------------------------- |
||
# main |
# main |
||
− | |||
+ | |||
sub main { |
sub main { |
||
my @argv = @_; |
my @argv = @_; |
Revision as of 09:12, 7 February 2014
#!/usr/bin/perl -w use strict; # wwScoreGetter: get a table of score data for the appropriate WeBWorK # sets. this is really a component of the ExamData system, but we # want to use WeBWorK calls rather than going into the WeBWorK # database manually, and so have a Perl script to get the data to # return to the ExamData system. # # the call is # wwScoreGetter [-c|-f filename] courseNum term [sectionNum] # the sets that get scored and returned are all those assigned to a # randomly chosen student in the course. if -c is specified, the scoring # file is written to the scoring directory in the course; if -f filename # it is written to the indicated filename; otherwise, it is written to # STDOUT # # we assume that courses all have names in the form # maXXX-XXX-XXX, e.g., ma115-001-f07, for math 105, 115, and 116, and # maXXX-XXX, e.g., ma215-f07, for math 215 and 216 # # the data for the scored sets are returned as a data stream with lines # NO OF FIELDS , , , , , \ # , , , , , \ # , , # SET NAME , , , , , \ # ,Chap1Sec1 ,Chap1Sec2 ,Chap1Sec3 ,Chap1Sec4 ,ProcEntrGW \ # ,summary , %score # DUE DATE , , , , , \ # , , , , , \ # , , # PROB VALUE , , , , , \ # ,8 ,6 ,7 ,8 ,7 \ # ,36.0 ,100.0 # STUDENT ID ,login ID ,LAST NAME ,FIRST NAME ,SECTION ,RECITATION \ # ,total ,total ,total ,total ,total \ # , , # 01234567 ,glarose ,Administrator ,An ,001 ,001 \ # ,0.5 ,0.0 ,0.0 ,8.0 ,3.0 \ # ,11.5 ,31.9 # these are lines (counting from 0) 1, 6, and 7- generated from the calls # to routines in the Scoring.pm ContentGenerator. # my $version = '1.3'; my $lastmod = '7 Feb 2014'; # # (c)2014 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/>. # #------------------------------------------------------------------------------- # setup variables, run script select STDERR; $|=1; select STDOUT; $|=1; my $wwHome = '/var/www/webwork/webwork2'; my $wwCourseDir = "$wwHome/courses"; my $usage = 'wwScoreGetter [-c|-f filename] courseNum term [sectionNum]'; # set environment variables to allow use of WeBWorK scripts # to get these set correctly will probably require running this from # a wrapper $ENV{WEBWORK_ROOT} = $wwHome; $ENV{WEBWORK_DIRECTORY} = $wwHome; $ENV{MOD_PERL_API_VERSION}=2; use lib '/var/www/webwork/pg/lib'; use lib '/var/www/webwork/webwork2/lib'; use WeBWorK::PG::ImageGenerator; use WeBWorK::CourseEnvironment; use WeBWorK::DB; use WeBWorK::ContentGenerator; use WeBWorK::ContentGenerator::Instructor; use WeBWorK::ContentGenerator::Instructor::Scoring; use lib '/home/glarose/IFS-Home/Private/mich/projrepo/examdata/bin'; use setLists; ## manually define those sets that we want to score; this becomes ## necessary because we drop the early sets in the semester my %scoreSets = %setLists::scoreSetsCurrent; # run script main( @ARGV ); # suppress residual errors (why is this necessary?) open( DN, ">/dev/null" ); *STDERR = *DN; exit 0; #------------------------------------------------------------------------------- # main sub main { my @argv = @_; my ( $cNum, $term, $sNum ); my $writeOutput = 0; my $outputFile = 0; my @rest = (); foreach ( @argv ) {
if ( $outputFile eq '-1' ) { $outputFile = $_; next; } if ( /^-c$/ ) { $writeOutput = 1; } elsif ( /^-f(.+)$/ ) { $outputFile = $1; } elsif ( /^-f$/ ) { $outputFile = -1; } elsif ( /^--/ || $_ !~ /^-/ || @rest ) { push( @rest, $_ ); }
} if ( @rest >= 2 ) {
$cNum = $rest[0]; $term = lc($rest[1]); if ( @rest == 3 ) { $sNum = $rest[2]; } else { $sNum = ; }
} else {
die("missing required input variables; $usage\n");
} my $courseName; if ( $cNum =~ /^1../ ) {
if ( ! $sNum ) { die("missing required section number for course $cNum\n"); } $courseName = "ma$cNum-$sNum-$term";
} else {
$courseName = "ma$cNum-$term";
} # get a webwork database object my $ce = WeBWorK::CourseEnvironment->new( { webwork_dir => $wwHome,
courseName => $courseName } );
my $db = WeBWorK::DB->new( $ce->{dbLayout} ); # get a list of user objects my @dbUserList = $db->listUsers; my @users = $db->getUsers( @dbUserList ); # we need to know permissions to see if the users are students or not my @perms = ( $db->getPermissionLevels( @dbUserList ) ); my %perms = map { $_->user_id => $_->permission() } @perms; # and sort them by userID my %usersById = (); foreach my $user ( @users ) {
next unless $user; $usersById{ $user->user_id } = $user;
} my @sortedIDs = sort {
lc($usersById{$a}->last_name) cmp lc($usersById{$b}->last_name) || lc($usersById{$a}->first_name) cmp lc($usersById{$b}->first_name) || lc($usersById{$a}->user_id) cmp lc($usersById{$b}->user_id) } keys %usersById;
# we also need a list of the sets for which we want data my @setIDs = (); # if we already have a list of sets to score, we use that list if ( @{$scoreSets{$cNum}} ) {
@setIDs = @{$scoreSets{$cNum}};
} else {
# otherwise, get a sample user, trying to avoid instructors, and # use the sets that are assigned to that user my $sampleUser = $users[0]; my $userIndex = 0; my $samplePerm = $db->getPermissionLevel( $sampleUser->user_id ); while ( $samplePerm->permission > 0 && $userIndex < @users-1 ) { $userIndex++; $sampleUser = $users[$userIndex]; $samplePerm = $db->getPermissionLevel( $sampleUser->user_id ); }
@setIDs = $db->listUserSets( $sampleUser->user_id );
} # drop gateway sets @setIDs = grep { $_ !~ /GW/ } @setIDs; # then we want to call a bunch of methods from the Scoring module, but # of course we don't have the created object. so build a fake such # object to use my $fr = new FakeRequest(); $fr->db( $db ); $fr->ce( $ce ); my $scoringCG = WeBWorK::ContentGenerator::Instructor::Scoring->new( $fr ); # make sure that padFields is set $scoringCG->{padFields} = 1; my @data = $scoringCG->scoreSet( $setIDs[0], "info", undef, \%usersById,
\@sortedIDs );
foreach my $setID ( @setIDs ) {
next unless defined $setID; my @totals = $scoringCG->scoreSet( $setID, "totals", 0, \%usersById, \@sortedIDs ); $scoringCG->appendColumns( \@data, \@totals );
} my @sumScores = $scoringCG->sumScores(\@data, 0, \%usersById, \@sortedIDs); $scoringCG->appendColumns( \@data, \@sumScores ); # now @data is an array of the scoring data, with element in the # array being one line in standard WeBWorK output. the following # (not surprisingly) rely on this format if ( $writeOutput ) {
my $scoringDir = "$wwCourseDir/$courseName/scoring"; my $scoringFileName = "${courseName}_totals.csv"; $scoringCG->writeCSV("$scoringDir/$scoringFileName", @data);
} elsif ( $outputFile ) {
my $scoringDir = "."; my $scoringFileName = "$outputFile"; $scoringCG->writeCSV("$scoringDir/$scoringFileName", @data);
} else {
# otherwise, send the data to STDOUT
my @outputLines = (); my $i = 0; foreach my $line ( @data ) { $i++; # next if ( ! ( $i-1 > 6 || $i-1 == 1 || $i-1 == 6 ) ); print join(",", map { $scoringCG->quote($_) } @$line ), "\n"; }
} return 1; } # end main #------------------------------------------------------------------------------- # fake packages 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 subroutines #------------------------------------------------------------------------------- # end script #-------------------------------------------------------------------------------