You can subscribe to this list here.
2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(58) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2005 |
Jan
(53) |
Feb
(56) |
Mar
|
Apr
|
May
(30) |
Jun
(78) |
Jul
(121) |
Aug
(155) |
Sep
(77) |
Oct
(61) |
Nov
(45) |
Dec
(94) |
2006 |
Jan
(116) |
Feb
(33) |
Mar
(11) |
Apr
(23) |
May
(60) |
Jun
(89) |
Jul
(130) |
Aug
(109) |
Sep
(124) |
Oct
(63) |
Nov
(82) |
Dec
(45) |
2007 |
Jan
(31) |
Feb
(35) |
Mar
(123) |
Apr
(36) |
May
(18) |
Jun
(134) |
Jul
(133) |
Aug
(241) |
Sep
(126) |
Oct
(31) |
Nov
(15) |
Dec
(5) |
2008 |
Jan
(11) |
Feb
(6) |
Mar
(16) |
Apr
(29) |
May
(43) |
Jun
(149) |
Jul
(27) |
Aug
(29) |
Sep
(37) |
Oct
(20) |
Nov
(4) |
Dec
(6) |
2009 |
Jan
(34) |
Feb
(30) |
Mar
(16) |
Apr
(6) |
May
(1) |
Jun
(32) |
Jul
(22) |
Aug
(7) |
Sep
(18) |
Oct
(50) |
Nov
(22) |
Dec
(8) |
2010 |
Jan
(17) |
Feb
(15) |
Mar
(10) |
Apr
(9) |
May
(67) |
Jun
(30) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
From: Sam H. v. a. <we...@ma...> - 2005-09-27 21:44:03
|
Log Message: ----------- formatting Modified Files: -------------- webwork2/lib/WeBWorK: Authen.pm Revision Data ------------- Index: Authen.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Authen.pm,v retrieving revision 1.42 retrieving revision 1.43 diff -Llib/WeBWorK/Authen.pm -Llib/WeBWorK/Authen.pm -u -r1.42 -r1.43 --- lib/WeBWorK/Authen.pm +++ lib/WeBWorK/Authen.pm @@ -433,9 +433,7 @@ } } - ######################################################### # a password was supplied. - ######################################################### if ($passwd) { if ($self->checkPassword($user, $passwd)) { @@ -459,9 +457,8 @@ # neither a key or a password were supplied. $error = "You must enter a password." } - ############################################# - # Check for multiply defined users - ############################################ + + # check for multiply defined users my @test_users = $r->param("user"); if (@test_users>1) { warn "User has been multiply defined in Authen.pm ", join(" ", @test_users) ; @@ -469,12 +466,10 @@ @test_users = $r->param("user"); warn "New value of user is ", join(" ", @test_users); } - ##### end check ###################### - if (defined $error) { # authentication failed, store the error message - $r->notes("authen_error",$error); + $r->notes("authen_error", $error); # if we got a cookie, it probably has incorrect information in it. so # we want to get rid of it |
From: Sam H. v. a. <we...@ma...> - 2005-09-27 03:58:11
|
Log Message: ----------- percent sign snuck in there oops Modified Files: -------------- webwork2/conf: global.conf.dist Revision Data ------------- Index: global.conf.dist =================================================================== RCS file: /webwork/cvs/system/webwork2/conf/global.conf.dist,v retrieving revision 1.141 retrieving revision 1.142 diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.141 -r1.142 --- conf/global.conf.dist +++ conf/global.conf.dist @@ -133,7 +133,7 @@ # %r = recitation # %% = literal percent sign # -$mail{feedbackSubjectFormat} = "[WWfeedback] course:%c %% user:%u set:%s prob:%p sec:%x rec:%r"; +$mail{feedbackSubjectFormat} = "[WWfeedback] course:%c user:%u set:%s prob:%p sec:%x rec:%r"; # feedbackVerbosity: # 0: send only the feedback comment and context link |
From: Mike G. v. a. <we...@ma...> - 2005-09-26 04:11:28
|
Log Message: ----------- Changed the numerical values of lbf to make it more accurate (assuming that lbf is an abbreviation for ft-lbs which I doubt). Also replaced the conversion factor for pounds with a more accurate figure. Modified Files: -------------- pg/lib: Units.pm Revision Data ------------- Index: Units.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Units.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -Llib/Units.pm -Llib/Units.pm -u -r1.3 -r1.4 --- lib/Units.pm +++ lib/Units.pm @@ -51,6 +51,7 @@ # be zero. my $PI = 4*atan2(1,1); +# 9.80665 m/s^2 -- standard accelearationof gravity my %known_units = ('m' => { 'factor' => 1, @@ -288,7 +289,7 @@ 's' => -2 }, 'lb' => { - 'factor' => 4.45, + 'factor' => 4.4482216152605, 'm' => 1, 'kg' => 1, 's' => -2 @@ -328,7 +329,7 @@ 's' => -2 }, 'lbf' => { - 'factor' => 1.355, + 'factor' => 1.35582, 'm' => 2, 'kg' => 1, 's' => -2 |
From: dpvc v. a. <we...@ma...> - 2005-09-24 02:38:14
|
Log Message: ----------- Updated to be able to handle empty anwswer blanks. There is a new parameter for the MultiPart object (allowBlankAnswers) that controls whether the checker routine will be called even when there are blank entries (normally, the checker is not called unless all the entries are non-blank). Use $mp = MultiPart(1,2)->with(checkTypes=>0,allowBlankAnswers=>0); to have the checker routine called when answers are left blank. You can now also include blank answers in the list itself: $mp = MultiPart(1,2,""); (there is no need to include allowBlankAnswers in this case, because the blank string will take care of itself. Modified Files: -------------- pg/macros: parserMultiPart.pl Revision Data ------------- Index: parserMultiPart.pl =================================================================== RCS file: /webwork/cvs/system/pg/macros/parserMultiPart.pl,v retrieving revision 1.3 retrieving revision 1.4 diff -Lmacros/parserMultiPart.pl -Lmacros/parserMultiPart.pl -u -r1.3 -r1.4 --- macros/parserMultiPart.pl +++ macros/parserMultiPart.pl @@ -29,7 +29,7 @@ # You need to provide a checker routine that will be called to determine if the # answers are correct or not. The checker will only be called if the student # answers have no syntax errors and their types match the types of the professor's -# answers, so you don't ahve to worry about handling bad data from the student +# answers, so you don't have to worry about handling bad data from the student # (at least as far as typechecking goes). # # The checker routine should accept three parameters: a reference to the array @@ -103,7 +103,7 @@ # or one for each answer rule. # (Default: 0) # -# namedRules => 0 or 1 wether to use named rules or default +# namedRules => 0 or 1 whether to use named rules or default # rule names. Use named rules if you need # to intersperse other rules with the # ones for the MultiPart, in which case @@ -117,6 +117,12 @@ # the types before you use the data). # (Default: 1) # +# allowBlankAnswers=>0 or 1 whether to remove the blank-check prefilter +# from the answer checkers for the answer +# checkers used for type checking the student's +# answers. +# (Default: 0) +# # separator => string the string to use between entries in the # results area when singleResult is set. # @@ -139,7 +145,8 @@ } bless { data => [@data], cmp => [@cmp], ans => [], - part => 0, singleResult => 0, namedRules => 0, checkTypes => 1, + part => 0, singleResult => 0, namedRules => 0, + checkTypes => 1, allowBlankAnswers => 0, tex_separator => $separator.'\,', separator => $separator.' ', context => $$Value::context, id => $answerPrefix.($count++), }, $class; @@ -159,6 +166,17 @@ } } die "You must supply a checker subroutine" unless ref($self->{checker}) eq 'CODE'; + if ($self->{allowBlankAnswers}) { + foreach my $cmp (@{$self->{cmp}}) { + $cmp->install_pre_filter('erase'); + $cmp->install_pre_filter(sub { + my $ans = shift; + $ans->{student_ans} =~ s/^\s+//g; + $ans->{student_ans} =~ s/\s+$//g; + return $ans; + }); + } + } my @cmp = (); if ($self->{singleResult}) { push(@cmp,$self->ANS_NAME(0)) if $self->{namedRules}; @@ -278,7 +296,7 @@ my $i = $ans->{part}; $self->{ans}[$i] = $self->{cmp}[$i]->evaluate($ans->{student_ans}); $self->{ans}[$i]->score(0); - $self->perform_check if ($i == $self->length - 1); + $self->perform_check($ans) if ($i == $self->length - 1); return $self->{ans}[$i]; } @@ -294,7 +312,8 @@ # Set the individual scores based on the result from the user's routine. # sub perform_check { - my $self = shift; $self->{context}->clearError; + my $self = shift; my $rh_ans = shift; + $self->{context}->clearError; my @correct; my @student; foreach my $ans (@{$self->{ans}}) { push(@correct,$ans->{correct_value}); @@ -302,7 +321,7 @@ return if $ans->{ans_message} ne "" || !defined($ans->{student_value}); return if $self->{checkTypes} && $ans->{student_value}->type ne $ans->{correct_value}->type; } - my $result = Value::cmp_compare([@correct],[@student],$self); + my $result = Value::cmp_compare([@correct],[@student],$self,$rh_ans); if (!defined($result) && $self->{context}{error}{flag}) {$self->cmp_error($self->{ans}[0]); return 1} $result = 0 if (!defined($result) || $result eq ''); if (ref($result) eq 'ARRAY') { |
From: dpvc v. a. <we...@ma...> - 2005-09-24 00:51:53
|
Log Message: ----------- Prevent empty answers that are marked as correct from being counted as unanswered blanks. This avoids the "all the above are correct/at least one of the above are NOT correct" problem, and suppresses the "n questions remain unanswered" message when the empty questions are counted as correct. Modified Files: -------------- webwork-modperl/lib/WeBWorK/ContentGenerator: Problem.pm Revision Data ------------- Index: Problem.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm,v retrieving revision 1.185 retrieving revision 1.186 diff -Llib/WeBWorK/ContentGenerator/Problem.pm -Llib/WeBWorK/ContentGenerator/Problem.pm -u -r1.185 -r1.186 --- lib/WeBWorK/ContentGenerator/Problem.pm +++ lib/WeBWorK/ContentGenerator/Problem.pm @@ -250,7 +250,7 @@ my $answerMessage = $showMessages ? $answerResult->{ans_message} : ""; $answerMessage =~ s/\n/<BR>/g; $numCorrect += $answerScore >= 1; - $numBlanks++ unless $studentAnswer =~/\S/; # unless student answer contains entry + $numBlanks++ unless $studentAnswer =~/\S/ || $answerScore >= 1; # unless student answer contains entry my $resultString = $answerScore >= 1 ? "correct" : $answerScore > 0 ? int($answerScore*100)."% correct" : "incorrect"; |
From: dpvc v. a. <we...@ma...> - 2005-09-24 00:47:27
|
Log Message: ----------- Added ability to have answers that are empty strings. String("") now will produce a valid string object regardless of the Context's defined string values. (You can prevent this using Context()->flags->set(allowEmptyStrings=>0); if you wish). String("")->cmp will produce an answer checker for an empty string (it removes the blank checker that WW installs). Modified Files: -------------- pg/lib: Parser.pm Value.pm pg/lib/Parser: String.pm pg/lib/Value: AnswerChecker.pm String.pm Revision Data ------------- Index: Value.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Value.pm,v retrieving revision 1.47 retrieving revision 1.48 diff -Llib/Value.pm -Llib/Value.pm -u -r1.47 -r1.48 --- lib/Value.pm +++ lib/Value.pm @@ -24,8 +24,9 @@ # ijk => 0, # print vectors as <...> # - # word to use for infinity + # For strings: # + allowEmptyStrings => 1, infiniteWord => 'infinity', # # For intervals and unions: @@ -174,7 +175,7 @@ # sub makeValue { my $x = shift; my %params = (showError => 0, makeFormula => 1, @_); - return $x if (ref($x) && ref($x) ne 'ARRAY') || $x eq ''; + return $x if ref($x) && ref($x) ne 'ARRAY'; return Value::Real->make($x) if matchNumber($x); if (matchInfinite($x)) { my $I = Value::Infinity->new(); @@ -182,7 +183,8 @@ return $I; } return Value::String->make($x) - if (!$Parser::installed || $$Value::context->{strings}{$x}); + if !$Parser::installed || $$Value::context->{strings}{$x} || + ($x eq '' && $$Value::context->{flags}{allowEmptyStrings}); return $x if !$params{makeFormula}; Value::Error("String constant '%s' is not defined in this context",$x) if $params{showError}; @@ -256,6 +258,7 @@ elsif (ref($value)) {return 'unknown'} elsif (defined($strings->{$value})) {return 'String'} elsif (Value::isNumber($value)) {return 'Number'} + elsif ($value eq '' && $equation->{context}{flags}{allowEmptyStrings}) {return 'String'} return 'unknown'; } Index: Parser.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Parser.pm,v retrieving revision 1.30 retrieving revision 1.31 diff -Llib/Parser.pm -Llib/Parser.pm -u -r1.30 -r1.31 --- lib/Parser.pm +++ lib/Parser.pm @@ -39,7 +39,10 @@ my $tree = $string; $tree = $tree->{tree} if exists $tree->{tree}; $math->{tree} = $tree->copy($math); } elsif (Value::isValue($string)) { - $math->{tree} = $math->{context}{parser}{Value}->new($math,$string); + $math->{tree} = $context->{parser}{Value}->new($math,$string); + } elsif ($string eq '' && $context->{flags}{allowEmptyStrings}) { + $math->{string} = ""; + $math->{tree} = $context->{parser}{Value}->new($math,""); } else { $math->{string} = $string; $math->tokenize; Index: String.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Parser/String.pm,v retrieving revision 1.10 retrieving revision 1.11 diff -Llib/Parser/String.pm -Llib/Parser/String.pm -u -r1.10 -r1.11 --- lib/Parser/String.pm +++ lib/Parser/String.pm @@ -19,7 +19,7 @@ my $def = $equation->{context}{strings}{$value}; unless ($def) { $def = $equation->{context}{strings}{uc($value)}; - $def = undef if $def->{caseSensitive} && $value ne uc($value); + $def = {} if $def->{caseSensitive} && $value ne uc($value); } $value = $def->{alias}, $def = $equation->{context}{strings}{$value} while defined($def->{alias}); Index: AnswerChecker.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v retrieving revision 1.65 retrieving revision 1.66 diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.65 -r1.66 --- lib/Value/AnswerChecker.pm +++ lib/Value/AnswerChecker.pm @@ -617,6 +617,25 @@ return $typeMatch->typeMatch($other,$ans); } +# +# Remove the blank-check prefilter when the string is empty, +# and add a filter that removes leading and trailing whitespace. +# +sub cmp { + my $self = shift; + my $cmp = $self->SUPER::cmp(@_); + if ($self->value =~ m/^\s*$/) { + $cmp->install_pre_filter('erase'); + $cmp->install_pre_filter(sub { + my $ans = shift; + $ans->{student_ans} =~ s/^\s+//g; + $ans->{student_ans} =~ s/\s+$//g; + return $ans; + }); + } + return $cmp; +} + ############################################################# package Value::Point; Index: String.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Value/String.pm,v retrieving revision 1.7 retrieving revision 1.8 diff -Llib/Value/String.pm -Llib/Value/String.pm -u -r1.7 -r1.8 --- lib/Value/String.pm +++ lib/Value/String.pm @@ -21,7 +21,8 @@ my $self = shift; my $class = ref($self) || $self; my $x = join('',@_); my $s = bless {data => [$x]}, $class; - if ($Parser::installed) { + if ($Parser::installed && + !($x eq '' && $$Value::context->flag('allowEmptyStrings'))) { my $strings = $$Value::context->{strings}; if (!$strings->{$x}) { my $X = $strings->{uc($x)}; |
From: Sam H. v. a. <we...@ma...> - 2005-09-23 23:31:07
|
Log Message: ----------- added download_hardcopy_format_pdf permission, set to $guest. This allows professors to turn off hardcopy altogether by setting all the download_hardcopy_format_* permissions to undef. Also change the default permisisonLevel for $guest to -5, to match the permissionLevels for the practiceUsers in defaultClasslist.lst. (It was supposed to be -5 all along.) Modified Files: -------------- webwork2/conf: global.conf.dist Revision Data ------------- Index: global.conf.dist =================================================================== RCS file: /webwork/cvs/system/webwork2/conf/global.conf.dist,v retrieving revision 1.140 retrieving revision 1.141 diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.140 -r1.141 --- conf/global.conf.dist +++ conf/global.conf.dist @@ -481,7 +481,7 @@ # described by the key, the user must have a permission level greater than or # equal to the value. -my $guest = -1; +my $guest = -5; my $student = 0; my $proctor = 2; my $ta = 5; @@ -549,6 +549,7 @@ download_hardcopy_multiuser => $ta, download_hardcopy_multiset => $ta, + download_hardcopy_format_pdf => $guest, download_hardcopy_format_tex => $ta, ); |
From: Sam H. v. a. <we...@ma...> - 2005-09-23 23:27:18
|
Log Message: ----------- Use new hardcopy param names. Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator: ProblemSets.pm Revision Data ------------- Index: ProblemSets.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/ProblemSets.pm,v retrieving revision 1.63 retrieving revision 1.64 diff -Llib/WeBWorK/ContentGenerator/ProblemSets.pm -Llib/WeBWorK/ContentGenerator/ProblemSets.pm -u -r1.63 -r1.64 --- lib/WeBWorK/ContentGenerator/ProblemSets.pm +++ lib/WeBWorK/ContentGenerator/ProblemSets.pm @@ -298,13 +298,13 @@ my $control = ""; if ($multiSet) { $control = CGI::checkbox( - -name=>"hcSet", + -name=>"selected_sets", -value=>$name, -label=>"", ); } else { $control = CGI::radio_group( - -name=>"hcSet", + -name=>"selected_sets", -values=>[$name], -default=>"-", -labels=>{$name => ""}, |
From: Sam H. v. a. <we...@ma...> - 2005-09-23 23:26:30
|
Log Message: ----------- Extensive refactor/rewrite. There are probably going to be bugs here that we squished in the old version of Hardcopy, but it seems to be pretty robust after an evening of testing. Alert me if you see problems. Features: * standard ScrollingRecordLists are used for user and set selection. * TeX source is written incrementally instead of being accumulated in memory. * arguments to shell commands are now quoted using String::ShellQuote * modular design allows adding additional formats easily (i.e. dvi, ps) * error reporting code is simplified. * if errors/warnings occur, user will see them on screen instead of getting the hardcopy file. * on the error screen, user can click to get (possibly broken) hardcopy if it exists. * on the error screen, user can click to get interesting temporary files. (for PDF format these are hardcopy.{tex,log,aux} and pdflatex.std{out,err}.) * on the error screen, if an error concerns a particular problem, an "edit problem" link is included. * probably more stuff i'm forgetting Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator: Hardcopy.pm Revision Data ------------- Index: Hardcopy.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Hardcopy.pm,v retrieving revision 1.61 retrieving revision 1.62 diff -Llib/WeBWorK/ContentGenerator/Hardcopy.pm -Llib/WeBWorK/ContentGenerator/Hardcopy.pm -u -r1.61 -r1.62 --- lib/WeBWorK/ContentGenerator/Hardcopy.pm +++ lib/WeBWorK/ContentGenerator/Hardcopy.pm @@ -17,36 +17,23 @@ package WeBWorK::ContentGenerator::Hardcopy; use base qw(WeBWorK::ContentGenerator); - =head1 NAME -WeBWorK::ContentGenerator::Hardcopy - generate a PDF version of one or more +WeBWorK::ContentGenerator::Hardcopy - generate printable versions of one or more problem sets. =cut -################################################################################ -## -## WARNING: This file has been hacked so that it will download -## TeX files rather than displaying them in the browser. -## In particular, if a TeX file is requested then -## the value of the variable $pdfFileURL (in spite of its name) -## will be the URL for the texFile, i.e., -## $pdfFileURL = $texFileURL if TeX file is requested -## -## wh...@in..., 7/9/04 -## -################################################################################ - use strict; use warnings; -use CGI qw(); -use File::Path qw(rmtree); -use WeBWorK::Form; +use Apache::Constants qw/:common REDIRECT/; +use CGI qw//; +use String::ShellQuote; use WeBWorK::Debug; +use WeBWorK::Form; +use WeBWorK::HTML::ScrollingRecordList qw/scrollingRecordList/; use WeBWorK::PG; -use WeBWorK::Utils qw(readFile makeTempDirectory surePathToFile); -use Apache::Constants qw(:common REDIRECT); +use WeBWorK::Utils qw/readFile makeTempDirectory surePathToFile/; =head1 CONFIGURATION VARIABLES @@ -64,848 +51,734 @@ =cut +our $HC_DEFAULT_FORMAT = "pdf"; # problems if this is not an allowed format for the user... +our %HC_FORMATS = ( + tex => { name => "TeX Source", subr => "generate_hardcopy_tex" }, + pdf => { name => "Adobe PDF", subr => "generate_hardcopy_pdf" }, +); + +# custom fields used in $self hash +# +# final_file_url +# contains the URL of the final hardcopy file generated +# set by generate_hardcopy(), used by pre_header_initialize() and body() +# temp_file_map +# reference to a hash mapping temporary file names to URL +# set by pre_header_initialize(), used by body() +# hardcopy_errors +# reference to array containing HTML strings describing generation errors (and warnings) +# used by add_errors(), get_errors(), get_errors_ref() + +################################################################################ +# UI subroutines +################################################################################ + sub pre_header_initialize { my ($self) = @_; my $r = $self->r; my $ce = $r->ce; my $db = $r->db; my $authz = $r->authz; - my $userID = $r->param("user"); - debug("begin hardcopy processing"); - - my $singleSet = $r->urlpath->arg("setID"); - my @sets = $r->param("hcSet"); - my @users = $r->param("hcUser"); - my $hardcopy_format = $r->param('hardcopy_format') ? $r->param('hardcopy_format') : ''; - - # add singleSet to the list of sets - if (defined $singleSet and $singleSet ne "") { - $singleSet =~ s/^set//; - unshift @sets, $singleSet unless grep { $_ eq $singleSet } @sets; - } - #die "single set is $singleSet and sets is ", join("|",@sets); - # default user is the effectiveUser - unless (@users) { - unshift @users, $r->param("effectiveUser"); + my $userID = $r->param("user"); + my $eUserID = $r->param("effectiveUser"); + my @setIDs = $r->param("selected_sets"); + my @userIDs = $r->param("selected_users"); + my $hardcopy_format = $r->param("hardcopy_format"); + my $generate_hardcopy = $r->param("generate_hardcopy"); + my $send_existing_hardcopy = $r->param("send_existing_hardcopy"); + my $final_file_url = $r->param("final_file_url"); + + # if there's an existing hardcopy file that can be sent, get set up to do that + if ($send_existing_hardcopy) { + $self->reply_with_redirect($final_file_url); + $self->{final_file_url} = $final_file_url; + $self->{send_hardcopy} = 1; + return; } # this should never happen, but apparently it did once (see bug #714), so we check for it - die "Parameter 'user' not defined. Can't continue." unless defined $userID; + die "Parameter 'user' not defined -- this should never happen" unless defined $userID; - $self->{user} = $db->getUser($userID); # checked - die "user ", $userID, " (real user) not found." - unless $self->{user}; - - $self->{effectiveUser} = $db->getUser($r->param("effectiveUser")); # checked - die "user ", $r->param("effectiveUser"), " (effective user) not found." - unless $self->{effectiveUser}; - - #my $PermissionLevel = $db->getPermissionLevel($r->param("user")); # checked - #if ($PermissionLevel) { - # $self->{permissionLevel} = $PermissionLevel->permission(); - #} else { - # die "permission level for user ", $r->param("user"), " (real user) not found."; - #} - - $self->{sets} = \@sets; - $self->{users} = \@users; - $self->{hardcopy_format} = $hardcopy_format; - $self->{errors} = []; - $self->{warnings} = []; - - # is the user allowed to request multiple sets/users at a time? - my $multiSet = $authz->hasPermissions($userID, "download_hardcopy_multiset"); - my $multiUser = $authz->hasPermissions($userID, "download_hardcopy_multiuser"); - - if (@sets > 1 and not $multiSet) { - $self->{generationError} = ["SIMPLE", "You are not permitted to generate hardcopy for multiple sets. Please select a single set and try again."]; - } - if (@users > 1 and not $multiUser) { - $self->{generationError} = ["SIMPLE", "You are not permitted to generate hardcopy for multiple users. Please select a single user and try again."]; - } - if ($users[0] ne $self->{effectiveUser}->user_id and not $multiUser) { - $self->{generationError} = ["SIMPLE", "You are not permitted to generate hardcopy for other users."]; - } - - unless ($self->{generationError}) { - if ($r->param("generateHardcopy")) { - #my ($tempDir, $fileName) = eval { $self->generateHardcopy() }; - my ($pdfFileURL) = eval { $self->generateHardcopy() }; - - $self->{generationError} = $@ if $@; - #warn "pdfFileURL is $pdfFileURL"; - #warn "generation error is ".$self->{generationError}; - #warn "hardcopy_format is ".$self->{hardcopy_format}; - if ($self->{generationError}) { - # In this case no correct pdf file was generated. - # throw the error up higher. - # The error is reported in body. - # the tempDir was removed in generateHardcopy -# } elsif ( $self->{hardcopy_format} eq 'tex') { -# # Only tex output was asked for, proceed to have the tex output -# # handled by the subroutine "body". + if ($generate_hardcopy) { + my $validation_failed = 0; + + # make sure format is valid + unless (grep { $_ eq $hardcopy_format } keys %HC_FORMATS) { + $self->addbadmessage("'$hardcopy_format' is not a valid hardcopy format."); + $validation_failed = 1; + } + + # make sure we are allowed to generate hardcopy in this format + unless ($authz->hasPermissions($userID, "download_hardcopy_format_$hardcopy_format")) { + $self->addbadmessage("You do not have permission to generate hardcopy in $hardcopy_format format."); + $validation_failed = 1; + } + + # is there at least one user and set selected? + unless (@userIDs) { + $self->addbadmessage("Please select at least one user and try again."); + $validation_failed = 1; + } + unless (@setIDs) { + $self->addbadmessage("Please select at least one set and try again."); + $validation_failed = 1; + } + + # is the user allowed to request multiple sets/users at a time? + my $perm_multiset = $authz->hasPermissions($userID, "download_hardcopy_multiset"); + my $perm_multiuser = $authz->hasPermissions($userID, "download_hardcopy_multiuser"); + + if (@setIDs > 1 and not $perm_multiset) { + $self->addbadmessage("You are not permitted to generate hardcopy for multiple sets. Please select a single set and try again."); + $validation_failed = 1; + } + if (@userIDs > 1 and not $perm_multiuser) { + $self->addbadmessage("You are not permitted to generate hardcopy for multiple users. Please select a single user and try again."); + $validation_failed = 1; + } + if (@userIDs and $userIDs[0] ne $eUserID and not $perm_multiuser) { + $self->addbadmessage("You are not permitted to generate hardcopy for other users."); + $validation_failed = 1; + } + + unless ($validation_failed) { + my ($final_file_url, %temp_file_map) = $self->generate_hardcopy($hardcopy_format, \@userIDs, \@setIDs); + if ($self->get_errors) { + # store the URLs in self hash so that body() can make a link to it + $self->{final_file_url} = $final_file_url; + $self->{temp_file_map} = \%temp_file_map; } else { - # information for redirect - $self->{pdfFileURL} = $pdfFileURL; + # send the file only + $self->reply_with_redirect($final_file_url); } } } } -sub header { - my ($self) = @_; - my $r = $self->r; - - if (exists $self->{pdfFileURL}) { - $r->header_out(Location => $self->{pdfFileURL} ); - $self->{noContent} = 1; - return REDIRECT; - } - $r->content_type("text/html"); - $r->send_http_header(); -} - -# ----- - -#sub path { -# my ($self, $args) = @_; -# -# my $ce = $self->{ce}; -# my $root = $ce->{webworkURLs}->{root}; -# my $courseName = $ce->{courseName}; -# return $self->pathMacro($args, -# "Home" => "$root", -# $courseName => "$root/$courseName", -# "Hardcopy Generator" => "", -# ); -#} -# -#sub title { -# return "Hardcopy Generator"; -#} - sub body { my ($self) = @_; - debug("Hardcopy: printing generation errors"); - - if ($self->{generationError}) { - if (ref $self->{generationError} eq "ARRAY") { - my ($disposition, @rest) = @{$self->{generationError}}; - if ($disposition eq "PGFAIL") { - $self->multiErrorOutput(@{$self->{errors}}); - debug("Hardcopy: end printing generation errors"); - return ""; - } elsif ($disposition eq "FAIL") { - print $self->errorOutput(@rest); - debug("Hardcopy: end printing generation errors"); - return ""; - } elsif ($disposition eq "RETRY") { - print $self->errorOutput(@rest); - } else { # a "simple" error - print CGI::p(CGI::font({-color=>"red"}, @rest)); + if (my $num = $self->get_errors) { + my $final_file_url = $self->{final_file_url}; + my %temp_file_map = %{$self->{temp_file_map}}; + + my $errors_str = $num > 1 ? "errors" : "error"; + print CGI::p("$num $errors_str occured while generating hardcopy:"); + + print CGI::ul(CGI::li($self->get_errors_ref)); + + if ($final_file_url) { + print CGI::p( + "A hardcopy file was generated, but it may not be complete or correct: ", + CGI::a({href=>$final_file_url}, "Download Hardcopy") + ); + } + + if (%temp_file_map) { + print CGI::start_p(); + print "You can also examine the following temporary files: "; + my $first = 1; + while (my ($temp_file_name, $temp_file_url) = each %temp_file_map) { + if ($first) { + $first = 0; + } else { + print ", "; + } + print CGI::a({href=>$temp_file_url}, " $temp_file_name"); } - } else { - # not something we were expecting... - debug("Hardcopy: end printing generation errors"); - die $self->{generationError}; + print CGI::end_p(); } + + print CGI::hr(); } - debug("Hardcopy: end printing generation errors"); - - if (@{$self->{warnings}}) { - # FIXME: this code will only be reached if there was also a - # generation error, because otherwise the module will send - # the PDF instead. DAMN! - $self->multiWarningOutput(@{$self->{warnings}}); - } -# if ($self->{hardcopy_format} eq 'tex') { -# my $r_tex_content = $self->{r_tex_content}; -# return $$r_tex_content; -# } - $self->displayForm(); + + $self->display_form(); } -sub multiErrorOutput($@) { - my ($self, @errors) = @_; +sub display_form { + my ($self) = @_; + my $r = $self->r; + my $db = $r->db; + my $authz = $r->authz; + my $userID = $r->param("user"); + my $eUserID = $r->param("effectiveUser"); - print CGI::h2("Compile Errors"); - print CGI::p(<<EOF); -WeBWorK has encountered one or more errors while attempting to process -these homework sets. It is likely that there are errors in the problems -themselves. If you are a student, contact your professor to have the errors -corrected. If you are a professor, please consult the error output below for -more information. -EOF - foreach my $error (@errors) { - my $user = $error->{user}; - my $userName = $user->user_id . ' ('.$user->first_name.' '.$user->last_name. ')'; - print CGI::h3("Set: ", $error->{set}, ", Problem: ", $error->{problem}, "for $userName"); - print CGI::h4("Error messages"), CGI::blockquote(CGI::pre($error->{message})); - print CGI::h4("Error context"), CGI::blockquote(CGI::pre($error->{context})); + # first time we show up here, fill in some values + unless ($r->param("in_hc_form")) { + # if a set was passed in via the path_info, add that to the list of sets. + my $singleSet = $r->urlpath->arg("setID"); + if (defined $singleSet and $singleSet ne "") { + my @selected_sets = $r->param("selected_sets"); + $r->param("selected_sets" => [ @selected_sets, $singleSet]) unless grep { $_ eq $singleSet } @selected_sets; + } + + # if no users are selected, select the effective user + my @selected_users = $r->param("selected_users"); + unless (@selected_users) { + $r->param("selected_users" => $eUserID); + } } -} - -sub multiWarningOutput($@) { - my ($self, @warnings) = @_; - - print CGI::h2("Software Warnings"); - print CGI::p(<<EOF); -WeBWorK has encountered one or more warnings while attempting to process these -homework sets. It is likely that this indicates errors or ambiguitiees in the -problems themselves. If you are a student, contact your professor to have the -problems corrected. If you are a professor, please consut the warning output -below for more informaiton. -EOF - foreach my $warning (@warnings) { - print CGI::h3("Set: ", $warning->{set}, ", Problem: ", $warning->{problem}); - print CGI::h4("Error messages"), CGI::blockquote(CGI::pre($warning->{message})); + + my $perm_multiset = $authz->hasPermissions($userID, "download_hardcopy_multiset"); + my $perm_multiuser = $authz->hasPermissions($userID, "download_hardcopy_multiuser"); + my $perm_texformat = $authz->hasPermissions($userID, "download_hardcopy_format_tex"); + my $perm_unopened = $authz->hasPermissions($userID, "view_unopened_sets"); + my $perm_unpublished = $authz->hasPermissions($userID, "view_unpublished_sets"); + + # get formats + my @formats; + foreach my $format (keys %HC_FORMATS) { + push @formats, $format if $authz->hasPermissions($userID, "download_hardcopy_format_$format"); + } + + # get format names hash for radio buttons + my %format_labels = map { $_ => $HC_FORMATS{$_}{name} || $_ } @formats; + + # get users for selection + my @Users; + if ($perm_multiuser) { + # if we're allowed to select multiple users, get all the users + @Users = $db->getUsers($db->listUsers); + } else { + # otherwise, we get our own record only + @Users = $db->getUser($eUserID); } -} - -# ----- - -sub displayForm($) { - my ($self) = @_; - my $r = $self->r; - my $db = $r->db; - my $authz = $r->authz; - my $userID = $r->param("user"); - my $ss= ''; - my $aa= ' a '; - if ($authz->hasPermissions($userID, "download_hardcopy_multiuser")) { - $ss= 's'; - $aa= ' '; - } - print CGI::start_p(), "Select the homework set$ss for which to generate${aa}hardcopy version$ss."; + # get sets for selection + my @Sets; + if ($perm_multiuser) { + # if we're allowed to select sets for multiple users, get all sets + @Sets = $db->getGlobalSets($db->listGlobalSets); + } else { + # otherwise, only get the sets assigned to the effective user + @Sets = $db->getMergedSets(map [$eUserID,$_], $db->listUserSets($eUserID)); + } + + # filter out unwanted sets + foreach my $i (0 .. $#Sets) { + my $Set = $Sets[$i]; + splice @Sets, $i, 1 unless $Set->open_date <= time or $perm_unopened; + splice @Sets, $i, 1 unless $Set->published or $perm_unpublished; + } + + my $scrolling_user_list = scrollingRecordList({ + name => "selected_users", + request => $r, + default_sort => "lnfn", + default_format => "lnfn_uid", + default_filters => ["all"], + size => 20, + multiple => $perm_multiuser, + }, @Users); + + my $scrolling_set_list = scrollingRecordList({ + name => "selected_sets", + request => $r, + default_sort => "set_id", + default_format => "set_id", + default_filters => ["all"], + size => 20, + multiple => $perm_multiset, + }, @Sets); + + # we change the text a little bit depending on whether the user has multiuser privileges + my $ss = $perm_multiuser ? "s" : ""; + my $aa = $perm_multiuser ? " " : " a "; + my $phrase_for_privileged_users = $perm_multiuser ? "to privileged users or" : ""; + + print CGI::start_p(); + print "Select the homework set$ss for which to generate${aa}hardcopy version$ss."; if ($authz->hasPermissions($userID, "download_hardcopy_multiuser")) { print "You may also select multiple users from the users list. You will receive hardcopy for each (set, user) pair."; } print CGI::end_p(); - my $download_texQ = $authz->hasPermissions($userID, "download_hardcopy_format_tex"); - - # ##########construct action URL ################# - my $ce = $r->ce; - my $root = $ce->{webworkURLs}->{root}; - my $courseName = $ce->{courseName}; - my $actionURL = "$root/$courseName/hardcopy/"; - # ################################################ - - my $phrase_for_privileged_users = ''; - $phrase_for_privileged_users ='to privileged users or' if $authz->hasPermissions($userID, "download_hardcopy_multiuser"); - - print CGI::start_form(-method=>"POST", -action=>$actionURL); + print CGI::start_form(-method=>"POST", -action=>$r->uri); print $self->hidden_authen_fields(); - print CGI::h3("Options"); - print CGI::p("You may choose to show any of the following data. Correct answers and solutions are only available $phrase_for_privileged_users after the answer date of the homework set."); - print CGI::p( - CGI::checkbox( - -name => "showCorrectAnswers", - -checked => $r->param("showCorrectAnswers") || 0, - -label => "Correct answers", - ), CGI::br(), - CGI::checkbox( - -name => "showHints", - -checked => $r->param("showHints") || 0, - -label => "Hints", - ), CGI::br(), - CGI::checkbox( - -name => "showSolutions", - -checked => $r->param("showSolutions") || 0, - -label => "Solutions", - ), - ); - print CGI::start_table({-width=>"100%"}), CGI::start_Tr({-valign=>"top"}); - - my $multiSet = $authz->hasPermissions($userID, "download_hardcopy_multiset"); - my $multiUser = $authz->hasPermissions($userID, "download_hardcopy_multiuser"); - my $preOpenSets = $authz->hasPermissions($userID, "view_unopened_sets"); - my $unpublishedSets = $authz->hasPermissions($userID, "view_unpublished_sets"); - my $effectiveUserName = $self->{effectiveUser}->user_id; - my @setNames = $db->listUserSets($effectiveUserName); - my @sets = $db->getMergedSets( map { [$effectiveUserName, $_] } @setNames ); # checked - @sets = grep { defined $_ and ($preOpenSets or $_->open_date < time) and ($unpublishedSets or $_->published) } @sets; - @sets = sort { $a->set_id cmp $b->set_id } @sets; - @setNames = map( {$_->set_id } @sets ); # get sorted version of setNames - my %setLabels = map( {($_->set_id, "set ".$_->set_id )} @sets ); - my (@users, @userNames,%userLabels); - - if ($multiUser) { - @userNames = $db->listUsers(); - @users = $db->getUsers(@userNames); # checked - @users = grep { defined $_ } @users; - @users = sort { $a->last_name cmp $b->last_name } @users; - @userNames = map( {$_->user_id} @users ); # get sorted version of user names - %userLabels = map( {($_->user_id , $_->last_name .", ". $_->first_name ." --- ". $_->user_id ) } @users ); - } - # set selection menu - { - print CGI::start_td(); - my $number_of_sets = @{$self->{sets}}; - print CGI::h3("Sets: $number_of_sets pre-selected"); - print CGI::scrolling_list(-name=>'hcSet', - -values=>\@setNames, - -labels=>\%setLabels, - -size => 10, - -multiple => $multiSet, - -defaults => $self->{sets}, - ); - print CGI::end_td(); - } - - # user selection menu - if ($multiUser) { - print CGI::start_td(); - my $number_of_users = @{$self->{users}}; - print CGI::h3("Users: $number_of_users pre-selected"); - - print CGI::scrolling_list(-name=>'hcUser', - -values=>\@userNames, - -labels=>\%userLabels, - -size => 10, - -multiple => 'true', - -defaults => $self->{users}, - ); - print CGI::end_td(); - } + print CGI::hidden("in_hc_form", 1); - print CGI::end_Tr(), CGI::end_table(); - if ($download_texQ) { # provide choice of pdf or tex output - print CGI::p( {-align => "center"}, + print CGI::table({class=>"FormLayout"}, + CGI::Tr( + CGI::th("Users"), + CGI::th("Sets"), + ), + CGI::Tr( + CGI::td($scrolling_user_list), + CGI::td($scrolling_set_list), + ), + CGI::Tr( + CGI::td({colspan=>2, class=>"ButtonRow"}, + CGI::small("You may choose to show any of the following data. Correct answers and solutions are only available $phrase_for_privileged_users after the answer date of the homework set."), + CGI::br(), + CGI::b("Show:"), " ", + CGI::checkbox( + -name => "showCorrectAnswers", + -checked => scalar($r->param("showCorrectAnswers")) || 0, + -label => "Correct answers", + ), + CGI::checkbox( + -name => "showHints", + -checked => scalar($r->param("showHints")) || 0, + -label => "Hints", + ), + CGI::checkbox( + -name => "showSolutions", + -checked => scalar($r->param("showSolutions")) || 0, + -label => "Solutions", + ), + ), + ), + CGI::Tr( + CGI::td({colspan=>2, class=>"ButtonRow"}, + CGI::b("Hardcopy Format:"), " ", CGI::radio_group( - -name=>"hardcopy_format", - -values=>['pdf', 'tex'], - -default=>'pdf', - -labels=>{'tex'=>'TeX','pdf'=>'PDF'} + -name => "hardcopy_format", + -values => \@formats, + -default => scalar($r->param("hardcopy_format")) || $HC_DEFAULT_FORMAT, + -labels => \%format_labels, ), - ); - } else { # only pdf output available - print CGI::hidden(-name=>'hardcopy_format',-value=>'pdf'); - } - print CGI::p({-align=>"center"}, - CGI::submit(-name=>"generateHardcopy", -label=>"Generate Hardcopy")); + ), + ), + CGI::Tr( + CGI::td({colspan=>2, class=>"ButtonRow"}, + CGI::submit( + -name => "generate_hardcopy", + -value => "Generate hardcopy for selected sets and selected users", + #-style => "width: 45ex", + ), + ), + ), + ); + print CGI::end_form(); return ""; } -sub generateHardcopy($) { - my ($self) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $authz = $r->authz; - my $userID = $r->param("user"); - my @sets = @{$self->{sets}}; - my @users = @{$self->{users}}; - my $multiSet = $authz->hasPermissions($userID, "download_hardcopy_multiset"); - my $multiUser = $authz->hasPermissions($userID, "download_hardcopy_multiuser"); - # sanity checks - unless (@sets) { - die ["RETRY", "No sets were specified."]; - } - unless (@users) { - die ["RETRY", "No users were specified."]; - } - - # determine where hardcopy is going to go - my $tempDir = makeTempDirectory($ce->{webworkDirs}->{tmp}, "webwork-hardcopy"); - - # determine name of PDF file #FIXME it might be best to have the effective user in here somewhere - my $courseName = $ce->{courseName}; - my $fileNameSet = (@sets > 1 ? "multiset" : $sets[0]); - my $fileNameUser = (@users > 1 ? "multiuser" : $users[0]); - my $fileName = "$courseName.$fileNameUser.$fileNameSet.pdf"; - - # for each user ... generate TeX for each set - my $tex; - # - # the document tex preamble - $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{preamble}); - # separate users by page break, or something - foreach my $user (@users) { - $tex .= $self->getMultiSetTeX($user, @sets); - if (@users) { - # separate users, but not after the last set - $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{userDivider}); - } - +################################################################################ +# harddcopy generating subroutines +################################################################################ + +sub generate_hardcopy { + my ($self, $format, $userIDsRef, $setIDsRef) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; + + my $courseID = $r->urlpath->arg("courseID"); + my $userID = $r->param("user"); + my $eUserID = $r->param("effectiveUser"); + + # we want to make the temp directory web-accessible, for error reporting + #my $temp_dir_path = eval { makeTempDirectory($ce->{webworkDirs}{tmp}, "webwork-hardcopy") }; + my $temp_dir_parent_path = $ce->{courseDirs}{html_temp} . "/hardcopy"; # makeTempDirectory will ensure that .../hardcopy exists + my $temp_dir_path = eval { makeTempDirectory($temp_dir_parent_path, "work") }; + if ($@) { + $self->add_errors($@); + return; } - # the document postamble - $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{postamble}); - # deal with PG errors - if (@{$self->{errors}}) { - die ["PGFAIL"]; + my $tex_file_name = "hardcopy.tex"; + my $tex_file_path = "$temp_dir_path/$tex_file_name"; + + # do some error checking + unless (-w $temp_dir_path) { + $self->add_errors("Temporary directory '$temp_dir_path' is not writeable: $!"); + return; + } + + # write TeX + my $open_result = open my $FH, ">", $tex_file_path; + unless ($open_result) { + $self->add_errors("Failed to open file '$tex_file_path' for writing: $!"); + return; + } + $self->write_multiuser_tex($FH, $userIDsRef, $setIDsRef); + close $FH; + + # determine base name of final file + my $final_file_user = @$userIDsRef > 1 ? "multiuser" : $userIDsRef->[0]; + my $final_file_set = @$setIDsRef > 1 ? "multiset" : $setIDsRef->[0]; + my $final_file_basename = "$courseID.$final_file_user.$final_file_set"; + + # call format subroutine + # $final_file_name is the name of final hardcopy file + # @temp_files is a list of temporary files of interest used by the subroutine + # (all are relative to $temp_dir_path) + my $format_subr = $HC_FORMATS{$format}{subr}; + my ($final_file_name, @temp_files) = $self->$format_subr($temp_dir_path, $final_file_basename); + my $final_file_path = "$temp_dir_path/$final_file_name"; + + #warn "final_file_name=$final_file_name\n"; + #warn "temp_files=@temp_files\n"; + + # calculate URLs for each temp file of interest + # makeTempDirectory's interface forces us to reverse-engineer the name of the temp dir from the path + my $temp_dir_parent_url = $ce->{courseURLs}{html_temp} . "/hardcopy"; + (my $temp_dir_url = $temp_dir_path) =~ s/^$temp_dir_parent_path/$temp_dir_parent_url/; + my %temp_file_map; + foreach my $temp_file_name (@temp_files) { + $temp_file_map{$temp_file_name} = "$temp_dir_url/$temp_file_name"; + } + + my $final_file_url; + + # make sure final file exists + unless (-e $final_file_path) { + $self->add_errors("Final hardcopy file '$final_file_path' not found after calling '$format_subr': $!"); + return $final_file_url, %temp_file_map; + } + + # try to move the hardcopy file out of the temp directory + # set $final_file_url accordingly + my $final_file_final_path = "$temp_dir_parent_path/$final_file_name"; + my $mv_cmd = "/bin/mv " . shell_quote($final_file_path, $final_file_final_path); + if (system $mv_cmd) { + $self->add_errors("Failed to move hardcopy file '$final_file_name' from '$temp_dir_path' to '$temp_dir_parent_path': $!"); + $final_file_url = "$temp_dir_url/$final_file_name"; + } else { + $final_file_url = "$temp_dir_parent_url/$final_file_name"; } - # FIXME: add something like: - #if (@{$self->{warnings}}) { - # $self->{generationWarnings} = 1; - #} - # ??????? - - # "try" to generate pdf or return TeX file - my $pdfFileURL = undef; - if ($self->{hardcopy_format} eq 'pdf' ) { - my $errors = ''; - debug("Hardcopy: format log file"); - $pdfFileURL = eval { $self->latex2pdf($tex, $tempDir, $fileName) }; - debug("end latex2pdf"); - if ($@) { - $errors = $@; - #$errors =~ s/\n/<br>/g; # make this readable on HTML FIXME make this a Utils. filter (Error2HTML) - # clean up temp directory - # FIXME this clean up done in latex2pdf? rmtree($tempDir); - die ["FAIL", "Failed to generate PDF from tex", $errors]; #throw error to subroutine body - } else { - # pass the relative temp file path back up to go subroutine - # to have an appropriate redirect generated. - - + # remove the temp directory if there are no errors + unless ($self->get_errors or $PreserveTempFiles) { + my $rm_cmd = "/bin/rm -rf " . shell_quote($temp_dir_path); + if (system $rm_cmd) { + $self->add_errors("Failed to remove temp directory '$temp_dir_path': $!"); } - } elsif ($self->{hardcopy_format} eq 'tex') { - - my $TeXdownloadFileName = "$courseName.$fileNameUser.$fileNameSet.tex"; + } - # Location for hardcopy file to be downloaded - # FIXME this should use surePathToTmpFile - # The html_temp directory might not have been created. - # But since the temp directory might be located anywhere we don't know what to use - # for the start file. - mkdir ($ce->{courseDirs}->{html_temp}) or die "Unable to make directory: ".$ce->{courseDirs}->{html_temp} - unless -e $ce->{courseDirs}->{html_temp}; - my $hardcopyTempDirectory = $ce->{courseDirs}->{html_temp}."/hardcopy"; - my $hardcopyFilePath = surePathToFile($ce->{courseDirs}->{html_temp}, "$hardcopyTempDirectory/$TeXdownloadFileName"); - - my $hardcopyFileURL = $ce->{courseURLs}->{html_temp}."/hardcopy/$TeXdownloadFileName"; - $self->{hardcopyFilePath} = $hardcopyFilePath; - $self->{hardcopyFileURL} = $hardcopyFileURL; - # write the tex file - local *TEX; - open TEX, ">", $hardcopyFilePath or die "Failed to open $hardcopyFilePath: $!\n".CGI::br(); - print TEX $tex; - close TEX; - - $pdfFileURL = $hardcopyFileURL; - - if ($PreserveTempFiles) { - warn "Temporary directory preserved at '$tempDir'.\n"; - } else { - rmtree($tempDir); - } - -# $tex = protect_HTML($tex); -# #$tex =~ s/\n/\<br\>\n/g; -# $tex = join('', ("<pre>\n",$tex,"\n</pre>\n")); -# $self->{r_tex_content} = \$tex; + warn "Preserved temporary files in directory '$temp_dir_path'.\n" if $PreserveTempFiles; + return $final_file_url, %temp_file_map; +} + +# format subroutines +# +# assume that TeX source is located at $temp_dir_path/hardcopy.tex +# the generated file will being with $final_file_basename +# first element of return value is the name of the generated file (relative to $temp_dir_path) +# rest of return value elements are names of temporary files that may be of interest in the +# case of an error, relative to $temp_dir_path. these are returned whether or not an error +# actually occured. + +sub generate_hardcopy_tex { + my ($self, $temp_dir_path, $final_file_basename) = @_; + + my $final_file_name; + + # try to rename tex file + my $src_name = "hardcopy.tex"; + my $dest_name = "$final_file_basename.tex"; + my $mv_cmd = "/bin/mv " . shell_quote("$temp_dir_path/$src_name", "$temp_dir_path/$dest_name"); + if (system $mv_cmd) { + $self->add_errors("Failed to rename '$src_name' to '$dest_name' in directory '$temp_dir_path': $!"); + $final_file_name = $src_name; } else { + $final_file_name = $dest_name; + } + return $final_file_name; +} + +sub generate_hardcopy_pdf { + my ($self, $temp_dir_path, $final_file_basename) = @_; - die["FAIL", "Hard copy format |".$self->{hardcopy_format}. "| not recognized."]; - + # call pdflatex - we don't want to chdir in the mod_perl process, as + # that might step on the feet of other things (esp. in Apache 2.0) + my $pdflatex_cmd = "cd " . shell_quote($temp_dir_path) . " && " + . $self->r->ce->{externalPrograms}{pdflatex} + . " >pdflatex.stdout 2>pdflatex.stderr hardcopy"; + if (system $pdflatex_cmd) { + $self->add_errors("Failed to convert TeX to PDF with command '$pdflatex_cmd'."); + } + + my $final_file_name; + + # try rename the pdf file + my $src_name = "hardcopy.pdf"; + my $dest_name = "$final_file_basename.pdf"; + my $mv_cmd = "/bin/mv " . shell_quote("$temp_dir_path/$src_name", "$temp_dir_path/$dest_name"); + if (system $mv_cmd) { + $self->add_errors("Failed to rename '$src_name' to '$dest_name' in directory '$temp_dir_path': $!"); + $final_file_name = $src_name; + } else { + $final_file_name = $dest_name; } - #return $tempDir, $fileName; - # return $pdfFilePath; - return $pdfFileURL; + + return $final_file_name, qw/hardcopy.tex hardcopy.log hardcopy.aux pdflatex.stdout pdflatex.stderr/; } -# ----- +################################################################################ +# TeX aggregating subroutines +################################################################################ -sub latex2pdf { - # this is a little ad-hoc function which I will replace with a LaTeX - # module at some point (or put it in Utils). - my ($self, $tex, $tempDir, $fileName) = @_; +sub write_multiuser_tex { + my ($self, $FH, $userIDsRef, $setIDsRef) = @_; my $r = $self->r; my $ce = $r->ce; - #FIXME is $tempDir used? - #my $finalFile = "$tempDir/$fileName"; + my @userIDs = @$userIDsRef; + my @setIDs = @$setIDsRef; - # Location for hardcopy file to be downloaded - # FIXME this should use surePathToTmpFile - # The html_temp directory might not have been created. - # But since the temp directory might be located anywhere we don't know what to use - # for the start file. - mkdir ($ce->{courseDirs}->{html_temp}) or die "Unable to make directory: ".$ce->{courseDirs}->{html_temp} - unless -e $ce->{courseDirs}->{html_temp}; - my $hardcopyTempDirectory = $ce->{courseDirs}->{html_temp}."/hardcopy"; - my $hardcopyFilePath = surePathToFile($ce->{courseDirs}->{html_temp}, "$hardcopyTempDirectory/$fileName"); - - - my $hardcopyFileURL = $ce->{courseURLs}->{html_temp}."/hardcopy/$fileName"; - $self->{hardcopyFilePath} = $hardcopyFilePath; - $self->{hardcopyFileURL} = $hardcopyFileURL; - - ## create a temporary directory for tex to shit in - # - we're using the existing temp dir. now - - my $wd = $tempDir; - my $texFile = "$wd/hardcopy.tex"; - my $pdfFile = "$wd/hardcopy.pdf"; - my $logFile = "$wd/hardcopy.log"; - - # write the tex file - local *TEX; - open TEX, ">", $texFile or die "Failed to open $texFile: $!\n".CGI::br(); - print TEX $tex; - close TEX; + # get snippets + my $preamble = $ce->{webworkFiles}->{hardcopySnippets}->{preamble}; + my $postamble = $ce->{webworkFiles}->{hardcopySnippets}->{postamble}; + my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{userDivider}; - # call pdflatex - we don't want to chdir in the mod_perl process, as - # that might step on the feet of other things (esp. in Apache 2.0) - my $pdflatex = $ce->{externalPrograms}->{pdflatex}; - my $pdflatexResult = system "cd $wd && $pdflatex $texFile"; + # write preamble + $self->write_tex_file($FH, $preamble); - # Even with errors there may be a valid pdfFile. Move it to where we can get it. - if (-e $pdfFile) { - - # moving to course tmp/hardcopy directory - system "/bin/mv", $pdfFile, $hardcopyFilePath - and die "Failed to mv: $pdfFile to $hardcopyFilePath<br> Quite likely this means that there ". - "is not sufficient write permission for some directory.<br>$!\n".CGI::br(); - } - # Alert the world that the tex file did not process perfectly. - if ($pdflatexResult) { - # something bad happened - my @textErrorMessage = (); - push @textErrorMessage , "Call to $pdflatex failed: $!\n",CGI::br(); - if (-e $wd) { - push @textErrorMessage , "Working directory preserved at '$wd'.\n", - CGI::p("Investigating the contents of the working directory can be useful for debugging ", - "errors which arise while processing the tex file, but it requires direct access to the server.\n" - ); - } else { - push @textErrorMessage, "Working directory $wd was not created.\n",CGI::br() ; - } - if (-e $hardcopyFilePath ) { - # FIXME Misuse of html tags!!! - push @textErrorMessage, CGI::h4("<h4>Some pdf output was produced and is available ", - CGI::a({-href=>$hardcopyFileURL},"here. ")),CGI::p("Looking at these - fragments of typeset output can help with debugging."), CGI::hr(); - } - # report logfile - if (-e $logFile) { - push @textErrorMessage , "pdflatex ran, but did not succeed. This suggests an error in the TeX\n", CGI::br(); - push @textErrorMessage , "version of one of the problems, or a problem with the pdflatex system.\n",CGI::br(); - debug("Hardcopy: read log file"); - my $logFileContents = eval { readTexErrorLog($logFile) }; - $logFileContents .= CGI::hr().CGI::hr(); - debug("Hardcopy: format log file"); - $logFileContents .= eval { formatTexFile($texFile) }; - debug("Hardcopy: end processing log file"); - if ($@) { - push @textErrorMessage, "Additionally, the pdflatex log file could not be read, though it exists.\n", CGI::br(); - } else { - push @textErrorMessage, "The essential contents of the TeX log are as follows:\n",CGI::hr(),CGI::br(); - push @textErrorMessage, $logFileContents, CGI::br(), CGI::br(); - } - } else { - push @textErrorMessage, "No log file was created, suggesting that pdflatex never ran. Check the WeBWorK\n",CGI::br(); - push @textErrorMessage, "configuration to ensure that the path to pdflatex is correct.\n", CGI::br(); - } - die \@textErrorMessage; + # write section for each user + while (defined (my $userID = shift @userIDs)) { + $self->write_multiset_tex($FH, $userID, @setIDs); + $self->write_tex_file($FH, $divider) if @userIDs; # divide users, but not after the last user } + # write postamble + $self->write_tex_file($FH, $postamble); +} +sub write_multiset_tex { + my ($self, $FH, $targetUserID, @setIDs) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; - ## remove temporary directory - if ($PreserveTempFiles) { - warn "Working directory preserved at '$wd'.\n"; - } else { - rmtree($wd, 0, 0); + # get user record + my $TargetUser = $db->getUser($targetUserID); # checked + unless ($TargetUser) { + $self->add_errors("Can't generate hardcopy for user $targetUserID -- no such user exists.\n"); + return; } - - -e $hardcopyFilePath or die "Failed to create $hardcopyFilePath for no apparent reason.\n"; - # return hardcopyFilePath; - return $hardcopyFileURL; -} - -# ----- -# FIXME move to Utils? probably not - -sub readTexErrorLog { - my $filePath = shift; - my $print_error_switch = 0; - my $line=''; - my @message=(); - #local($/ ) = "\n"; - open(LOGFILE,"<$filePath") or die "Can't read $filePath"; - while (<LOGFILE>) { - $line = $_; - $print_error_switch = 1 if $line =~ /^!/; # after a fatal error start printing messages - push(@message, protect_HTML($line)) if $print_error_switch; - } - close(LOGFILE); - join("<br>\n",@message); -} - -sub formatTexFile { - my $texFilePath = shift; - open (TEXFILE, "$texFilePath") - or die "Can't open tex source file: path= $texFilePath: $!"; + # get set divider + my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{setDivider}; - my @message = (); - push @message, '<BR>\n<h3>TeX Source File:</h3><BR>\n', ; - - my $lineNumber = 1; - while (<TEXFILE>) { - push @message, protect_HTML("$lineNumber $_")."\n"; - $lineNumber++; - } - close(TEXFILE); - #push @message, '</pre>'; - join("<br>\n",@message); -} -sub protect_HTML { - my $line = shift; - chomp($line); - $line =~s/\&/&/g; - $line =~s/</</g; - $line =~s/>/>/g; - $line; + # write each set + while (defined (my $setID = shift @setIDs)) { + $self->write_set_tex($FH, $TargetUser, $setID); + $self->write_tex_file($FH, $divider) if @setIDs; # divide sets, but not after the last set + } } -sub texBlockComment(@) { return "\n".("%"x80)."\n%% ".join("", @_)."\n".("%"x80)."\n\n"; } -sub getMultiSetTeX { - my ($self, $effectiveUserName,@sets) = @_; - my $ce = $self->r->ce; - my $tex = ""; - +sub write_set_tex { + my ($self, $FH, $TargetUser, $setID) = @_; + my $r = $self->r; + my $ce = $r->ce; + my $db = $r->db; + my $authz = $r->authz; + my $userID = $r->param("user"); + # get set record + my $MergedSet = $db->getMergedSet($TargetUser->user_id, $setID); # checked + unless ($MergedSet) { + $self->add_errors("Can't generate hardcopy for set $setID for user ".$TargetUser->user_id." -- set is not assigned to that user."); + return; + } - while (defined (my $setName = shift @sets)) { - $tex .= $self->getSetTeX($effectiveUserName, $setName); - if (@sets) { - # divide sets, but not after the last set - $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{setDivider}); - } + # see if the *real* user is allowed to access this problem set + if ($MergedSet->open_date > time and not $authz->hasPermissions($userID, "view_unopened_sets")) { + $self->add_errors("Can't generate hardcopy for set $setID for user ".$TargetUser->user_id." -- set is not yet open."); + return; + } + if (not $MergedSet->published and not $authz->hasPermissions($userID, "view_unpublished_sets")) { + $self->addbadmessage("Can't generate hardcopy for set $setID for user ".$TargetUser->user_id." -- set has not been published."); + return; } - + # get snippets + my $header = $MergedSet->hardcopy_header + ? $MergedSet->hardcopy_header + : $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; + my $footer = $ce->{webworkFiles}->{hardcopySnippets}->{setFooter}; + my $divider = $ce->{webworkFiles}->{hardcopySnippets}->{problemDivider}; + + # get list of problem IDs + my @problemIDs = sort { $a <=> $b } $db->listUserProblems($MergedSet->user_id, $MergedSet->set_id); + + # write set header + $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $header); # 0 => pg file specified directly - return $tex; + # write each problem + while (my $problemID = shift @problemIDs) { + $self->write_tex_file($FH, $divider); + $self->write_problem_tex($FH, $TargetUser, $MergedSet, $problemID); + } + + # write footer + $self->write_problem_tex($FH, $TargetUser, $MergedSet, 0, $footer); # 0 => pg file specified directly } -sub getSetTeX { - my ($self, $effectiveUserName, $setName) = @_; +sub write_problem_tex { + my ($self, $FH, $TargetUser, $MergedSet, $problemID, $pgFile) = @_; my $r = $self->r; my $ce = $r->ce; my $db = $r->db; - - # FIXME (debug code line next) - # print STDERR "Creating set $setName for $effectiveUserName \n"; - - # FIXME We could define a default for the effective user if no correct name is passed in. - # I'm not sure that it is wise. - my $effectiveUser = $db->getUser($effectiveUserName); # checked - die "effective user ($effectiveUserName) does not exist." - unless defined $effectiveUser; - - my @problemNumbers = sort { $a <=> $b } - $db->listUserProblems($effectiveUserName, $setName); - - # get header and footer - my $set = $db->getMergedSet($effectiveUserName, $setName); # checked - my $setHeader = (ref($set) && $set->hardcopy_header) ? $set->hardcopy_header: $ce->{webworkFiles}->{hardcopySnippets}->{setHeader}; - # database doesn't support the following yet :( - #my $setFooter = $wwdb->getMergedSet($effectiveUserName, $setName)->set_footer - # || $ce->{webworkFiles}->{hardcopySnippets}->{setFooter}; - # so we don't allow per-set customization, which is probably okay :) - my $setFooter = $ce->{webworkFiles}->{hardcopySnippets}->{setFooter}; - - my $tex = ""; - - # render header - $tex .= texBlockComment("BEGIN $setName : $setHeader"); - $tex .= $self->getProblemTeX($effectiveUser,$setName, 0, $setHeader); - - # render each problem - while (my $problemNumber = shift @problemNumbers) { - # - # DPVC -- do problem divider ABOVE the problem, rather than below it - # - $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{problemDivider}); - # - # /DPVC - # - $tex .= texBlockComment("BEGIN $setName : $problemNumber"); - $tex .= $self->getProblemTeX($effectiveUser,$setName, $problemNumber); - # - # DPVC -- no need for it here since we do it above - # - #if (@problemNumbers) { - # # divide problems, but not after the last problem - # $tex .= $self->texInclude($ce->{webworkFiles}->{hardcopySnippets}->{problemDivider}); - #} - # - # /DPVC - # - } - - # render footer - $tex .= texBlockComment("BEGIN $setName : $setFooter"); - $tex .= $self->getProblemTeX($effectiveUser,$setName, 0, $setFooter); - - return $tex; -} - -sub getProblemTeX { - debug("hardcopy: begin processing problem"); - my ($self, $effectiveUser, $setName, $problemNumber, $pgFile) = @_; - my $r = $self->r; - my $ce = $r->ce; - my $db = $r->db; my $authz = $r->authz; - my $userID = $r->param("user"); - # Should we provide a default user ? I think not FIXME + my $userID = $r->param("user"); + + my @errors; - # $effectiveUser = $self->{effectiveUser} unless defined($effectiveUser); - my $permissionLevel = $self->{permissionLevel}; - my $set = $db->getMergedSet($effectiveUser->user_id, $setName); # checked - unless (ref($set) ) { # return error if no set is defined - push(@{$self->{warnings}}, - setName => $setName, - problem => 0, - message => "No set $setName exists for ".$effectiveUser->first_name.' '. - $effectiveUser->last_name.' ('.$effectiveUser->user_id.' )' - ); - return "No set $setName for ".$effectiveUser->user_id; - } - - my $preOpenSets = $authz->hasPermissions($userID, "view_unopened_sets"); - my $unpublishedSets = $authz->hasPermissions($userID, "view_unpublished_sets"); - unless ( ($preOpenSets or $set->open_date < time) and ($unpublishedSets or $set->published) ) { # return error if set is invisible - push(@{$self->{warnings}}, - setName => $setName, - problem => 0, - message => "The set $setName is hidden for ".$effectiveUser->first_name.' '. - $effectiveUser->last_name.' ('.$effectiveUser->user_id.' )' - ); - return "The set $setName is not yet ready for ".$effectiveUser->user_id; - } - my $psvn = $set->psvn(); - - # decide what to do about problem number - my $problem; - if ($problemNumber) { # problem number defined and not zero - $problem = $db->getMergedProblem($effectiveUser->user_id, $setName, $problemNumber); # checked + # get problem record + my $MergedProblem; + if ($problemID) { + # a non-zero problem ID was given -- load that problem + $MergedProblem = $db->getMergedProblem($MergedSet->user_id, $MergedSet->set_id, $problemID); # checked + + # handle nonexistent problem + unless ($MergedProblem) { + $self->add_errors("Can't generate hardcopy for problem $problemID in set ".$MergedSet->set_id." for user ".$MergedSet->user_id." -- problem does not exist in that set or is not assigned to that user."); + return; + } } elsif ($pgFile) { - $problem = WeBWorK::DB::Record::UserProblem->new( - set_id => $set->set_id, + # otherwise, we try an explicit PG file + $MergedProblem = $db->newUserProblem( + user_id => $MergedSet->user_id, + set_id => $MergedSet->set_id, problem_id => 0, - login_id => $effectiveUser->user_id, source_file => $pgFile, - # the rest of Problem's fields are not needed, i think ); + die "newUserProblem failed -- WTF?" unless $MergedProblem; # this should never happen + } else { + # this shouldn't happen -- error out for real + die "write_problem_tex needs either a non-zero \$problemID or a \$pgFile"; } - unless (ref($problem) ) { # return error if no problem is defined - $problemNumber = 'undefined problem number' unless defined($problemNumber); - $setName = 'undefined set Name' unless defined($setName); - my $msg = "Problem $setName/problem $problemNumber not assigned to ". - $effectiveUser->first_name.' '. - $effectiveUser->last_name.' ('.$effectiveUser->user_id.' )'; - push(@{$self->{warnings}}, - setName => $setName, - problem => $problemNumber, - message => $msg, - ); - $msg =~ s/_/\\_/; # escape underbars to protect them from TeX FIXME--this could be more general?? - return $msg; - } - # figure out if we're allowed to get solutions and call PG->new accordingly. + + # figure out if we're allowed to get correct answers, hints, and solutions + # (eventually, we'd like to be able to use the same code as Problem) my $showCorrectAnswers = $r->param("showCorrectAnswers") || 0; my $showHints = $r->param("showHints") || 0; my $showSolutions = $r->param("showSolutions") || 0; - unless ($authz->hasPermissions($userID, "view_answers") or time > $set->answer_date) { + unless ($authz->hasPermissions($userID, "view_answers") or time > $MergedSet->answer_date) { $showCorrectAnswers = 0; $showSolutions = 0; } - ##FIXME -- there can be a problem if the $siteDefaults{timezone} is not defined? Why is this? + + # FIXME -- there can be a problem if the $siteDefaults{timezone} is not defined? Why is this? # why does it only occur with hardcopy? my $pg = WeBWorK::PG->new( $ce, - $effectiveUser, - $r->param('key'), - $set, - $problem, - $psvn, + $TargetUser, + scalar($r->param('key')), # avoid multiple-values problem + $MergedSet, + $MergedProblem, + $MergedSet->psvn, {}, # no form fields! { # translation options displayMode => "tex", - showHints => ($showHints)? 1:0, # insure that this value is numeric - showSolutions => ($showSolutions)? 1:0, - processAnswers => ($showCorrectAnswers)? 1:0, + showHints => $showHints ? 1 : 0, # insure that this value is numeric + showSolutions => $showSolutions ? 1 : 0, # (or what? -sam) + processAnswers => $showCorrectAnswers ? 1 : 0, }, ); + # only bother to generate this info if there were warnings or errors + my $edit_url; + my $problem_name; + my $problem_desc; + if ($pg->{warnings} ne "" or $pg->{flags}->{error_flag}) { + my $edit_urlpath = $r->urlpath->newFromModule( + "WeBWorK::ContentGenerator::Instructor::PGProblemEditor", + courseID => $r->urlpath->arg("courseID"), + setID => $MergedProblem->set_id, + problemID => $MergedProblem->problem_id, + ); + + if ($MergedProblem->problem_id == 0) { + # link for an fake problem (like a header file) + $edit_url = $self->systemLink($edit_urlpath, + params => { + sourceFilePath => $MergedProblem->source_file, + problemSeed => $MergedProblem->problem_seed, + }, + ); + } else { + # link for a real problem + $edit_url = CGI::a({href=>$self->systemLink($edit_urlpath)}, "Edit it"); + } + + if ($MergedProblem->problem_id == 0) { + $problem_name = "snippet"; + $problem_desc = $problem_name." ".$MergedProblem->source_file + ." for set ".$MergedProblem->set_id." and user " + .$MergedProblem->user_id; + } else { + $problem_name = "problem"; + $problem_desc = $problem_name." ".$MergedProblem->problem_id + ." in set ".$MergedProblem->set_id." for user " + .$MergedProblem->user_id; + } + } + + # deal with PG warnings if ($pg->{warnings} ne "") { - push @{$self->{warnings}}, { - set => $setName, - problem => $problemNumber, - message => $pg->{warnings}, - }; + $self->add_errors(CGI::a({href=>$edit_url}, "[edit]") + ."Warnings encountered while processing $problem_desc. " + ."Error text:".CGI::br().CGI::pre($pg->{warnings}) + ); } + # deal with PG errors if ($pg->{flags}->{error_flag}) { - push @{$self->{errors}}, { - set => $setName, - problem => $problemNumber, - user => $effectiveUser, - message => $pg->{errors}, - context => $pg->{body_text}, - }; - # if there was an error, body_text contains - # the error context, not TeX code FIXME (should this error context be used?) - $pg->{body_text} = ''; # FIXME using undef causes error unless it is caught undef; - } else { - # append list of correct answers to body text - if ($showCorrectAnswers && $problemNumber != 0) { - # - # DPVC -- Adjusted spacing here, and added \small and italics. - # Put the answer in verbatim mode to make it display as typed - # by the author, rather than use hacks for ^ and _. What about - # vectors (where TeX will complain about < and > outside of - # math mode)? Do we need hacks for them, too? - # This also fixes a bug when the answer begins with [ - # where \item would think this was an optional parameter - # (otherwise we need to do "\\item{}$correctanswer\n"). - # - my $correctTeX = "\\par{\\small{\\it Correct Answers:}\n" - . "\\vspace{-\\parskip}\\begin{itemize}\n"; - foreach my $ansName (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}) { - my $correctAnswer = $pg->{answers}->{$ansName}->{correct_ans}; - #$correctAnswer =~ s/\^/\\\^\{\}/g; - #$correctAnswer =~ s/\_/\\\_/g; - $correctTeX .= "\\item\\begin{verbatim}$correctAnswer\\end{verbatim}\n"; - } - $correctTeX .= "\\end{itemize}}\\par\n"; - # - # /DPVC - # - $pg->{body_text} .= $correctTeX; + $self->add_errors(CGI::a({href=>$edit_url}, "[edit]") + ."Errors encountered while processing $problem_desc. " + ."This $problem_name has been omitted from the hardcopy. " + ."Error text:".CGI::br().CGI::pre($pg->{errors}) + ); + return; + } + + print $FH $pg->{body_text}; + + # write the list of correct answers is appropriate + if ($showCorrectAnswers && $MergedProblem->problem_id != 0) { + my $correctTeX = "\\par{\\small{\\it Correct Answers:}\n" + . "\\vspace{-\\parskip}\\begin{itemize}\n"; + + foreach my $ansName (@{$pg->{flags}->{ANSWER_ENTRY_ORDER}}) { + my $correctAnswer = $pg->{answers}->{$ansName}->{correct_ans}; + $correctTeX .= "\\item\\begin{verbatim}$correctAnswer\\end{verbatim}\n"; + # FIXME: What about vectors (where TeX will complain about < and > outside of math mode)? } + + $correctTeX .= "\\end{itemize}}\\par\n"; + + print $FH $correctTeX; } - debug("hardcopy: end processing problem"); - return $pg->{body_text}; } -sub texInclude { - my ($self, $texFile) = @_; - my $tex = ""; +sub write_tex_file { + my ($self, $FH, $file) = @_; - $tex .= texBlockComment("BEGIN: $texFile"); - eval { - $tex .= readFile($texFile) - }; + my $tex = eval { readFile($file) }; if ($@) { - $tex .= texBlockComment($@); + $self->add_errors("Failed to include TeX file $file: $@"); + } else { + print $FH $tex; } - - return $tex; +} + +################################################################################ +# utilities +################################################################################ + +sub add_errors { + my ($self, @errors) = @_; + #warn "add_errors(".join(", ", map("'$_'", @errors)).")"; + push @{$self->{hardcopy_errors}}, @errors; +} + +sub get_errors { + my ($self) = @_; + return $self->{hardcopy_errors} ? @{$self->{hardcopy_errors}} : (); +} + +sub get_errors_ref { + my ($self) = @_; + return $self->{hardcopy_errors}; } 1; |
From: Sam H. v. a. <we...@ma...> - 2005-09-22 18:58:19
|
Log Message: ----------- changed label for context URL to "Click this link to see the page from which the user sent feedback". Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator: Feedback.pm Revision Data ------------- Index: Feedback.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Feedback.pm,v retrieving revision 1.32 retrieving revision 1.33 diff -Llib/WeBWorK/ContentGenerator/Feedback.pm -Llib/WeBWorK/ContentGenerator/Feedback.pm -u -r1.32 -r1.33 --- lib/WeBWorK/ContentGenerator/Feedback.pm +++ lib/WeBWorK/ContentGenerator/Feedback.pm @@ -231,7 +231,9 @@ "generated by the WeBWorK system at", "$hostname:$port, in response to a request from", "$remoteIdent\@$remoteHost."), "\n\n"; - print $MAIL "Context: $emailableURL\n\n"; + + print $MAIL "Click this link to see the page from which the user sent feedback:\n", + "$emailableURL\n\n"; if ($feedback) { print $MAIL |
From: Sam H. v. a. <we...@ma...> - 2005-09-22 18:45:32
|
Log Message: ----------- restrict dates to < 10 years in the future -- see bug #829. Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator/Instructor: ProblemSetList.pm ProblemSetDetail.pm Revision Data ------------- Index: ProblemSetDetail.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm,v retrieving revision 1.20 retrieving revision 1.21 diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -u -r1.20 -r1.21 --- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm +++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm @@ -604,12 +604,29 @@ $error = $r->param('submit_changes'); } + # make sure the dates are not more than 10 years in the future + my $curr_time = time; + my $seconds_per_year = 31_556_926; + my $cutoff = $curr_time + $seconds_per_year*10; + if ($open_date > $cutoff) { + $self->addbadmessage("Error: open date cannot be more than 10 years from now in set $setID"); + $error = $r->param('submit_changes'); + } + if ($due_date > $cutoff) { + $self->addbadmessage("Error: due date cannot be more than 10 years from now in set $setID"); + $error = $r->param('submit_changes'); + } + if ($answer_date > $cutoff) { + $self->addbadmessage("Error: answer date cannot be more than 10 years from now in set $setID"); + $error = $r->param('submit_changes'); + } + + if ($error) { $self->addbadmessage("No changes were saved!"); } } - - + if (defined $r->param('submit_changes') && !$error) { #my $setRecord = $db->getGlobalSet($setID); # already fetched above --sam Index: ProblemSetList.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm,v retrieving revision 1.85 retrieving revision 1.86 diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm -u -r1.85 -r1.86 --- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm +++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm @@ -1213,7 +1213,7 @@ my @visibleSetIDs = @{ $self->{visibleSetIDs} }; foreach my $setID (@visibleSetIDs) { my $Set = $db->getGlobalSet($setID); # checked -# FIXME: we may not want to die on bad sets, they're not as bad as bad users + # FIXME: we may not want to die on bad sets, they're not as bad as bad users die "record for visible set $setID not found" unless $Set; foreach my $field ($Set->NONKEYFIELDS()) { @@ -1226,20 +1226,27 @@ } } } - - ################################################### + + # make sure the dates are not more than 10 years in the future + my $curr_time = time; + my $seconds_per_year = 31_556_926; + my $cutoff = $curr_time + $seconds_per_year*10; + return CGI::div({class=>'ResultsWithError'}, "Error: open date cannot be more than 10 years from now in set $setID") + if $Set->open_date > $cutoff; + return CGI::div({class=>'ResultsWithError'}, "Error: due date cannot be more than 10 years from now in set $setID") + if $Set->due_date > $cutoff; + return CGI::div({class=>'ResultsWithError'}, "Error: answer date cannot be more than 10 years from now in set $setID") + if $Set->answer_date > $cutoff; + # Check that the open, due and answer dates are in increasing order. # Bail if this is not correct. - ################################################### if ($Set->open_date > $Set->due_date) { return CGI::div({class=>'ResultsWithError'}, "Error: Due date must come after open date in set $setID"); } if ($Set->due_date > $Set->answer_date) { return CGI::div({class=>'ResultsWithError'}, "Error: Answer date must come after due date in set $setID"); } - ################################################### - # End date check section. - ################################################### + $db->putGlobalSet($Set); } |
From: Sam H. v. a. <we...@ma...> - 2005-09-22 18:06:53
|
Log Message: ----------- since the subject line can be changed now, email filters would be wise to rely on something more static. i've added X-WeBWorK-* headers to accomodate this: X-WeBWorK-Module X-WeBWorK-Course X-WeBWorK-User X-WeBWorK-Section X-WeBWorK-Recitation X-WeBWorK-Set X-WeBWorK-Problem Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator: Feedback.pm Revision Data ------------- Index: Feedback.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Feedback.pm,v retrieving revision 1.31 retrieving revision 1.32 diff -Llib/WeBWorK/ContentGenerator/Feedback.pm -Llib/WeBWorK/ContentGenerator/Feedback.pm -u -r1.31 -r1.32 --- lib/WeBWorK/ContentGenerator/Feedback.pm +++ lib/WeBWorK/ContentGenerator/Feedback.pm @@ -194,13 +194,24 @@ || "WeBWorK feedback from %c: %u set %s/prob %p"; # default if not entered $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ""/eg; + my $headers = "X-Remote-Host: ".$r->get_remote_host()."\n"; + $headers .= "X-WeBWorK-Module: $module\n" if defined $module; + $headers .= "X-WeBWorK-Course: $courseID\n" if defined $courseID; + if ($user) { + $headers .= "X-WeBWorK-User: ".$user->user_id."\n"; + $headers .= "X-WeBWorK-Section: ".$user->section."\n"; + $headers .= "X-WeBWorK-Recitation: ".$user->recitation."\n"; + } + $headers .= "X-WeBWorK-Set: ".$set->set_id."\n" if $set; + $headers .= "X-WeBWorK-Problem: ".$problem->problem_id."\n" if $problem; + # bring up a mailer my $mailer = Mail::Sender->new({ from => $sender, to => join(",", @recipients), smtp => $ce->{mail}->{smtpServer}, subject => $subject, - headers => "X-Remote-Host: ".$r->get_remote_host(), + headers => $headers, }); unless (ref $mailer) { $self->feedbackForm($user, $returnURL, |
From: Sam H. v. a. <we...@ma...> - 2005-09-22 17:48:58
|
Log Message: ----------- implement customizable feedback subject line. The following escape sequences are recognized: %c = course ID %u = user ID %s = set ID %p = problem ID %x = section %r = recitation %% = literal percent sign Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator: Feedback.pm webwork2/conf: global.conf.dist Revision Data ------------- Index: Feedback.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Feedback.pm,v retrieving revision 1.30 retrieving revision 1.31 diff -Llib/WeBWorK/ContentGenerator/Feedback.pm -Llib/WeBWorK/ContentGenerator/Feedback.pm -u -r1.30 -r1.31 --- lib/WeBWorK/ContentGenerator/Feedback.pm +++ lib/WeBWorK/ContentGenerator/Feedback.pm @@ -180,17 +180,26 @@ return ""; } + my %subject_map = ( + 'c' => $courseID, + 'u' => $user ? $user->user_id : undef, + 's' => $set ? $set->set_id : undef, + 'p' => $problem ? $problem->problem_id : undef, + 'x' => $user ? $user->section : undef, + 'r' => $user ? $user->recitation : undef, + '%' => '%', + ); + my $chars = join("", keys %subject_map); + my $subject = $ce->{mail}{feedbackSubjectFormat} + || "WeBWorK feedback from %c: %u set %s/prob %p"; # default if not entered + $subject =~ s/%([$chars])/defined $subject_map{$1} ? $subject_map{$1} : ""/eg; + # bring up a mailer my $mailer = Mail::Sender->new({ from => $sender, to => join(",", @recipients), - # *** we might want to have a CE setting for - # "additional recipients" smtp => $ce->{mail}->{smtpServer}, - subject => "WeBWorK feedback from $courseID (".$user->section.'-'.$user->recitation.'): '.$user->first_name.' '.$user->last_name. - ( ( defined($setName) && defined($problemNumber) ) ? - " set$setName/prob$problemNumber" : "" - ), + subject => $subject, headers => "X-Remote-Host: ".$r->get_remote_host(), }); unless (ref $mailer) { Index: global.conf.dist =================================================================== RCS file: /webwork/cvs/system/webwork2/conf/global.conf.dist,v retrieving revision 1.139 retrieving revision 1.140 diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.139 -r1.140 --- conf/global.conf.dist +++ conf/global.conf.dist @@ -93,7 +93,7 @@ # message. It can really be anything, but some mail servers require it contain # a valid mail domain, or at least be well-formed. $mail{smtpSender} = 'we...@yo...'; - + # AllowedRecipients defines addresses that the PG system is allowed to send mail # to. this prevents subtle PG exploits. This should be set in course.conf to the # addresses of professors of each course. Sending mail from the PG system (i.e. @@ -123,12 +123,24 @@ #'pr...@yo...', ]; +# Feedback subject line -- the following escape sequences are recognized: +# +# %c = course ID +# %u = user ID +# %s = set ID +# %p = problem ID +# %x = section +# %r = recitation +# %% = literal percent sign +# +$mail{feedbackSubjectFormat} = "[WWfeedback] course:%c %% user:%u set:%s prob:%p sec:%x rec:%r"; + # feedbackVerbosity: # 0: send only the feedback comment and context link # 1: as in 0, plus user, set, problem, and PG data # 2: as in 1, plus the problem environment (debugging data) $mail{feedbackVerbosity} = 1; - + # Defines the size of the Mail Merge editor window # FIXME: should this be here? it's UI, not mail # FIXME: replace this with the auto-size method that TWiki uses @@ -340,22 +352,7 @@ }; ################################################################################ -# Database options (WWDBv3) -################################################################################ - -# The four arguments passed to the DBI::connect() method. See the DBI manual for -# more information. -$wwdbv3_settings{dsn} = "dbi:mysql:wwdbv3"; -$wwdbv3_settings{user} = "wwdbv3"; -$wwdbv3_settings{pass} = "xyzzy"; -$wwdbv3_settings{attr} = {}; - -# WWDBv3 needs a lock file to prevent concurrent database upgrades. The file -# will be locked with flock(). -$wwdbv3_settings{upgrade_lock} = "$webworkDirs{tmp}/wwdbv3_upgrade.lock"; - -################################################################################ -# Database options (WWDBv2) +# Database options ################################################################################ # Several database are defined in the file conf/database.conf and stored in the |
From: Arnie P. v. a. <we...@ma...> - 2005-09-22 14:11:29
|
Log Message: ----------- Add section and recitation to feedback subject line as per Gavin's suggestion. Modified Files: -------------- webwork-modperl/lib/WeBWorK/ContentGenerator: Feedback.pm Revision Data ------------- Index: Feedback.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Feedback.pm,v retrieving revision 1.29 retrieving revision 1.30 diff -Llib/WeBWorK/ContentGenerator/Feedback.pm -Llib/WeBWorK/ContentGenerator/Feedback.pm -u -r1.29 -r1.30 --- lib/WeBWorK/ContentGenerator/Feedback.pm +++ lib/WeBWorK/ContentGenerator/Feedback.pm @@ -187,7 +187,7 @@ # *** we might want to have a CE setting for # "additional recipients" smtp => $ce->{mail}->{smtpServer}, - subject => "WeBWorK feedback from $courseID: ".$user->first_name." ".$user->last_name. + subject => "WeBWorK feedback from $courseID (".$user->section.'-'.$user->recitation.'): '.$user->first_name.' '.$user->last_name. ( ( defined($setName) && defined($problemNumber) ) ? " set$setName/prob$problemNumber" : "" ), |
From: Arnie P. v. a. <we...@ma...> - 2005-09-21 20:26:19
|
Log Message: ----------- fixed small typo Modified Files: -------------- webwork-modperl/conf: global.conf.dist Revision Data ------------- Index: global.conf.dist =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/conf/global.conf.dist,v retrieving revision 1.138 retrieving revision 1.139 diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.138 -r1.139 --- conf/global.conf.dist +++ conf/global.conf.dist @@ -113,7 +113,7 @@ # feedback button to go away as well. # # * If you want to send email ONLY to addresses in this list, set -# receive_feedback => $nodoy in %permissionLevels below. +# receive_feedback => $nobody in %permissionLevels below. # # It's often useful to set this in the course.conf to change the behavior of # feedback for a specific course. |
From: Sam H. v. a. <we...@ma...> - 2005-09-21 18:25:44
|
Log Message: ----------- added "use WeBWorK::Debug" to allow debug() statements to work. Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator: GatewayQuiz.pm Revision Data ------------- Index: GatewayQuiz.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v retrieving revision 1.12 retrieving revision 1.13 diff -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -u -r1.12 -r1.13 --- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm +++ lib/WeBWorK/ContentGenerator/GatewayQuiz.pm @@ -34,7 +34,7 @@ use WeBWorK::PG::IO; use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswers ref2string makeTempDirectory); use WeBWorK::DB::Utils qw(global2user user2global findDefaults); - +use WeBWorK::Debug; use WeBWorK::ContentGenerator::Instructor qw(assignSetVersionToUser); # template method |
From: dpvc v. a. <we...@ma...> - 2005-09-20 23:42:09
|
Log Message: ----------- Fixed a problem with reporting the directories where files with given types should be uploaded. Modified Files: -------------- webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor: FileManager.pm Revision Data ------------- Index: FileManager.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm,v retrieving revision 1.14 retrieving revision 1.15 diff -Llib/WeBWorK/ContentGenerator/Instructor/FileManager.pm -Llib/WeBWorK/ContentGenerator/Instructor/FileManager.pm -u -r1.14 -r1.15 --- lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm +++ lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm @@ -1047,11 +1047,12 @@ sub checkFileLocation { my $self = shift; my $extension = shift; $extension =~ s/.*\.//; - my $dir = shift; - return unless defined($uploadDir{$extension}); - return if $dir =~ m/^$uploadDir{$extension}$/; - $dir = $uploadDir{$extension}; $dir =~ s!/\.\*!!; - $self->addbadmessage("Files with extension '.$extension' usually belong in '$dir'"); + my $dir = shift; my $location = $uploadDir{$extension}; + return unless defined($location); + return if $dir =~ m/^$location$/; + $location =~ s!/\.\*!!; + return if $dir =~ m/^$location$/; + $self->addbadmessage("Files with extension '.$extension' usually belong in '$location'"); } ################################################## |
From: jj v. a. <we...@ma...> - 2005-09-19 17:11:14
|
Log Message: ----------- Fix bug 819. This adds a method to DB for getting all merged problems for a (student,set) combination so that the problem value can be correct. See bug 819 for additional comments on how this affects scoring when an individual student is given an override value for "weight". Modified Files: -------------- webwork-modperl/lib/WeBWorK: DB.pm webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor: StudentProgress.pm Scoring.pm webwork-modperl/lib/WeBWorK/ContentGenerator: Grades.pm Revision Data ------------- Index: DB.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/DB.pm,v retrieving revision 1.66 retrieving revision 1.67 diff -Llib/WeBWorK/DB.pm -Llib/WeBWorK/DB.pm -u -r1.66 -r1.67 --- lib/WeBWorK/DB.pm +++ lib/WeBWorK/DB.pm @@ -1865,6 +1865,29 @@ } } +=item getAllMergedUserProblems($userID, $setID) + +Returns a list of merged UserProblem objects representing all the problems +in the given set. Analogous to getAllUserProblems, except it returns +merged problem records. + +=cut + +sub getAllMergedUserProblems { + my ($self, $userID, $setID) = @_; + + croak "getAllMergedUserProblems: requires 2 arguments" + unless @_ == 3; + croak "getAllMergedUserProblems: argument 1 must contain a user_id" + unless defined $userID; + croak "getAllMergedUserProblems: argument 2 must contain a set_id" + unless defined $setID; + + my @userProblemRecords = $self->getAllUserProblems( $userID, $setID ); + my @userProblemIDs = map { [$userID, $setID, $_->problem_id] } @userProblemRecords; + return $self->getMergedProblems( @userProblemIDs ); +} + sub putUserProblem { my ($self, $UserProblem, $versioned) = @_; # $versioned is an optional argument which lets us slip versioned setIDs Index: Scoring.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm,v retrieving revision 1.49 retrieving revision 1.50 diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -u -r1.49 -r1.50 --- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm +++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm @@ -381,7 +381,7 @@ $setRecord->assignment_type() !~ /gateway/ ) { foreach my $userID (@sortedUserIDs) { my %CurrUserProblems = map { $_->problem_id => $_ } - $db->getAllUserProblems($userID, $setID); + $db->getAllMergedUserProblems($userID, $setID); $UserProblems{$userID} = \%CurrUserProblems; } } else { # versioned sets; get the problems for the best version @@ -463,7 +463,7 @@ } $userStatusTotals{$user} = 0 unless exists $userStatusTotals{$user}; my $user_problem_status = ($userProblem->status =~/^[\d\.]+$/) ? $userProblem->status : 0; # ensure it's numeric - $userStatusTotals{$user} += $user_problem_status * $globalProblem->value; + $userStatusTotals{$user} += $user_problem_status * $userProblem->value; if ($scoringItems->{successIndex}) { $numberOfAttempts{$user} = 0 unless defined($numberOfAttempts{$user}); my $num_correct = $userProblem->num_correct; Index: StudentProgress.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm,v retrieving revision 1.19 retrieving revision 1.20 diff -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -u -r1.19 -r1.20 --- lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm +++ lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm @@ -420,7 +420,7 @@ debug("Begin obtaining problem records for user $student set $setName"); - my @problemRecords = sort {$a->problem_id <=> $b->problem_id } $db->getAllUserProblems( $student, $sN ); + my @problemRecords = sort {$a->problem_id <=> $b->problem_id } $db->getAllMergedUserProblems( $student, $sN ); debug("End obtaining problem records for user $student set $setName"); my $num_of_problems = @problemRecords; $max_num_problems = ($max_num_problems>= $num_of_problems) ? $max_num_problems : $num_of_problems; Index: Grades.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Grades.pm,v retrieving revision 1.16 retrieving revision 1.17 diff -Llib/WeBWorK/ContentGenerator/Grades.pm -Llib/WeBWorK/ContentGenerator/Grades.pm -u -r1.16 -r1.17 --- lib/WeBWorK/ContentGenerator/Grades.pm +++ lib/WeBWorK/ContentGenerator/Grades.pm @@ -269,7 +269,7 @@ my $num_of_attempts = 0; debug("Begin collecting problems for set $setName"); - my @problemRecords = $db->getAllUserProblems( $studentName, $setName ); + my @problemRecords = $db->getAllMergedUserProblems( $studentName, $setName ); debug("End collecting problems for set $setName"); # FIXME the following line doesn't sort the problemRecords |
From: Sam H. v. a. <we...@ma...> - 2005-09-19 16:25:32
|
Log Message: ----------- added nice custom formatting routines for user/set/problem data: * uses "yes" and "no" for true/false values * formats dates * uses "unlimited" for -1 max_attempts * uses pretty names for the status * decodes the answer string * lines up output Modified Files: -------------- webwork2/lib/WeBWorK/ContentGenerator: Feedback.pm Revision Data ------------- Index: Feedback.pm =================================================================== RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Feedback.pm,v retrieving revision 1.28 retrieving revision 1.29 diff -Llib/WeBWorK/ContentGenerator/Feedback.pm -Llib/WeBWorK/ContentGenerator/Feedback.pm -u -r1.28 -r1.29 --- lib/WeBWorK/ContentGenerator/Feedback.pm +++ lib/WeBWorK/ContentGenerator/Feedback.pm @@ -32,6 +32,7 @@ use CGI::Pretty qw(); use Mail::Sender; use Text::Wrap qw(wrap); +use WeBWorK::Utils qw/formatDateTime decodeAnswers/; # request paramaters used # @@ -222,43 +223,48 @@ "***** Data about the problem processor: *****\n\n", "Display Mode: $displayMode\n", - "Show Old Answers? $showOldAnswers\n", - "Show Correct Answers? $showCorrectAnswers\n", - "Show Hints? $showHints\n", - "Show Solutions? $showSolutions\n\n", + "Show Old Answers: " . ($showOldAnswers ? "yes" : "no") . "\n", + "Show Correct Answers: " . ($showCorrectAnswers ? "yes" : "no") . "\n", + "Show Hints: " . ($showHints ? "yes" : "no") . "\n", + "Show Solutions: " . ($showSolutions ? "yes" : "no") . "\n\n", } if ($user and $verbosity >= 1) { print $MAIL "***** Data about the user: *****\n\n", - $user->toString(), "\n\n"; - + #$user->toString(), "\n\n"; + $self->format_user($user), "\n"; } if ($problem and $verbosity >= 1) { print $MAIL "***** Data about the problem: *****\n\n", - $problem->toString(), "\n\n"; - + #$problem->toString(), "\n\n"; + $self->format_userproblem($problem), "\n"; } if ($set and $verbosity >= 1) { print $MAIL "***** Data about the homework set: *****\n\n", - $set->toString(), "\n\n"; - + #$set->toString(), "\n\n"; + $self->format_userset($set), "\n"; } if ($ce and $verbosity >= 2) { print $MAIL "***** Data about the environment: *****\n\n", Dumper($ce), "\n\n"; - } - # end the message - close $MAIL; - - # print confirmation - print CGI::p("Your message was sent successfully."); - print CGI::p(CGI::a({-href => $returnURL}, "Return to your work")); - print CGI::pre(wrap("", "", $feedback)); + # Close returns the mailer object on success, a negative value on failure, + # zero if mailer was not opened. + my $result = $mailer->Close; + + if (ref $result) { + # print confirmation + print CGI::p("Your message was sent successfully."); + print CGI::p(CGI::a({-href => $returnURL}, "Return to your work")); + print CGI::pre(wrap("", "", $feedback)); + } else { + $self->feedbackForm($user, $returnURL, + "Failed to send message ($result): $Mail::Sender::Error"); + } } else { # just print the feedback form, with no message $self->feedbackForm($user, $returnURL, ""); @@ -336,4 +342,78 @@ return @recipients; } +sub format_user { + my ($self, $User) = @_; + my $ce = $self->r->ce; + + my $result = "User ID: " . $User->user_id . "\n"; + $result .= "Name: " . $User->first_name . " " . $User->last_name . "\n"; + $result .= "Email: " . $User->email_address . "\n"; + $result .= "Student ID: " . $User->student_id . "\n"; + + my %status = %{$ce->{siteDefaults}{status}}; + $result .= "Status: " . (exists $status{$User->status} ? $status{$User->status} : $User->status) . "\n"; + + $result .= "Section: " . $User->section . "\n"; + $result .= "Recitation: " . $User->recitation . "\n"; + $result .= "Comment: " . $User->comment . "\n"; + + return $result; +} + +sub format_userset { + my ($self, $Set) = @_; + my $ce = $self->r->ce; + + my $result = "Set ID: " . $Set->set_id . "\n"; + $result .= "Set header file: " . $Set->set_header . "\n"; + $result .= "Hardcopy header file: " . $Set->hardcopy_header . "\n"; + + my $tz = $ce->{siteDefaults}{timezone}; + $result .= "Open date: " . formatDateTime($Set->open_date, $tz) . "\n"; + $result .= "Due date: " . formatDateTime($Set->due_date, $tz) . "\n"; + $result .= "Answer date: " . formatDateTime($Set->answer_date, $tz) . "\n"; + $result .= "Published: " . ($Set->published ? "yes" : "no") . "\n"; + $result .= "Assignment type: " . $Set->assignment_type . "\n"; + if ($Set->assignment_type =~ /gateway/) { + $result .= "Attempts per version: " . $Set->assignment_type . "\n"; + $result .= "Time interval: " . $Set->time_interval . "\n"; + $result .= "Versions per interval: " . $Set->versions_per_interval . "\n"; + $result .= "Version time limit: " . $Set->version_time_limit . "\n"; + $result .= "Version creation time: " . formatDateTime($Set->version_creation_time, $tz) . "\n"; + $result .= "Problem randorder: " . $Set->problem_randorder . "\n"; + $result .= "Version last attempt time: " . $Set->version_last_attempt_time . "\n"; + } + + return $result; +} + +sub format_userproblem { + my ($self, $Problem) = @_; + my $ce = $self->r->ce; + + my $result = "Problem ID: " . $Problem->problem_id . "\n"; + $result .= "Source file: " . $Problem->source_file . "\n"; + $result .= "Value: " . $Problem->value . "\n"; + $result .= "Max attempts " . ($Problem->max_attempts == -1 ? "unlimited" : $Problem->max_attempts) . "\n"; + $result .= "Random seed: " . $Problem->problem_seed . "\n"; + $result .= "Status: " . $Problem->status . "\n"; + $result .= "Attempted: " . ($Problem->attempted ? "yes" : "no") . "\n"; + + my %last_answer = decodeAnswers($Problem->last_answer); + if (%last_answer) { + $result .= "Last answer:\n"; + foreach my $key (sort keys %last_answer) { + $result .= "\t$key: $last_answer{$key}\n"; + } + } else { + $result .= "Last answer: none\n"; + } + + $result .= "Number of correct attempts: " . $Problem->num_correct . "\n"; + $result .= "Number of incorrect attempts: " . $Problem->num_incorrect . "\n"; + + return $result; +} + 1; |
From: dpvc v. a. <we...@ma...> - 2005-09-19 00:58:19
|
Log Message: ----------- Fixed bug where str_cmp("0") was changing the correct answer to "", making it impossible to get correct. Modified Files: -------------- pg/macros: PGanswermacros.pl Revision Data ------------- Index: PGanswermacros.pl =================================================================== RCS file: /webwork/cvs/system/pg/macros/PGanswermacros.pl,v retrieving revision 1.37 retrieving revision 1.38 diff -Lmacros/PGanswermacros.pl -Lmacros/PGanswermacros.pl -u -r1.37 -r1.38 --- macros/PGanswermacros.pl +++ macros/PGanswermacros.pl @@ -2844,7 +2844,7 @@ my $answer_evaluator = new AnswerEvaluator; $answer_evaluator->{debug} = $str_params{debug}; $answer_evaluator->ans_hash( - correct_ans => $str_params{correct_ans}||'', + correct_ans => "$str_params{correct_ans}", type => $str_params{type}||'str_cmp', score => 0, |
From: dpvc v. a. <we...@ma...> - 2005-09-19 00:16:09
|
Log Message: ----------- Prevent the empty list from having open and close be set to 'start' (a value used internally). Modified Files: -------------- pg/lib/Parser: List.pm Revision Data ------------- Index: List.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Parser/List.pm,v retrieving revision 1.16 retrieving revision 1.17 diff -Llib/Parser/List.pm -Llib/Parser/List.pm -u -r1.16 -r1.17 --- lib/Parser/List.pm +++ lib/Parser/List.pm @@ -44,6 +44,7 @@ else {$equation->Error(["Entries in a %s must be of the same type",$type->{name}])} } } + $open = '' if $open eq 'start'; $close = '' if $close eq 'start'; $list = bless { coords => $coords, type => $type, open => $open, close => $close, paren => $paren, equation => $equation, isConstant => $constant |
From: Mike G. v. a. <we...@ma...> - 2005-09-17 20:14:06
|
Log Message: ----------- Expanded information in error messages. Modified Files: -------------- webwork-modperl/lib/WeBWorK/Utils: CourseManagement.pm webwork-modperl/lib/WeBWorK/Utils/CourseManagement: sql_single.pm Revision Data ------------- Index: CourseManagement.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/CourseManagement.pm,v retrieving revision 1.24 retrieving revision 1.25 diff -Llib/WeBWorK/Utils/CourseManagement.pm -Llib/WeBWorK/Utils/CourseManagement.pm -u -r1.24 -r1.25 --- lib/WeBWorK/Utils/CourseManagement.pm +++ lib/WeBWorK/Utils/CourseManagement.pm @@ -569,7 +569,7 @@ debug("archiving course dir: $tarCmd $archivePath $courseDir \n"); my $tarStatement = "$tarCmd -zcf $archivePath $courseDir"; my $tarResult = system $tarStatement ; - $tarResult and die "failed to tar course directory with command: '$tarStatement ' (errno: $tarResult): $!\n"; + $tarResult and die "Failed to tar course directory with command: '$tarStatement ' (errno: $tarResult): $!\n"; } Index: sql_single.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/CourseManagement/sql_single.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -Llib/WeBWorK/Utils/CourseManagement/sql_single.pm -Llib/WeBWorK/Utils/CourseManagement/sql_single.pm -u -r1.6 -r1.7 --- lib/WeBWorK/Utils/CourseManagement/sql_single.pm +++ lib/WeBWorK/Utils/CourseManagement/sql_single.pm @@ -352,7 +352,8 @@ " >$archiveDatabasePath"; debug($exportStatement); my $exportResult = system $exportStatement; - $exportResult and die "failed to tar course directory with command: '$exportResult ' (errno: $exportResult): $!\n"; + $exportResult and die "Failed to export database with command: '$exportStatement ' (errno: $exportResult): $! + \n\n Check server error log for more information."; ##### issue SQL statements ##### |
From: Mike G. v. a. <we...@ma...> - 2005-09-17 20:11:41
|
Log Message: ----------- Added \usepackage{epstopdf} on the suggestion of Frank Wolfs to the TeX header. This allows the CAPA files to print pictures with pdflatex even though they use .eps figures. Modified Files: -------------- webwork-modperl/conf/snippets: hardcopyPreamble.tex Revision Data ------------- Index: hardcopyPreamble.tex =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/conf/snippets/hardcopyPreamble.tex,v retrieving revision 1.2 retrieving revision 1.3 diff -Lconf/snippets/hardcopyPreamble.tex -Lconf/snippets/hardcopyPreamble.tex -u -r1.2 -r1.3 --- conf/snippets/hardcopyPreamble.tex +++ conf/snippets/hardcopyPreamble.tex @@ -18,7 +18,9 @@ \documentclass[10pt,dvips]{amsart} \usepackage{amsmath,amsfonts,amssymb,multicol} \usepackage[pdftex]{graphicx} +\usepackage{epstopdf} % allows use of eps files with pdftex \usepackage{epsf} +\usepackage{epsfig} \usepackage{pslatex} \pagestyle{plain} \textheight 9in |
From: jj v. a. <we...@ma...> - 2005-09-17 16:32:26
|
Log Message: ----------- Use underscore2nbsp from higher up module. Hopefully this fixes bug 841. Modified Files: -------------- webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor: Stats.pm StudentProgress.pm webwork-modperl/lib/WeBWorK/ContentGenerator: Grades.pm Revision Data ------------- Index: Stats.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/Stats.pm,v retrieving revision 1.57 retrieving revision 1.58 diff -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -u -r1.57 -r1.58 --- lib/WeBWorK/ContentGenerator/Instructor/Stats.pm +++ lib/WeBWorK/ContentGenerator/Instructor/Stats.pm @@ -112,7 +112,7 @@ foreach my $setID (@setIDs) { my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::Stats", courseID => $courseID, setID => $setID,statType => 'set',); - print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, underscore2nbsp($setID))); + print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, WeBWorK::ContentGenerator::underscore2nbsp($setID))); } print CGI::end_ul(); @@ -195,7 +195,7 @@ statType => 'set', setID => $set ); - push @setLinks, CGI::a({-href=>$self->systemLink($setStatisticsPage) }, underscore2nbsp($set)); + push @setLinks, CGI::a({-href=>$self->systemLink($setStatisticsPage) }, WeBWorK::ContentGenerator::underscore2nbsp($set)); } foreach my $student (@studentList) { @@ -600,10 +600,4 @@ return shift; } -sub underscore2nbsp { - my $str = shift; - $str =~ s/_/ /g; - return($str); -} - 1; Index: StudentProgress.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm,v retrieving revision 1.18 retrieving revision 1.19 diff -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -u -r1.18 -r1.19 --- lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm +++ lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm @@ -111,7 +111,7 @@ foreach my $setID (@setIDs) { my $problemPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::StudentProgress", courseID => $courseID, setID => $setID,statType => 'set',); - print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, underscore2nbsp($setID))); + print CGI::li(CGI::a({href=>$self->systemLink($problemPage)}, WeBWorK::ContentGenerator::underscore2nbsp($setID))); } print CGI::end_ul(); @@ -224,7 +224,7 @@ statType => 'set', setID => $set ); - push @setLinks, CGI::a({-href=>$self->systemLink($setStatisticsPage) }, underscore2nbsp($set)); + push @setLinks, CGI::a({-href=>$self->systemLink($setStatisticsPage) }, WeBWorK::ContentGenerator::underscore2nbsp($set)); } foreach my $studentRecord (@sortedStudentRecords) { @@ -847,10 +847,4 @@ return shift; } -sub underscore2nbsp { - my $str = shift; - $str =~ s/_/ /g; - return($str); -} - 1; Index: Grades.pm =================================================================== RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Grades.pm,v retrieving revision 1.15 retrieving revision 1.16 diff -Llib/WeBWorK/ContentGenerator/Grades.pm -Llib/WeBWorK/ContentGenerator/Grades.pm -u -r1.15 -r1.16 --- lib/WeBWorK/ContentGenerator/Grades.pm +++ lib/WeBWorK/ContentGenerator/Grades.pm @@ -336,7 +336,7 @@ my $successIndicator = ($avg_num_attempts) ? ($totalRight/$total)**2/$avg_num_attempts : 0 ; push @rows, CGI::Tr( - CGI::td(CGI::a({-href=>$act_as_student_set_url}, underscore2nbsp($setName))), + CGI::td(CGI::a({-href=>$act_as_student_set_url}, WeBWorK::ContentGenerator::underscore2nbsp($setName))), CGI::td(sprintf("%0.2f",$totalRight)), # score CGI::td($total), # out of CGI::td(sprintf("%0.0f",100*$successIndicator)), # indicator @@ -390,10 +390,4 @@ return shift; } -sub underscore2nbsp { - my $str = shift; - $str =~ s/_/ /g; - return($str); -} - 1; |
From: dpvc v. a. <we...@ma...> - 2005-09-17 13:22:31
|
Log Message: ----------- Don't allow wrapping in label for ans_array errors. Modified Files: -------------- pg/lib/Value: AnswerChecker.pm Revision Data ------------- Index: AnswerChecker.pm =================================================================== RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v retrieving revision 1.64 retrieving revision 1.65 diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.64 -r1.65 --- lib/Value/AnswerChecker.pm +++ lib/Value/AnswerChecker.pm @@ -503,7 +503,7 @@ if ($rows == 1) {$title = "In entry $j"} elsif ($cols == 1) {$title = "In entry $i"} else {$title = "In entry ($i,$j)"} - push(@{$errors},"<TR VALIGN=\"TOP\"><TD STYLE=\"text-align:right; border:0px\"><I>$title</I>: </TD>". + push(@{$errors},"<TR VALIGN=\"TOP\"><TD NOWRAP STYLE=\"text-align:right; border:0px\"><I>$title</I>: </TD>". "<TD STYLE=\"text-align:left; border:0px\">$message</TD></TR>"); } |