--- loncom/homework/grades.pm 2007/11/08 19:57:30 1.486 +++ loncom/homework/grades.pm 2008/03/17 20:39:50 1.515 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.486 2007/11/08 19:57:30 albertel Exp $ +# $Id: grades.pm,v 1.515 2008/03/17 20:39:50 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -47,88 +47,80 @@ use LONCAPA; use POSIX qw(floor); + my %perm=(); -my %bubble_lines_per_response = (); # no. bubble lines for each response. - # index is "symb.part_id" -my %first_bubble_line = (); # First bubble line no. for each bubble. +# These variables are used to recover from ssi errors -# Save and restore the bubble lines array to the form env. +my $ssi_retries = 5; +my $ssi_error; +my $ssi_error_resource; +my $ssi_error_message; -sub save_bubble_lines { - foreach my $line (keys(%bubble_lines_per_response)) { - $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; - $env{"form.scantron.first_bubble_line.$line"} = - $first_bubble_line{$line}; - } -} +# Do an ssi with retries: +# While I'd love to factor out this with the vesrion in lonprintout, +# that would either require a data coupling between modules, which I refuse to perpetuate +# (there's quite enough of that already), or would require the invention of another infrastructure +# I'm not quite ready to invent (e.g. an ssi_with_retry object). +# +# At least the logic that drives this has been pulled out into loncommon. -sub restore_bubble_lines { - my $line = 0; - %bubble_lines_per_response = (); - while ($env{"form.scantron.bubblelines.$line"}) { - my $value = $env{"form.scantron.bubblelines.$line"}; - $bubble_lines_per_response{$line} = $value; - $first_bubble_line{$line} = - $env{"form.scantron.first_bubble_line.$line"}; - $line++; +# +# ssi_with_retries - Does the server side include of a resource. +# if the ssi call returns an error we'll retry it up to +# the number of times requested by the caller. +# If we still have a proble, no text is appended to the +# output and we set some global variables. +# to indicate to the caller an SSI error occured. +# All of this is supposed to deal with the issues described +# in LonCAPA BZ 5631 see: +# http://bugs.lon-capa.org/show_bug.cgi?id=5631 +# by informing the user that this happened. +# +# Parameters: +# resource - The resource to include. This is passed directly, without +# interpretation to lonnet::ssi. +# form - The form hash parameters that guide the interpretation of the resource +# +# retries - Number of retries allowed before giving up completely. +# Returns: +# On success, returns the rendered resource identified by the resource parameter. +# Side Effects: +# The following global variables can be set: +# ssi_error - If an unrecoverable error occured this becomes true. +# It is up to the caller to initialize this to false +# if desired. +# ssi_last_error_resource - If an unrecoverable error occured, this is the value +# of the resource that could not be rendered by the ssi +# call. +# ssi_last_error - The error string fetched from the ssi response +# in the event of an error. +# +sub ssi_with_retries { + my ($resource, $retries, %form) = @_; + my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form); + if ($response->is_error) { + $ssi_error = 1; + $ssi_error_resource = $resource; + $ssi_error_message = $response->code . " " . $response->message; } -} + return $content; -# Given the parsed scanline, get the response for -# 'answer' number n: - -sub get_response_bubbles { - my ($parsed_line, $response) = @_; - - - my $bubble_line = $first_bubble_line{$response-1} +1; - my $bubble_lines= $bubble_lines_per_response{$response-1}; - - my $selected = ""; - - for (my $bline = 0; $bline < $bubble_lines; $bline++) { - $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; - $bubble_line++; - } - return $selected; } +# +# Prodcuces an ssi retry failure error message to the user: +# - -# ----- These first few routines are general use routines.---- - -# Return the number of occurences of a pattern in a string. - -sub occurence_count { - my ($string, $pattern) = @_; - - my @matches = ($string =~ /$pattern/g); - - return scalar(@matches); -} - - -# Take a string known to have digits and convert all the -# digits into letters in the range J,A..I. - -sub digits_to_letters { - my ($input) = @_; - - my @alphabet = ('J', 'A'..'I'); - - my @input = split(//, $input); - my $output =''; - for (my $i = 0; $i < scalar(@input); $i++) { - if ($input[$i] =~ /\d/) { - $output .= $alphabet[$input[$i]]; - } else { - $output .= $input[$i]; - } - } - return $output; +sub ssi_print_error { + my ($r) = @_; + $r->print('
Unable to perform a resource fetch from a server:
');
+ $r->print("Resource: $ssi_error_resource
");
+ $r->print("Error: $ssi_error_message
Try again later.");
+ $r->print('If errors persist, contact LonCAPA support for assistance
'. + &mt('The above receipt matches the following [numerate,_1,student].',$matches). + '
'. $header. $contents. &Apache::loncommon::end_data_table()."\n"; @@ -1837,9 +1833,9 @@ sub download_all_link { join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); my $identifier = &Apache::loncommon::get_cgi_id(); - &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students, - 'cgi.'.$identifier.'.symb' => $symb, - 'cgi.'.$identifier.'.parts' => $parts,); + &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, + 'cgi.'.$identifier.'.symb' => $symb, + 'cgi.'.$identifier.'.parts' => $parts,}); $r->print(''. &mt('Download All Submitted Documents').''); return @@ -4038,31 +4034,31 @@ sub csvuploadassign { $grades{$store_key}=$entries{$fields{$dest}}; } } - if (! %grades) { push(@skipped,"$username:$domain no data to save"); } - $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; - my $result=&Apache::lonnet::cstore(\%grades,$symb, + if (! %grades) { + push(@skipped,&mt("[_1]: no data to save","$username:$domain")); + } else { + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $result=&Apache::lonnet::cstore(\%grades,$symb, $env{'request.course.id'}, $domain,$username); - if ($result eq 'ok') { - $request->print('.'); - } else { - $request->print("- - Failed to save student $username:$domain. - Message when trying to save was ($result) - -
" ); - } - $request->rflush(); - $countdone++; + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print("". + &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", + "$username:$domain",$result)."
"); + } + $request->rflush(); + $countdone++; + } } - $request->print("'.&mt('Skipped Students').'
'); foreach my $student (@skipped) { $request->print("$studentStudents Not Allowed to Modify
'); + $request->print(''.&mt('Students Not Allowed to Modify').'
'); foreach my $student (@notallowed) { $request->print("$student- Specify a Scantron data file to upload. - | -|
+ '.&mt('Specify a Scantron data file to upload.').' + | + '.&Apache::loncommon::end_data_table_header_row().' + '.&Apache::loncommon::start_data_table_row().'
-SCANTRONFORM
+');
my $default_form_data=&defaultFormData(&get_symb($r,1));
my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'};
- $r->print(< - + |
-
---|
- Download a scoring office file - | -|
Filename of scoring office file: | $file_selector | -
- - | -
Sequence to be Graded: | $title |
Data File that will be used: | $env{'form.scantron_selectfile'} |
'.&mt('Sequence to be Graded:').' | '.$title.' |
'.&mt('Data File that will be used:').' | '.$env{'form.scantron_selectfile'}.' |
If this information is correct, please click on '$button_text'.
-If something is incorrect, please click the 'Grading Menu' button to start over.
+'.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'
+'.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').'
You have forgetten to specify some information. Please go Back and try again.
"); + $r->print("".&mt('You have forgetten to specify some information. Please go Back and try again.')."
"); if ( $env{'form.selectpage'} eq '') { - $r->print('You have not selected a Sequence to grade
'); + $r->print(''.&mt('You have not selected a Sequence to grade').'
'); } if ( $env{'form.scantron_selectfile'} eq '') { - $r->print('You have not selected a file that contains the student\'s response data.
'); + $r->print(''.&mt('You have not selected a file that contains the student\'s response data.').'
'); } if ( $env{'form.scantron_format'} eq '') { - $r->print('You have not selected a the format of the student\'s response data.
'); + $r->print(''.&mt('You have not selected a the format of the student\'s response data.').'
'); } } else { my $warning=&scantron_warning_screen('Grading: Validate Records'); - $r->print(<Gathering necessary info.
");$r->rflush(); + $r->print(''.&mt('Gathering necessary information.').'
');$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $max_bubble=&scantron_get_maxbubble(); @@ -5997,7 +6103,7 @@ sub scantron_validate_file { my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { - $r->print("Validating ".$validate_phases[$currentphase]."
"); + $r->print(&mt('Validating '.$validate_phases[$currentphase]).'Or click the 'Grading Menu' button to start over.
"); + $r->print("".&mt("Or click the 'Grading Menu' button to start over.")."
"); } else { - $r->print(''); - $r->print(' using corrected infoAn error was detected ($error)"); if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { - $r->print(" for PaperID ". - $$scan_record{'scantron.PaperID'}." \n"); + $r->print("
".&mt("An error was detected ($error)". + " for PaperID [_1]", + $$scan_record{'scantron.PaperID'})."
\n"); } else { - $r->print(" in scanline $i". - $line."\n"); - } - my $message="
The ID on the form is ".
- $$scan_record{'scantron.ID'}."
\n".
- "The name on the paper is ".
- $$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."
".&mt("An error was detected ($error)". + " in scanline [_1]
[_2]", + $i,$line)." \n"); + } + my $message="
".&mt("The ID on the form is [_1]
".
+ "The name on the paper is [_2],[_3]",
+ $$scan_record{'scantron.ID'},
+ $$scan_record{'scantron.LastName'},
+ $$scan_record{'scantron.FirstName'})."
".&mt("The encoded ID is not in the classlist"). + "
\n"); } elsif ($error eq 'duplicateID') { - $r->print("The encoded ID has also been used by a previous paper $arg\n"); + $r->print("".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."
\n"); } $r->print($message); - $r->print("How should I handle this?
\n");
+ $r->print("
".&mt("How should I handle this?")."
\n");
$r->print("\n
The encoded CODE is not in the list of possible CODEs
\n"); + $r->print("".&mt("The encoded CODE is not in the list of possible CODEs.")."
\n"); } elsif ($error eq 'duplicateCODE') { - $r->print("The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique
\n"); + $r->print("".&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."
\n"); } - $r->print("The CODE on the form is '".
- $$scan_record{'scantron.CODE'}."'
\n");
+ $r->print("
".&mt("The CODE on the form is '[_1]'",
+ $$scan_record{'scantron.CODE'})."
\n");
$r->print($message);
- $r->print("
How should I handle this?
\n");
+ $r->print("
".&mt("How should I handle this?")."
\n");
$r->print("\n
");
my $i=0;
if ($error eq 'incorrectCODE'
@@ -6562,7 +6679,13 @@ sub scantron_get_correction {
foreach my $testcode (@{$closest}) {
my $checked='';
if (!$i) { $checked=' checked="checked" '; }
- $r->print("");
+ $r->print("
+
+ ");
$r->print("\n
");
$i++;
}
@@ -6570,7 +6693,12 @@ sub scantron_get_correction {
}
if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
my $checked; if (!$i) { $checked=' checked="checked" '; }
- $r->print("");
+ $r->print("
+ ");
$r->print("\n
");
}
@@ -6592,118 +6720,274 @@ ENDSCRIPT
"&curCODE=".&escape($$scan_record{'scantron.CODE'}).
"&scantron_selectfile=".&escape($env{'form.scantron_selectfile'});
if ($env{'form.scantron_CODElist'} =~ /\S/) {
- $r->print(" Selected CODE is ");
+ $r->print("
+
+ ".&mt("Selected CODE is [_1]",""));
$r->print("\n
");
}
- $r->print(" as the CODE.");
+ $r->print("
+ "));
$r->print("\n
");
} elsif ($error eq 'doublebubble') {
- $r->print("
There have been multiple bubbles scanned for a some question(s)
\n"); + $r->print("".&mt("There have been multiple bubbles scanned for some question(s)")."
\n"); + + # The form field scantron_questions is acutally a list of line numbers. + # represented by this form so: + + my $line_list = &questions_to_line_list($arg); + $r->print(''); + $line_list.'" />'); $r->print($message); - $r->print("Please indicate which bubble should be used for grading
"); + $r->print("".&mt("Please indicate which bubble should be used for grading")."
"); foreach my $question (@{$arg}) { - my $selected = &get_response_bubbles($scan_record, $question); - my @select_array = split(/:/,$selected); - &scantron_bubble_selector($r,$scan_config,$question, - @select_array); + my @linenums = &prompt_for_corrections($r,$question,$scan_config, + $scan_record, $error); + push (@lines_to_correct,@linenums); } + $r->print(&verify_bubbles_checked(@lines_to_correct)); } elsif ($error eq 'missingbubble') { - $r->print("There have been no bubbles scanned for some question(s)
\n"); + $r->print("".&mt("There have been no bubbles scanned for some question(s)")."
\n"); $r->print($message); - $r->print("Please indicate which bubble should be used for grading
"); - $r->print("Some questions have no scanned bubbles\n"); + $r->print("".&mt("Please indicate which bubble should be used for grading.")."
"); + $r->print(&mt("Some questions have no scanned bubbles.")."\n"); + + # The form field scantron_questions is actually a list of line numbers not + # a list of question numbers. Therefore: + # + + my $line_list = &questions_to_line_list($arg); + $r->print(''); + $line_list.'" />'); foreach my $question (@{$arg}) { - my $selected = &get_response_bubbles($scan_record, $question); - my @select_array = split(/:/,$selected); # ought to be an array of empties. - &scantron_bubble_selector($r,$scan_config,$question, @select_array); + my @linenums = &prompt_for_corrections($r,$question,$scan_config, + $scan_record, $error); + push (@lines_to_correct,@linenums); } + $r->print(&verify_bubbles_checked(@lines_to_correct)); } else { $r->print("\n$quest | "); +sub prompt_for_corrections { + my ($r, $question, $scan_config, $scan_record, $error) = @_; + my ($current_line,$lines); + my @linenums; + my $questionnum = $question; + if ($question =~ /^(\d+)\.(\d+)$/) { + $question = $1; + $current_line = $first_bubble_line{$question-1} + 1 ; + my $subquestion = $2; + my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); + my $subcount = 1; + while ($subcount<$subquestion) { + $current_line += $subans[$subcount-1]; + $subcount ++; + } + $lines = $subans[$subquestion-1]; + } else { + $current_line = $first_bubble_line{$question-1} + 1 ; + $lines = $bubble_lines_per_response{$question-1}; + } + if ($lines > 1) { + $r->print(&mt('The group of bubble lines below responds to a single question.').'|
'); - if ($selected[0] eq $alphabet[$i]) { - $r->print('X'); - shift(@selected) ; - } else { - $r->print(' '); - } - $r->print(' | '); - - } +=pod - if ($l == 0) { - my $lspan = $total_lines * 2; # 2 table rows per bubble line. +=item scantron_bubble_selector + + Generates the html radiobuttons to correct a single bubble line + possibly showing the existing the selected bubbles if known - $r->print(''); - - } + Arguments: + $r - Apache request object + $scan_config - hash from &get_scantron_config() + $line - Number of the line being displayed. + $questionnum - Question number (may include subquestion) + $error - Type of error. + @selected - Array of bubbles picked on this line. - $r->print(' |
"); - } - $r->print(' |
$select_link | |
Course ID: | |
Course Name: | |
Domain: | $domsel |
File to upload: | |
'.$select_link.' | |
'.&mt('Course ID:').' | +|
'.&mt('Course Name:').' | +|
'.&mt('Domain:').' | +'.$domsel.' |
'.&mt('File to upload:').' | +
- The requested file name was invalid. + '.&mt('The requested file name was invalid.').'
-ERROR +'); $r->print(&show_grading_menu_form(&get_symb($r,1))); return; } @@ -7313,17 +7712,20 @@ ERROR &Apache::lonnet::allowuploaded('/adm/grades',$orig); &Apache::lonnet::allowuploaded('/adm/grades',$corrected); &Apache::lonnet::allowuploaded('/adm/grades',$skipped); - $r->print(<- Original file as uploaded by the scantron office. + '.&mt('[_1]Original[_2] file as uploaded by the scantron office.', + '','').'
- Corrections, a file of corrected records that were used in grading. + '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', + '','').'
- Skipped, a file of records that were skipped. + '.&mt('[_1]Skipped[_2], a file of records that were skipped.', + '','').'
-DOWNLOAD +'); $r->print(&show_grading_menu_form(&get_symb($r,1))); return ''; } @@ -7430,14 +7832,12 @@ sub grading_menu { $menudata->{'url'}.'" >'. $menudata->{'name'}."\n"; } else { - $Str .='