--- loncom/homework/grades.pm 2007/11/16 07:56:15 1.492
+++ loncom/homework/grades.pm 2009/02/24 17:12:19 1.553
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.492 2007/11/16 07:56:15 albertel Exp $
+# $Id: grades.pm,v 1.553 2009/02/24 17:12:19 biermanm Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -26,6 +26,8 @@
# http://www.lon-capa.org/
#
+
+
package Apache::grades;
use strict;
use Apache::style;
@@ -47,88 +49,49 @@ 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.
-
-# Save and restore the bubble lines array to the form env.
-
-
-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};
- }
-}
-
-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++;
- }
-
-}
+my %perm=();
-# Given the parsed scanline, get the response for
-# 'answer' number n:
+# These variables are used to recover from ssi errors
-sub get_response_bubbles {
- my ($parsed_line, $response) = @_;
+my $ssi_retries = 5;
+my $ssi_error;
+my $ssi_error_resource;
+my $ssi_error_message;
- 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++;
+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 $selected;
-}
-
-
-# ----- 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 $content;
- return scalar(@matches);
}
+#
+# Prodcuces an ssi retry failure error message to the user:
+#
-
-# 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) = @_;
+ my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk');
+ $r->print('
+'.&mt('An unrecoverable network error occurred:').'
+
+'.&mt('Unable to retrieve a resource from a server:').'
+'.
+&mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'
');
+ return;
}
#
@@ -239,8 +202,8 @@ sub showResourceInfo {
my %resptype = ();
my $hdgrade='no';
my %partsseen;
- foreach my $partID (sort keys(%$responseType)) {
- foreach my $resID (sort keys(%{ $responseType->{$partID} })) {
+ foreach my $partID (sort(keys(%$responseType))) {
+ foreach my $resID (sort(keys(%{ $responseType->{$partID} }))) {
my $handgrade=$$handgrade{$partID.'_'.$resID};
my $responsetype = $responseType->{$partID}->{$resID};
$hdgrade = $handgrade if ($handgrade eq 'yes');
@@ -254,9 +217,9 @@ sub showResourceInfo {
$partsseen{$partID}=1;
}
my $display_part=&get_display_part($partID,$symb);
- $result.=''.&mt('Part: [_1]',$display_part).' '.
- $resID.' '.
- ''.&mt('Type: [_1]',$responsetype).' ';
+ $result.=''.&mt('Part').': '.$display_part.
+ ' '.$resID.' '.&mt('Type').': '.$responsetype.''.&mt('Handgrade: [_1]',$handgrade).' ';
}
}
@@ -277,27 +240,28 @@ sub reset_caches {
}
sub get_analyze {
- my ($symb,$uname,$udom)=@_;
+ my ($symb,$uname,$udom,$no_increment)=@_;
my $key = "$symb\0$uname\0$udom";
return $analyze_cache{$key} if (exists($analyze_cache{$key}));
my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
$url=&Apache::lonnet::clutter($url);
- my $subresult=&Apache::lonnet::ssi($url,
- ('grade_target' => 'analyze'),
- ('grade_domain' => $udom),
- ('grade_symb' => $symb),
- ('grade_courseid' =>
- $env{'request.course.id'}),
- ('grade_username' => $uname));
+ my $subresult=&ssi_with_retries($url, $ssi_retries,
+ ('grade_target' => 'analyze',
+ 'grade_domain' => $udom,
+ 'grade_symb' => $symb,
+ 'grade_courseid' =>
+ $env{'request.course.id'},
+ 'grade_username' => $uname,
+ 'grade_noincrement' => $no_increment));
(undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
my %analyze=&Apache::lonnet::str2hash($subresult);
return $analyze_cache{$key} = \%analyze;
}
sub get_order {
- my ($partid,$respid,$symb,$uname,$udom)=@_;
- my $analyze = &get_analyze($symb,$uname,$udom);
+ my ($partid,$respid,$symb,$uname,$udom,$no_increment)=@_;
+ my $analyze = &get_analyze($symb,$uname,$udom,$no_increment);
return $analyze->{"$partid.$respid.shown"};
}
@@ -735,7 +699,7 @@ sub verifyreceipt {
my $title.=
''.
- &mt('Verifying Submission Receipt [_1]',$receipt).
+ &mt('Verifying Receipt No. [_1]',$receipt).
' '.&mt('Resource: [_1]',$env{'form.probTitle'}).
' '."\n";
@@ -819,16 +783,16 @@ sub listStudents {
$env{'form.probTitle'} = $env{'form.probTitle'} eq '' ?
&Apache::lonnet::gettitle($symb) : $env{'form.probTitle'};
- my $result=' '.
- &mt($viewgrade.' Submissions for a Student or a Group of Students')
+ my $result=' '
+ .&mt("$viewgrade Submissions for a Student or a Group of Students")
.' View Problem Text: [_1]',
+ ' '.&mt('View Problem Text').': '.
'View Answer: [_1]',
+ ' '.&mt('View Answer').': '.
'Submissions: [_1]',$submission_options).''.&mt('Submissions').': '.$submission_options.'Grading Increments: [_1]',
+ ' '.&mt('Grading Increments').': '.
''.
''.&mt('Whole Points').' '.
''.&mt('Half Points').' '.
''.&mt('Quarter Points').' '.
''.&mt('Tenths of a Point').' '.
- ' ');
+ '';
$gradeTable .=
&build_section_inputs().
@@ -929,15 +889,14 @@ LISTJAVASCRIPT
&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).' '.&mt($status{$_}).' '."\n";
}
@@ -1057,7 +1016,7 @@ LISTJAVASCRIPT
$gradeTable.=&Apache::loncommon::end_data_table()."\n".
'
function updateRadio(formname,id,weight) {
@@ -1163,7 +1123,7 @@ sub sub_page_js {
gradeBox.value = pts;
var resetbox = false;
if (isNaN(pts) || pts < 0) {
- alert("A number equal or greater than 0 is expected. Entered value = "+pts);
+ alert("$alertmsg"+pts);
for (var i=0; iprint(<
@@ -1440,7 +1401,7 @@ INNERJS
else return;
var cleantxt = txt.replace(new RegExp('([\\f\\n\\r\\t\\v ])+', 'g')," ");
if (cleantxt=="") {
- alert("Please select a word or group of words from document and then click this link.");
+ alert("$alertmsg");
return;
}
var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt);
@@ -1679,7 +1640,7 @@ sub gradeBox {
my $radio.=''."\n"; # display radio buttons in a nice table 10 across
while ($thisweight<=$wgt) {
- $radio.= '/'.$wgt.' '.$wgtmsg.
($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : '').
- ' '."\n";
+ ' '.&mt('Grade Status').': '."\n";
$line.=''."\n";
if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {
@@ -1708,9 +1669,9 @@ sub gradeBox {
$line.=''.&mt('reset status').' '."\n";
+ #&mt('Part: [_1] Points: [_2] or [_3] ',$display_part,$radio,$line);
$result .=
- &mt('Part: [_1] Points: [_2] or [_3] ',$display_part,$radio,$line);
-
+ ''.&mt('Part').': '.$display_part.' '.&mt('Points').': '.$radio.' '.&mt('or').' '.$line.' '.
$result.='
'."\n";
$result.=''.
&mt('Download All Submitted Documents').' ');
return
@@ -2092,7 +2053,7 @@ KEYWORDS
$lastsubonly.="\n".'Part: '.
$display_part.' ( ID '.$respid.
' ) '.
- ''.&mt('Nothing submitted - no attempts').'
';
+ ''.&mt('Nothing submitted - no attempts.').' ';
my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);
if (@$files) {
- $lastsubonly.=''.&mt('Like all files provided by users, this file may contain virusses').' '.&mt('Like all files provided by users, this file may contain viruses').' 7 10 '."\n";
my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1');
$ntstu =~ s/$nsel$nsel '."\n".
''.&mt('Nothing submitted - no attempts.').' ';
}
return (\@string,\$timestamp);
}
@@ -2552,7 +2513,7 @@ sub processHandGrade {
my (@parsedlist,@nextlist);
my ($nextflg) = 0;
- foreach (sort
+ foreach my $item (sort
{
if (lc($$fullname{$a}) ne lc($$fullname{$b})) {
return (lc($$fullname{$a}) cmp lc($$fullname{$b}));
@@ -2560,12 +2521,12 @@ sub processHandGrade {
return $a cmp $b;
} (keys(%$fullname))) {
if ($nextflg == 1 && $button =~ /Next$/) {
- push @parsedlist,$_;
+ push(@parsedlist,$item);
}
- $nextflg = 1 if ($_ eq $laststu);
+ $nextflg = 1 if ($item eq $laststu);
if ($button eq 'Previous') {
- last if ($_ eq $firststu);
- push @parsedlist,$_;
+ last if ($item eq $firststu);
+ push(@parsedlist,$item);
}
}
$ctr = 0;
@@ -2588,11 +2549,11 @@ sub processHandGrade {
my $submitted = 0;
my $ungraded = 0;
my $incorrect = 0;
- foreach (keys(%status)) {
- $submitted = 1 if ($status{$_} ne 'nothing');
- $ungraded = 1 if ($status{$_} =~ /^ungraded/);
- $incorrect = 1 if ($status{$_} =~ /^incorrect/);
- my ($foo,$partid,$foo1) = split(/\./,$_);
+ foreach my $item (keys(%status)) {
+ $submitted = 1 if ($status{$item} ne 'nothing');
+ $ungraded = 1 if ($status{$item} =~ /^ungraded/);
+ $incorrect = 1 if ($status{$item} =~ /^incorrect/);
+ my ($foo,$partid,$foo1) = split(/\./,$item);
if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
$submitted = 0;
}
@@ -2603,7 +2564,7 @@ sub processHandGrade {
next if (!$ungraded && ($submitonly eq 'graded'));
next if (!$incorrect && $submitonly eq 'incorrect');
}
- push @nextlist,$student if ($ctr < $ntstu);
+ push(@nextlist,$student) if ($ctr < $ntstu);
last if ($ctr == $ntstu);
$ctr++;
}
@@ -2611,7 +2572,7 @@ sub processHandGrade {
$ctr = 0;
my $total = scalar(@nextlist)-1;
- foreach (sort @nextlist) {
+ foreach (sort(@nextlist)) {
my ($uname,$udom,$submitter) = split(/:/);
$env{'form.student'} = $uname;
$env{'form.userdom'} = $udom;
@@ -2657,7 +2618,7 @@ sub saveHandGrade {
}
} elsif ($dropMenu eq 'reset status'
&& exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
- foreach my $key (keys (%record)) {
+ foreach my $key (keys(%record)) {
if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; }
}
$newrecord{'resource.'.$new_part.'.regrader'}=
@@ -2692,7 +2653,7 @@ sub saveHandGrade {
&handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
next;
} else {
- push @parts_graded, $new_part;
+ push(@parts_graded,$new_part);
}
if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {
$newrecord{'resource.'.$new_part.'.awarded'} = $partial;
@@ -2719,7 +2680,7 @@ sub saveHandGrade {
$record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||
$dropMenu eq 'reset status')
{
- push (@version_parts,$new_part);
+ push(@version_parts,$new_part);
}
}
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
@@ -2767,7 +2728,7 @@ sub check_and_remove_from_queue {
sub handback_files {
my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
- my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio';
+ my $portfolio_root = '/userfiles/portfolio';
my ($partlist,$handgrade,$responseType) = &response_type($symb);
my @part_response_id = &flatten_responseType($responseType);
@@ -2785,7 +2746,8 @@ sub handback_files {
my ($answer_name,$answer_ver,$answer_ext) =
&file_name_version_ext($answer_file);
my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
- my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root);
+ my $getpropath = 1;
+ my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
# fix file name
my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
@@ -2793,8 +2755,10 @@ sub handback_files {
$newflg.'_'.$part_resp.'_returndoc'.$file_counter,
$save_file_name);
if ($result !~ m|^/uploaded/|) {
- $request->print('An error occurred ('.$result.
- ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.' '.
+ &mt('An error occurred ([_1]) while trying to upload [_2].',
+ $result,$newflg.'_'.$part_resp.'_returndoc'.$file_counter).
+ ' ');
} else {
# mark the file as read only
my @files = ($save_file_name);
@@ -2891,7 +2855,7 @@ sub decrement_aggs {
if ($aggtries == $totaltries) {
$decrement{'users'} = 1;
}
- foreach my $type (keys (%decrement)) {
+ foreach my $type (keys(%decrement)) {
$$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};
}
return;
@@ -2921,8 +2885,7 @@ sub version_portfiles {
my $version_parts = join('|',@$v_flag);
my @returned_keys;
my $parts = join('|', @$parts_graded);
- my $portfolio_root = &propath($domain,$stu_name).
- '/userfiles/portfolio';
+ my $portfolio_root = '/userfiles/portfolio';
foreach my $key (keys(%$record)) {
my $new_portfiles;
if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
@@ -2933,7 +2896,8 @@ sub version_portfiles {
my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
my ($answer_name,$answer_ver,$answer_ext) =
&file_name_version_ext($answer_file);
- my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root);
+ my $getpropath = 1;
+ my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
if ($new_answer ne 'problem getting file') {
@@ -3013,6 +2977,7 @@ sub file_name_version_ext {
sub viewgrades_js {
my ($request) = shift;
+ my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = ');
$request->print(<
function writePoint(partid,weight,point) {
@@ -3021,7 +2986,7 @@ sub viewgrades_js {
if (point == "textval") {
point = document.classgrade["TEXTVAL_"+partid].value;
if (isNaN(point) || parseFloat(point) < 0) {
- alert("A number equal or greater than 0 is expected. Entered value = "+parseFloat(point));
+ alert("$alertmsg"+parseFloat(point));
var resetbox = false;
for (var i=0; i';
+ &mt("Assign Common Grade to [_1]",$sectionClass,$section_display).' '."\n";
+ $line.= ''.&mt('Grade Status').': '.
' '.
@@ -3267,7 +3232,7 @@ sub viewgrades {
$result.=
&Apache::loncommon::start_data_table_row()."\n".
- &mt('Part: [_1] Points: [_2] or [_3] ',$display_part,$radio,$line).
+ ''.&mt('Part').': '.$display_part.' '.&mt('Points').': '.$radio.' '.&mt('or').' '.$line.' '.
&Apache::loncommon::end_data_table_row()."\n";
$ctsparts++;
}
@@ -3278,8 +3243,8 @@ sub viewgrades {
#table listing all the students in a section/class
#header of table
- $result.= ''.&mt('Assign Grade to Specific Students in '.$sectionClass,
- $section_display).' ';
+ $result.= ''.&mt('Assign Grade to Specific Students in ').$sectionClass,
+ $section_display.' ';
$result.= &Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
''.&mt('No.').' '.
@@ -3289,10 +3254,11 @@ sub viewgrades {
my @partids = ();
foreach my $part (@parts) {
my $display=&Apache::lonnet::metadata($url,$part.'.display');
- $display =~ s|^Number of Attempts|Tries'.
@@ -3446,7 +3412,7 @@ sub editgrades {
my $header;
while ($ctr < $env{'form.totalparts'}) {
my $partid = $env{'form.partid_'.$ctr};
- push @partid,$partid;
+ push(@partid,$partid);
$weight{$partid} = $env{'form.weight_'.$partid};
$ctr++;
}
@@ -3460,10 +3426,11 @@ sub editgrades {
if ($part !~ m/^\Q$partid\E/) { next;}
if ($type eq 'awarded' || $type eq 'solved') { next; }
my $display=&Apache::lonnet::metadata($url,$stores.'.display');
- $display =~ s/\[Part: (\w)+\]//;
- $display =~ s/Number of Attempts/Tries/;
- $header .= ' '.&mt('Old '.$display).' '.
- ''.&mt('New '.$display).' ';
+ $display =~ s/\[Part: \Q$part\E\]//;
+ my $narrowtext = &mt('Tries');
+ $display =~ s/Number of Attempts/$narrowtext/;
+ $header .= ''.&mt('Old').' '.$display.' '.
+ ''.&mt('New').' '.$display.' ';
$columns{$partid}+=2;
}
}
@@ -3805,11 +3772,12 @@ ENDPICK
}
sub checkforfile_js {
+ my $alertmsg = &mt('Please use the browse button to select a file from your local directory.');
my $result =<
function checkUpload(formname) {
if (formname.upfile.value == "") {
- alert("Please use the browse button to select a file from your local directory.");
+ alert("$alertmsg");
return false;
}
formname.submit();
@@ -3829,8 +3797,8 @@ sub upcsvScores_form {
$result.=$table;
$result.=''."\n";
$result.=''."\n";
- $result.=' '.&mt('Specify a file containing the class scores for current resource').
- '. '.&mt('Specify a file containing the class scores for current resource.').
+ ' '."\n";
$result.=''."\n";
my $upload=&mt("Upload Scores");
my $upfile_select=&Apache::loncommon::upfile_select_html();
@@ -4042,31 +4010,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("Saved [_1] students",$countdone)." \n");
if (@skipped) {
- $request->print('
Skipped Students '.&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
function checkPickOne(formname) {
if (radioSelection(formname.student) == null) {
- alert("Please select the student you wish to grade.");
+ alert("$alertmsg");
return;
}
ptr = pullDownSelection(formname.selectpage);
@@ -4123,7 +4092,7 @@ LISTJAVASCRIPT
$ctr++;
}
$select.= '';
- $result.=&mt(' Problems from: [_1]',$select)."'.&mt('Problems from').': '.$select."View Problems Text: [_1]',$options);
+ $result.=' '.&mt('View Problem Text').': '.$options;
$options =
'Submission Details: [_1]',$options);
+ $result.=' '.&mt('Submissions').': '.$options;
$result.=&build_section_inputs();
my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
@@ -4153,12 +4122,10 @@ LISTJAVASCRIPT
'Use CODE: [_1] ',
- ''.&mt('Use CODE').': '.$env{'form.title'}.' '.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)).
' '."\n";
- if (&Apache::lonnet::validCODE($env{'form.CODE'})) {
+ $env{'form.CODE'} = uc($env{'form.CODE'});
+ if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) {
$result.=' '.&mt('CODE: [_1]',$env{'form.CODE'}).' '."\n";
} else {
delete($env{'form.CODE'});
@@ -4333,7 +4301,7 @@ sub displayPage {
# $request->print('match='.$1."||g;
- $studentTable.=' '.$title.' Correct answer: '.$title.' '.&mt('Correct answer').': '.&mt('Nothing submitted - no attempts').' '.&mt('Nothing submitted - no attempts.').' Unable to modify requested student.('.$env{'form.student'}.' ');
+ $request->print(''.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).' ');
$request->print(&show_grading_menu_form($env{'form.symb'}));
return;
}
my $result=' '.$env{'form.title'}.' Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
+ $result.=' '.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
' '."\n";
$request->print($result);
@@ -4517,7 +4487,7 @@ sub updateGradeByPage {
my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'});
my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
if (!$map) {
- $request->print('Unable to grade requested sequence. ('.$resUrl.') ');
+ $request->print(''.&mt('Unable to grade requested sequence ([_1]).',$resUrl).' ');
my ($symb)=&get_symb($request);
$request->print(&show_grading_menu_form($symb));
return;
@@ -4549,8 +4519,8 @@ sub updateGradeByPage {
&Apache::loncommon::start_data_table_row().
''.$prob.
(scalar(@{$parts}) == 1 ? ''
- : ' ';
+ : ' '.$title.' ';
my %newrecord=();
@@ -4594,10 +4564,10 @@ sub updateGradeByPage {
}
my $display_part=&get_display_part($partid,$curRes->symb());
my $oldstatus = $env{'form.solved'.$question.'_'.$partid};
- $displayPts[0].=' Part: '.$display_part.' = '.
+ $displayPts[0].=' '.&mt('Part').': '.$display_part.' = '.
(($oldstatus eq 'excused') ? 'excused' : $oldpts).
' Part: '.$display_part.' = '.
+ $displayPts[1].=' '.&mt('Part').': '.$display_part.' = '.
(($score eq 'excused') ? 'excused' : $newpts).
' '."\n";
$result.=''.$descrip.' '."\n";
+ my @lines = &get_scantronformat_file();
+ if (@lines > 0) {
+ foreach my $line (@lines) {
+ next if (($line =~ /^\#/) || ($line eq ''));
+ my ($name,$descrip)=split(/:/,$line);
+ $result.=''.$descrip.' '."\n";
+ }
}
$result.=' '."\n";
-
return $result;
}
+=pod
+
+=item get_scantronformat_file
+
+ Returns an array containing lines from the scantron format file for
+ the domain of the course.
+
+ If a url for a custom.tab file is listed in domain's configuration.db,
+ lines are from this file.
+
+ Otherwise, if a default.tab has been published in RES space by the
+ domainconfig user, lines are from this file.
+
+ Otherwise, fall back to getting lines from the legacy file on the
+ local server: /home/httpd/lonTabs/default_scantronformat.tab
+
+=cut
+
+sub get_scantronformat_file {
+ my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom);
+ my $gottab = 0;
+ my @lines;
+ if (ref($domconfig{'scantron'}) eq 'HASH') {
+ if ($domconfig{'scantron'}{'scantronformat'} ne '') {
+ my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'});
+ if ($formatfile ne '-1') {
+ @lines = split("\n",$formatfile,-1);
+ $gottab = 1;
+ }
+ }
+ }
+ if (!$gottab) {
+ my $confname = $cdom.'-domainconfig';
+ my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab';
+ my $formatfile = &Apache::lonnet::getfile($default);
+ if ($formatfile ne '-1') {
+ @lines = split("\n",$formatfile,-1);
+ $gottab = 1;
+ }
+ }
+ if (!$gottab) {
+ my @domains = &Apache::lonnet::current_machine_domains();
+ if (grep(/^\Q$cdom\E$/,@domains)) {
+ my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+ @lines = <$fh>;
+ close($fh);
+ } else {
+ my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab');
+ @lines = <$fh>;
+ close($fh);
+ }
+ }
+ return @lines;
+}
+
=pod
=item scantron_CODElist
@@ -4858,11 +4949,11 @@ sub scantron_CODElist {
=cut
sub scantron_CODEunique {
- my $result='
+ my $result='
-
+
';
@@ -4899,6 +4990,8 @@ sub scantron_selectphase {
my $CODE_unique=&scantron_CODEunique();
my $result;
+ $ssi_error = 0;
+
# Chunk of form to prompt for a file to grade and how:
$result.= '
@@ -5019,8 +5112,37 @@ sub scantron_selectphase {
');
&Apache::lonpickcode::code_list($r,2);
+
+ $r->print(''.&mt('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();
@@ -5985,7 +6168,7 @@ sub scantron_validate_file {
my $stop=0;
while (!$stop && $currentphase < scalar(@validate_phases)) {
- $r->print(' '.&mt('Validating '.$validate_phases[$currentphase]).'
');
+ $r->print(&mt('Validating '.$validate_phases[$currentphase]).''.
+ ' '.
+ (' 'x3).''.
+ ' ".&mt("Or click the 'Grading Menu' button to start over.")."
");
} else {
- $r->print('".&mt("The encoded ID is not in the classlist").
@@ -6612,112 +6771,258 @@ ENDSCRIPT
"
".&mt("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('".&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("".&mt("There have been no bubbles scanned for some question(s)")."
\n");
$r->print($message);
$r->print("".&mt("Please indicate which bubble should be used for grading.")."
");
- $r->print(&mt("Some questions have no scanned bubbles")."\n");
+ $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('
+function verify_bubble_radio(form) {
+ var ansnumArray = new Array ("$ansnumstr");
+ var need_bubble_count = 0;
+ for (var i=0; i 1) {
+ var bubble_picked = 0;
+ for (var j=0; j
+ENDSCRIPT
+ return $output;
}
=pod
-=item scantron_bubble_selector
-
- Generates the html radiobuttons to correct a single bubble line
- possibly showing the existing the selected bubbles if known
+=item questions_to_line_list
- Arguments:
- $r - Apache request object
- $scan_config - hash from &get_scantron_config()
- $quest - number of the bubble line to make a corrector for
- @lines - array of answer lines.
+Converts a list of questions into a string of comma separated
+line numbers in the answer sheet used by the questions. This is
+used to fill in the scantron_questions form field.
-=cut
+ Arguments:
+ questions - Reference to an array of questions.
-sub scantron_bubble_selector {
- my ($r,$scan_config,$quest,@lines)=@_;
- my $max=$$scan_config{'Qlength'};
+=cut
- my $scmode=$$scan_config{'Qon'};
+sub questions_to_line_list {
+ my ($questions) = @_;
+ my @lines;
+
+ foreach my $item (@{$questions}) {
+ my $question = $item;
+ my ($first,$count,$last);
+ if ($item =~ /^(\d+)\.(\d+)$/) {
+ $question = $1;
+ my $subquestion = $2;
+ $first = $first_bubble_line{$question-1} + 1;
+ my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
+ my $subcount = 1;
+ while ($subcount<$subquestion) {
+ $first += $subans[$subcount-1];
+ $subcount ++;
+ }
+ $count = $subans[$subquestion-1];
+ } else {
+ $first = $first_bubble_line{$question-1} + 1;
+ $count = $bubble_lines_per_response{$question-1};
+ }
+ $last = $first+$count-1;
+ push(@lines, ($first..$last));
+ }
+ return join(',', @lines);
+}
- my $bubble_length = scalar(@lines);
+=pod
+=item prompt_for_corrections
- if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }
+Prompts for a potentially multiline correction to the
+user's bubbling (factors out common code from scantron_get_correction
+for multi and missing bubble cases).
- my $response = $quest-1;
- my $lines = $bubble_lines_per_response{$response};
+ Arguments:
+ $r - Apache request object.
+ $question - The question number to prompt for.
+ $scan_config - The scantron file configuration hash.
+ $scan_record - Reference to the hash that has the the parsed scanlines.
+ $error - Type of error
+
+ Implicit inputs:
+ %bubble_lines_per_response - Starting line numbers for each question.
+ Numbered from 0 (but question numbers are from
+ 1.
+ %first_bubble_line - Starting bubble line for each question.
+ %subdivided_bubble_lines - optionresponse, matchresponse and rankresponse
+ type problems render as separate sub-questions,
+ in exam mode. This hash contains a
+ comma-separated list of the lines per
+ sub-question.
+ %responsetype_per_response - essayresponse, formularesponse,
+ stringresponse, imageresponse, reactionresponse,
+ and organicresponse type problem parts can have
+ multiple lines per response if the weight
+ assigned exceeds 10. In this case, only
+ one bubble per line is permitted, but more
+ than one line might contain bubbles, e.g.
+ bubbling of: line 1 - J, line 2 - J,
+ line 3 - B would assign 22 points.
- my $total_lines = $lines*2;
- my @alphabet=('A'..'Z');
+=cut
- $r->print("$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.').'');
- }
- my @selected = split(//,$lines[$l]);
- for (my $i=0;$i<$max;$i++) {
- $r->print("\n".'');
- 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(' ');
+=cut
- # FIXME: This may have to be a bit more clever for
- # multiline questions (different values e.g..).
+sub scantron_bubble_selector {
+ my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_;
+ my $max=$$scan_config{'Qlength'};
- for (my $i=0;$i<$max;$i++) {
- my $value = "$l:$i"; # Relative bubble line #: Bubble in line.
- $r->print("\n".
- ' ');
+ my $scmode=$$scan_config{'Qon'};
+ if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }
-
- }
- $r->print('
');
+ my @alphabet=('A'..'Z');
+ $r->print(&Apache::loncommon::start_data_table().
+ &Apache::loncommon::start_data_table_row());
+ $r->print('');
+ for (my $i=0;$i<$max+1;$i++) {
+ $r->print("\n".'');
+ if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
+ else { $r->print(' '); }
+ $r->print(' ');
+ }
+ $r->print(&Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::start_data_table_row());
+ for (my $i=0;$i<$max;$i++) {
+ $r->print("\n".
+ '
@@ -7091,19 +7425,36 @@ SCANTRONFORM
$r->print($result);
my @delayqueue;
- my %completedstudents;
+ my (%completedstudents,%scandata);
+ my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
my $count=&get_todo_count($scanlines,$scan_data);
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
'Scantron Progress',$count,
'inline',undef,'scantronupload');
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
'Processing first student');
+ $r->print('');
+ if ($scancode eq '') {
+ $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'}));
+ } else {
+ $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
+ }
+ $r->print('
'.&mt('Source').' '.&mt('Bubbled responses').' '.
+ &Apache::loncommon::end_data_table_header_row()."\n".
+ &Apache::loncommon::start_data_table_row().
+ ''.&mt('Bubble Sheet').' '.
+ ''.$studentdata.' Stored submissions '.
+ ''.$studentrecord.' '.
+ &mt('A second grading pass was needed for user: [_1] with ID: [_2], because a mismatch was seen on the first pass.',$uname.':'.$udom,$scan_record->{'scantron.ID'}).' took $lasttime
");
@@ -7173,13 +7576,22 @@ SCANTRONFORM
return '';
}
-=pod
-
-=item scantron_upload_scantron_data
-
- Creates the screen for adding a new bubble sheet data file to a course.
-
-=cut
+sub grade_student_bubbles {
+ my ($r,$uname,$udom,$scan_record,$scancode,@resources) = @_;
+ foreach my $resource (@resources) {
+ my %form = ('submitted' => 'scantron',
+ 'grade_target' => 'grade',
+ 'grade_username'=> $uname,
+ 'grade_domain' => $udom,
+ 'grade_courseid'=> $env{'request.course.id'},
+ 'grade_symb' => $resource->symb(),
+ 'CODE' => $scancode);
+ my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form);
+ return 'ssi_error' if ($ssi_error);
+ last if (&Apache::loncommon::connection_aborted($r));
+ }
+ return;
+}
sub scantron_upload_scantron_data {
my ($r)=@_;
@@ -7194,7 +7606,7 @@ sub scantron_upload_scantron_data {