--- loncom/homework/grades.pm 2008/02/06 00:39:11 1.509
+++ loncom/homework/grades.pm 2009/03/06 21:14:50 1.555
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.509 2008/02/06 00:39:11 raeburn Exp $
+# $Id: grades.pm,v 1.555 2009/03/06 21:14:50 raeburn 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,8 +49,51 @@ use LONCAPA;
use POSIX qw(floor);
+
my %perm=();
+# These variables are used to recover from ssi errors
+
+my $ssi_retries = 5;
+my $ssi_error;
+my $ssi_error_resource;
+my $ssi_error_message;
+
+
+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;
+
+}
+#
+# Prodcuces an ssi retry failure error message to the user:
+#
+
+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('Resource:').' '.$ssi_error_resource.'
+'.&mt('Error:').' '.$ssi_error_message.'
+
+'.
+&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.').' '.
+&mt('If the error persists, please contact the [_1] for assistance.',$helpurl).
+'
');
+ return;
+}
+
#
# --- Retrieve the parts from the metadata file.---
sub getpartlist {
@@ -157,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');
@@ -172,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).' ';
}
}
@@ -195,39 +240,65 @@ 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"};
}
sub get_radiobutton_correct_foil {
my ($partid,$respid,$symb,$uname,$udom)=@_;
my $analyze = &get_analyze($symb,$uname,$udom);
- foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) {
- if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
- return $foil;
+ my $foils = &get_order($partid,$respid,$symb,$uname,$udom);
+ if (ref($foils) eq 'ARRAY') {
+ foreach my $foil (@{$foils}) {
+ if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') {
+ return $foil;
+ }
}
}
}
+
+ sub scantron_partids_tograde {
+ my ($resource,$cid,$uname,$udom) = @_;
+ my (%analysis,@parts);
+ if (ref($resource)) {
+ my $symb = $resource->symb();
+ my $analyze = &get_analyze($symb,$uname,$udom);
+ if (ref($analyze) eq 'HASH') {
+ %analysis = %{$analyze};
+ }
+ if (ref($analysis{'parts'}) eq 'ARRAY') {
+ foreach my $part (@{$analysis{'parts'}}) {
+ my ($id,$respid) = split(/\./,$part);
+ if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) {
+ push(@parts,$part);
+ }
+ }
+ }
+ }
+ return (\%analysis,\@parts);
+ }
+
}
#--- Clean response type for display
@@ -653,7 +724,7 @@ sub verifyreceipt {
my $title.=
''.
- &mt('Verifying Submission Receipt [_1]',$receipt).
+ &mt('Verifying Receipt No. [_1]',$receipt).
' '."\n".
''.&mt('Resource: [_1]',$env{'form.probTitle'}).
' '."\n";
@@ -737,16 +808,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")
.' ';
my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes'));
my %lt = ( 'multiple' =>
- "Please select a student or group of students before clicking on the Next button.",
+ &mt("Please select a student or group of students before clicking on the Next button."),
'single' =>
- "Please select the student before clicking on the Next button.",
+ &mt("Please select the student before clicking on the Next button."),
);
%lt = &Apache::lonlocal::texthash(%lt);
$request->print(<View Problem Text: [_1]',
+ ' '.&mt('View Problem Text').': '.
' '.&mt('no').' '."\n".
' '.&mt('one student').' '."\n".
- ' '.&mt('all students').' ').' '."\n";
+ ' '.&mt('all students').' '."\n";
$gradeTable .=
- ' '.
- &mt('View Answer: [_1]',
+ ' '.&mt('View Answer').': '.
' '.&mt('no').' '."\n".
' '.&mt('one student').' '."\n".
- ' '.&mt('all students').' ').' '."\n";
+ ' '.&mt('all students').' '."\n";
my $submission_options;
if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
@@ -817,18 +886,16 @@ LISTJAVASCRIPT
' '.&mt('by dates and submissions').' '."\n".
' '.&mt('all details').' ';
$gradeTable .=
- ' '.
- &mt('Submissions: [_1]',$submission_options).' '."\n";
+ ' '.&mt('Submissions').': '.$submission_options.' '."\n";
$gradeTable .=
- ' '.
- &mt('Grading Increments: [_1]',
+ ' '.&mt('Grading Increments').': '.
''.
''.&mt('Whole Points').' '.
''.&mt('Half Points').' '.
''.&mt('Quarter Points').' '.
''.&mt('Tenths of a Point').' '.
- ' ');
+ '';
$gradeTable .=
&build_section_inputs().
@@ -847,15 +914,14 @@ LISTJAVASCRIPT
&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).' ';
}
- $gradeTable.=&mt('To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '.
- 'next to the student\'s name(s). Then click on the Next button.').' '."\n".
+ $gradeTable.=&mt('To '.lc($viewgrade)." a submission or a group of submissions, click on the check box(es) next to the student's name(s). Then click on the Next button.").' '."\n".
' '."\n";
# checkall buttons
$gradeTable.=&check_script('gradesub', 'stuinfo');
$gradeTable.=' '."\n";
+ 'value="'.&mt('Next').' →" /> '."\n";
$gradeTable.=&check_buttons();
$gradeTable.=' '.&mt('Check For Plagiarism').' ';
my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup);
@@ -947,7 +1013,7 @@ LISTJAVASCRIPT
' '.$section.($group ne '' ?'/'.$group:'').''."\n";
if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
- foreach (sort keys(%status)) {
+ foreach (sort(keys(%status))) {
next if ($_ =~ /^resource.*?submitted_by$/);
$gradeTable.=' '.&mt($status{$_}).' '."\n";
}
@@ -975,7 +1041,7 @@ LISTJAVASCRIPT
$gradeTable.=&Apache::loncommon::end_data_table()."\n".
' '."\n";
+ 'value="'.&mt('Next').' →" />'."\n";
if ($ctr == 0) {
my $num_students=(scalar(keys(%$fullname)));
if ($num_students eq 0) {
@@ -1071,6 +1137,7 @@ sub processGroup {
#--- Javascript to handle the submission page functionality ---
sub sub_page_js {
my $request = shift;
+ my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = ');
$request->print(<
function updateRadio(formname,id,weight) {
@@ -1081,7 +1148,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(<
@@ -1358,7 +1426,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);
@@ -1597,7 +1665,7 @@ sub gradeBox {
my $radio.=''."\n"; # display radio buttons in a nice table 10 across
while ($thisweight<=$wgt) {
- $radio.= ' '.$thisweight." \n";
@@ -1613,7 +1681,7 @@ sub gradeBox {
$wgt.')" />'."\n";
$line.='/'.$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') {
@@ -1626,9 +1694,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.=' '."\n".
@@ -1759,9 +1827,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
@@ -2010,7 +2078,7 @@ KEYWORDS
$lastsubonly.="\n".'Part: '.
$display_part.' ( ID '.$respid.
' ) '.
- ''.&mt('Nothing submitted - no attempts').'
';
+ ''.&mt('Nothing submitted - no attempts.').' ';
next;
}
foreach my $submission (@$string) {
@@ -2051,7 +2119,7 @@ KEYWORDS
' ) ';
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').' ';
+ $lastsubonly.=''.&mt('Like all files provided by users, this file may contain viruses').' ';
my $file_counter = 0;
foreach my $file (@$files) {
$file_counter++;
@@ -2062,7 +2130,7 @@ KEYWORDS
}
$lastsubonly.=''.&mt('Submitted Answer:').' '.
&cleanRecord($subval,$responsetype,$symb,$partid,
- $respid,\%record,$order);
+ $respid,\%record,$order,undef,$uname,$udom);
if ($similar) {$lastsubonly.=" $similar\n";}
$lastsubonly.='';
}
@@ -2142,8 +2210,8 @@ KEYWORDS
$seen{$partid}++;
next if ($$handgrade{$part_resp} ne 'yes'
&& $env{'form.lastSub'} eq 'hdgrade');
- push @partlist,$partid;
- push @gradePartRespid,$partid.'.'.$respid;
+ push(@partlist,$partid);
+ push(@gradePartRespid,$partid.'.'.$respid);
$request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
}
$request->print('');
@@ -2191,7 +2259,7 @@ KEYWORDS
'7 10 '."\n";
my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1');
$ntstu =~ s/$nsel $nsel;
- $endform.=&mt('[_1]student(s)',$ntstu);
+ $endform.=&mt('[quant,_1,student]',$ntstu);
$endform.=' '."\n".
' Nothing submitted - no attempts.';
+ ''.&mt('Nothing submitted - no attempts.').' ';
}
return (\@string,\$timestamp);
}
@@ -2470,7 +2538,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}));
@@ -2478,12 +2546,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;
@@ -2506,11 +2574,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;
}
@@ -2521,7 +2589,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++;
}
@@ -2529,7 +2597,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;
@@ -2575,7 +2643,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'}=
@@ -2610,7 +2678,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;
@@ -2637,7 +2705,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'};
@@ -2685,7 +2753,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);
@@ -2703,7 +2771,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}\/(.*)/);
@@ -2711,8 +2780,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.' ');
+ $request->print(''.
+ &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);
@@ -2809,7 +2880,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;
@@ -2839,8 +2910,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$/ ) {
@@ -2851,7 +2921,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') {
@@ -2931,6 +3002,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) {
@@ -2939,7 +3011,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 $sectionClass",$section_display).' ';
+ &mt("Assign Common Grade to [_1]",$sectionClass,$section_display).'';
$result.= &Apache::loncommon::start_data_table();
#radio buttons/text box for assigning points for a section or class.
#handles different parts of a problem
@@ -3169,8 +3241,8 @@ sub viewgrades {
my $line = ' /'.
- $weight{$partid}.' (problem weight)'."\n";
- $line.= ''."\n";
+ $line.= ''.&mt('Grade Status').': '.
' '.
@@ -3185,7 +3257,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++;
}
@@ -3196,8 +3268,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.').' '.
@@ -3207,10 +3279,11 @@ sub viewgrades {
my @partids = ();
foreach my $part (@parts) {
my $display=&Apache::lonnet::metadata($url,$part.'.display');
- $display =~ s|^Number of Attempts|Tries |; # makes the column narrower
+ my $narrowtext = &mt('Tries');
+ $display =~ s|^Number of Attempts|$narrowtext |; # makes the column narrower
if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
my ($partid) = &split_part_type($part);
- push(@partids, $partid);
+ push(@partids,$partid);
my $display_part=&get_display_part($partid,$symb);
if ($display =~ /^Partial Credit Factor/) {
$result.=''.
@@ -3364,7 +3437,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++;
}
@@ -3378,10 +3451,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;
}
}
@@ -3723,11 +3797,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();
@@ -3747,8 +3822,8 @@ sub upcsvScores_form {
$result.=$table;
$result.=''."\n";
$result.=''."\n";
- $result.=' '.&mt('Specify a file containing the class scores for current resource').
- '. '."\n";
+ $result.=' '.&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();
@@ -4001,12 +4076,13 @@ sub csvuploadassign {
sub pickStudentPage {
my ($request) = shift;
+ my $alertmsg = &mt('Please select the student you wish to grade.');
$request->print(<
function checkPickOne(formname) {
if (radioSelection(formname.student) == null) {
- alert("Please select the student you wish to grade.");
+ alert("$alertmsg");
return;
}
ptr = pullDownSelection(formname.selectpage);
@@ -4041,7 +4117,7 @@ LISTJAVASCRIPT
$ctr++;
}
$select.= '';
- $result.=&mt(' Problems from: [_1]',$select)." \n";
+ $result.=' '.&mt('Problems from').': '.$select." \n";
$ctr=0;
foreach (@$titles) {
@@ -4056,13 +4132,13 @@ LISTJAVASCRIPT
my $options =
' '.&mt('no').' '."\n".
' '.&mt('yes').' '." \n";
- $result.=' '.&mt('View Problems Text: [_1]',$options);
+ $result.=' '.&mt('View Problem Text').': '.$options;
$options =
' '.&mt('none').' '."\n".
' '.&mt('by dates and submissions').' '."\n".
' '.&mt('all details').' '."\n";
- $result.=' '.&mt('Submission Details: [_1]',$options);
+ $result.=' '.&mt('Submissions').': '.$options;
$result.=&build_section_inputs();
my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
@@ -4071,12 +4147,10 @@ LISTJAVASCRIPT
' '."\n".
' '." \n";
- $result.=' '.&mt('Use CODE: [_1] ',
- ' ').
- ' '."\n";
+ $result.=' '.&mt('Use CODE').': '."\n";
$result.=' '."\n";
+ 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /> '."\n";
$request->print($result);
@@ -4115,7 +4189,7 @@ LISTJAVASCRIPT
}
$studentTable.=&Apache::loncommon::end_data_table()."\n";
$studentTable.=' '."\n";
+ 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" />'."\n";
$studentTable.=&show_grading_menu_form($symb);
$request->print($studentTable);
@@ -4252,7 +4326,7 @@ sub displayPage {
# $request->print('match='.$1." \n");
# }
# $companswer =~ s|||g;
- $studentTable.=' '.$title.' '.&mt('Correct answer: [_1]',$companswer);
+ $studentTable.=' '.$title.' '.&mt('Correct answer').': '.$companswer;
}
my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
@@ -4322,10 +4396,11 @@ sub displaySubByDates {
my %orders;
$mark{'correct_by_student'} = $checkIcon;
if (!exists($$record{'1:timestamp'})) {
- return ' '.&mt('Nothing submitted - no attempts').' ';
+ return ' '.&mt('Nothing submitted - no attempts.').' ';
}
my $interaction;
+ my $no_increment = 1;
for ($version=1;$version<=$$record{'version'};$version++) {
my $timestamp =
&Apache::lonlocal::locallocaltime($$record{$version.':timestamp'});
@@ -4369,7 +4444,8 @@ sub displaySubByDates {
if (!exists($orders{$partid})) { $orders{$partid}={}; }
if (!exists($orders{$partid}->{$responseId})) {
$orders{$partid}->{$responseId}=
- &get_order($partid,$responseId,$symb,$uname,$udom);
+ &get_order($partid,$responseId,$symb,$uname,$udom,
+ $no_increment);
}
$displaySub[0].=' '.
&cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).' ';
@@ -4422,12 +4498,12 @@ sub updateGradeByPage {
my ($uname,$udom) = split(/:/,$env{'form.student'});
my $usec=$classlist->{$env{'form.student'}}[5];
if (!&canmodify($usec)) {
- $request->print('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'}.' ';
- $result.=' Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
+ $result.=' '.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
' '."\n";
$request->print($result);
@@ -4436,7 +4512,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;
@@ -4468,8 +4544,8 @@ sub updateGradeByPage {
&Apache::loncommon::start_data_table_row().
''.$prob.
(scalar(@{$parts}) == 1 ? ''
- : ' ('.&mt('[quant,_1, parts]',scalar(@{$parts}))
- ).') ';
+ : ' ('.&mt('[quant,_1, part]',scalar(@{$parts}))
+ .')').'';
$studentTable.=' '.$title.' ';
my %newrecord=();
@@ -4513,10 +4589,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).
' ';
- $displayPts[1].=' Part: '.$display_part.' = '.
+ $displayPts[1].=' '.&mt('Part').': '.$display_part.' = '.
(($score eq 'excused') ? 'excused' : $newpts).
' ';
$question++;
@@ -4565,9 +4641,9 @@ sub updateGradeByPage {
$studentTable.=&Apache::loncommon::end_data_table();
$studentTable.=&show_grading_menu_form($env{'form.symb'});
- my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' :
- 'The scores were changed for '.
- $changeflag.' problem'.($changeflag == 1 ? '.' : 's.'));
+ my $grademsg=($changeflag == 0 ? &mt('No score was changed or updated.') :
+ &mt('The scores were changed for [quant,_1,problem].',
+ $changeflag));
$request->print($grademsg.$studentTable);
return '';
@@ -4677,7 +4753,7 @@ sub getSequenceDropDown {
}
my %bubble_lines_per_response; # no. bubble lines for each response.
- # index is "symb.part_id"
+ # key is zero-based index - 0, 1, 2 ...
my %first_bubble_line; # First bubble line no. for each bubble.
@@ -4718,7 +4794,6 @@ sub restore_bubble_lines {
$env{"form.scantron.responsetype.$line"};
$line++;
}
-
}
# Given the parsed scanline, get the response for
@@ -4727,7 +4802,6 @@ sub restore_bubble_lines {
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};
@@ -4751,8 +4825,9 @@ sub get_response_bubbles {
sub scantron_filenames {
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $getpropath = 1;
my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
- &propath($cdom,$cname));
+ $getpropath);
my @possiblenames;
foreach my $filename (sort(@files)) {
($filename)=split(/&/,$filename);
@@ -4795,19 +4870,76 @@ sub scantron_uploads {
=cut
sub scantron_scantab {
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
my $result=''."\n";
$result.=' '."\n";
- foreach my $line (<$fh>) {
- my ($name,$descrip)=split(/:/,$line);
- if ($name =~ /^\#/) { next; }
- $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
@@ -4840,11 +4972,11 @@ sub scantron_CODElist {
=cut
sub scantron_CODEunique {
- my $result='
+ my $result='
'.&mt('Yes').'
-
+
'.&mt('No').'
';
@@ -4881,6 +5013,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.= '
@@ -5001,8 +5135,37 @@ sub scantron_selectphase {
');
&Apache::lonpickcode::code_list($r,2);
+
+ $r->print(' ');
$r->print($grading_menu_button);
- return
+ return;
}
=pod
@@ -5064,10 +5227,10 @@ sub scantron_selectphase {
sub get_scantron_config {
my ($which) = @_;
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+ my @lines = &get_scantronformat_file();
my %config;
#FIXME probably should move to XML it has already gotten a bit much now
- foreach my $line (<$fh>) {
+ foreach my $line (@lines) {
my ($name,$descrip)=split(/:/,$line);
if ($name ne $which ) { next; }
chomp($line);
@@ -5347,7 +5510,8 @@ sub scantron_parse_scanline {
my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;
my %record;
- my $questions=substr($line,$$scantron_config{'Qstart'}-1); # Answers
+ my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'};
+ my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers
my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff
if (!($$scantron_config{'CODElocation'} eq 0 ||
$$scantron_config{'CODElocation'} eq 'none')) {
@@ -5458,7 +5622,10 @@ sub scantron_validator_lettnum {
my $occurrences = 0;
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
- ($responsetype_per_response{$questnum-1} eq 'stringresponse')) {
+ ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
+ ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
+ ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
+ ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
my @singlelines = split('',$currquest);
foreach my $entry (@singlelines) {
$occurrences = &occurence_count($entry,$matchon);
@@ -5557,7 +5724,10 @@ sub scantron_validator_positional {
#
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') ||
($responsetype_per_response{$questnum-1} eq 'formularesponse') ||
- ($responsetype_per_response{$questnum-1} eq 'stringresponse')) {
+ ($responsetype_per_response{$questnum-1} eq 'stringresponse') ||
+ ($responsetype_per_response{$questnum-1} eq 'imageresponse') ||
+ ($responsetype_per_response{$questnum-1} eq 'reactionresponse') ||
+ ($responsetype_per_response{$questnum-1} eq 'organicresponse')) {
my $doubleerror = 0;
while (($currquest >= $$scantron_config{'Qlength'}) &&
(!$doubleerror)) {
@@ -6031,28 +6201,33 @@ sub scantron_validate_file {
}
if (!$stop) {
my $warning=&scantron_warning_screen('Start Grading');
- $r->print('
-'.&mt('Validation process complete.').'
-'.$warning.'
-
-
-');
-
+ $r->print(&mt('Validation process complete.').' '.
+ $warning.
+ &mt('Perform verification for each student after storage of submissions?').
+ ' '.
+ ' '.&mt('Yes').' '.
+ (' 'x3).''.
+ ' '.&mt('No').
+ ' '.
+ &mt('Grading will take longer if you use verification.').' '.
+ &mt("Alternatively, the 'Review scantron data' utility (see grading menu) can be used for all students after grading is complete.").' '.
+ ' '.
+ ' '."\n");
} else {
$r->print(' ');
$r->print(" ");
}
if ($stop) {
if ($validate_phases[$currentphase] eq 'sequence') {
- $r->print(' ');
+ $r->print(' ');
$r->print(' '.&mt('this error').' ');
$r->print(" ".&mt("Or click the 'Grading Menu' button to start over.")."
");
} else {
if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') {
- $r->print(' ');
+ $r->print(' ');
} else {
- $r->print(' ');
+ $r->print(' ');
}
$r->print(' '.&mt('using corrected info').' ');
$r->print(" ");
@@ -6430,14 +6605,7 @@ sub scantron_validate_sequence {
return (0,$currentphase+1);
}
-=pod
-
-=item scantron_validate_ID
-
- Validates all scanlines in the selected file to not have any
- invalid or underspecified student IDs
-=cut
sub scantron_validate_ID {
my ($r,$currentphase) = @_;
@@ -6503,35 +6671,6 @@ sub scantron_validate_ID {
return (0,$currentphase+1);
}
-=pod
-
-=item scantron_get_correction
-
- Builds the interface screen to interact with the operator to fix a
- specific error condition in a specific scanline
-
- Arguments:
- $r - Apache request object
- $i - number of the current scanline
- $scan_record - hash ref as returned from &scantron_parse_scanline()
- $scan_config - hash ref as returned from &get_scantron_config()
- $line - full contents of the current scanline
- $error - error condition, valid values are
- 'incorrectCODE', 'duplicateCODE',
- 'doublebubble', 'missingbubble',
- 'duplicateID', 'incorrectID'
- $arg - extra information needed
- For errors:
- - duplicateID - paper number that this studentID was seen before on
- - duplicateCODE - array ref of the paper numbers this CODE was
- seen on before
- - incorrectCODE - current incorrect CODE
- - doublebubble - array ref of the bubble lines that have double
- bubble errors
- - missingbubble - array ref of the bubble lines that have missing
- bubble errors
-
-=cut
sub scantron_get_correction {
my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
@@ -6669,7 +6808,7 @@ ENDSCRIPT
foreach my $question (@{$arg}) {
my @linenums = &prompt_for_corrections($r,$question,$scan_config,
$scan_record, $error);
- push (@lines_to_correct,@linenums);
+ push(@lines_to_correct,@linenums);
}
$r->print(&verify_bubbles_checked(@lines_to_correct));
} elsif ($error eq 'missingbubble') {
@@ -6689,7 +6828,7 @@ ENDSCRIPT
foreach my $question (@{$arg}) {
my @linenums = &prompt_for_corrections($r,$question,$scan_config,
$scan_record, $error);
- push (@lines_to_correct,@linenums);
+ push(@lines_to_correct,@linenums);
}
$r->print(&verify_bubbles_checked(@lines_to_correct));
} else {
@@ -6798,8 +6937,9 @@ for multi and missing bubble cases).
in exam mode. This hash contains a
comma-separated list of the lines per
sub-question.
- %responsetype_per_response - essayresponse, forumalaresponse, and
- stringresponse type problem parts can have
+ %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
@@ -6833,7 +6973,10 @@ sub prompt_for_corrections {
$r->print(&mt('The group of bubble lines below responds to a single question.').' ');
if (($responsetype_per_response{$question-1} eq 'essayresponse') ||
($responsetype_per_response{$question-1} eq 'formularesponse') ||
- ($responsetype_per_response{$question-1} eq 'stringresponse')) {
+ ($responsetype_per_response{$question-1} eq 'stringresponse') ||
+ ($responsetype_per_response{$question-1} eq 'imageresponse') ||
+ ($responsetype_per_response{$question-1} eq 'reactionresponse') ||
+ ($responsetype_per_response{$question-1} eq 'organicresponse')) {
$r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their scantron sheets.",$lines).' '.&mt('A non-zero score can be assigned to the student during scantron grading by selecting a bubble in at least one line.').' '.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').' '.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").' ');
} else {
$r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")." ");
@@ -6843,7 +6986,7 @@ sub prompt_for_corrections {
my $selected = $$scan_record{"scantron.$current_line.answer"};
&scantron_bubble_selector($r,$scan_config,$current_line,
$questionnum,$error,split('', $selected));
- push (@linenums,$current_line);
+ push(@linenums,$current_line);
$current_line++;
}
if ($lines > 1) {
@@ -7059,7 +7202,7 @@ sub scantron_validate_CODE {
$line,'duplicateCODE',$usedCODEs{$CODE});
return(1,$currentphase);
}
- push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
+ push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
}
return (0,$currentphase+1);
}
@@ -7098,25 +7241,6 @@ sub scantron_validate_doublebubble {
return (0,$currentphase+1);
}
-=pod
-
-=item scantron_get_maxbubble
-
- Returns the maximum number of bubble lines that are expected to
- occur. Does this by walking the selected sequence rendering the
- resource and then checking &Apache::lonxml::get_problem_counter()
- for what the current value of the problem counter is.
-
- Caches the results to $env{'form.scantron_maxbubble'},
- $env{'form.scantron.bubble_lines.n'},
- $env{'form.scantron.first_bubble_line.n'} and
- $env{"form.scantron.sub_bubblelines.n"}
- which are the total number of bubble, lines, the number of bubble
- lines for response n and number of the first bubble line for response n,
- and a comma separated list of numbers of bubble lines for sub-questions
- (for optionresponse, matchresponse, and rankresponse items), for response n.
-
-=cut
sub scantron_get_maxbubble {
if (defined($env{'form.scantron_maxbubble'}) &&
@@ -7142,97 +7266,66 @@ sub scantron_get_maxbubble {
%first_bubble_line = ();
%subdivided_bubble_lines = ();
%responsetype_per_response = ();
-
+
my $response_number = 0;
my $bubble_line = 0;
foreach my $resource (@resources) {
- # Need to retrieve part IDs and response IDs because essayresponse
- # items are not included in $analysis{'parts'} from lonnet::ssi.
- my %possible_part_ids;
- if (ref($resource->parts()) eq 'ARRAY') {
- foreach my $part (@{$resource->parts()}) {
- my @resp_ids = $resource->responseIds($part);
- foreach my $id (@resp_ids) {
- $possible_part_ids{$part.'.'.$id} = 1;
- }
- }
- }
- my $result=&Apache::lonnet::ssi($resource->src(),
- ('symb' => $resource->symb()),
- ('grade_target' => 'analyze'),
- ('grade_courseid' => $cid),
- ('grade_domain' => $udom),
- ('grade_username' => $uname));
- my (undef, $an) =
- split(/_HASH_REF__/,$result, 2);
-
- my @parts;
-
- my %analysis = &Apache::lonnet::str2hash($an);
-
- if (ref($analysis{'parts'}) eq 'ARRAY') {
- @parts = @{$analysis{'parts'}};
- }
- # Add part_ids for any essayresponse items.
- foreach my $part_id (keys(%possible_part_ids)) {
- if ($analysis{$part_id.'.type'} eq 'essayresponse') {
- if (!grep(/^\Q$part_id\E$/,@parts)) {
- push (@parts,$part_id);
- }
- }
- }
-
- foreach my $part_id (@parts) {
- my $lines = $analysis{"$part_id.bubble_lines"};
-
- # TODO - make this a persistent hash not an array.
-
- # optionresponse, matchresponse and rankresponse type items
- # render as separate sub-questions in exam mode.
- if (($analysis{$part_id.'.type'} eq 'optionresponse') ||
- ($analysis{$part_id.'.type'} eq 'matchresponse') ||
- ($analysis{$part_id.'.type'} eq 'rankresponse')) {
- my ($numbub,$numshown);
- if ($analysis{$part_id.'.type'} eq 'optionresponse') {
- if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') {
- $numbub = scalar(@{$analysis{$part_id.'.options'}});
+ my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom);
+ if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
+ foreach my $part_id (@{$parts}) {
+ my $lines;
+
+ # TODO - make this a persistent hash not an array.
+
+ # optionresponse, matchresponse and rankresponse type items
+ # render as separate sub-questions in exam mode.
+ if (($analysis->{$part_id.'.type'} eq 'optionresponse') ||
+ ($analysis->{$part_id.'.type'} eq 'matchresponse') ||
+ ($analysis->{$part_id.'.type'} eq 'rankresponse')) {
+ my ($numbub,$numshown);
+ if ($analysis->{$part_id.'.type'} eq 'optionresponse') {
+ if (ref($analysis->{$part_id.'.options'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis->{$part_id.'.options'}});
+ }
+ } elsif ($analysis->{$part_id.'.type'} eq 'matchresponse') {
+ if (ref($analysis->{$part_id.'.items'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis->{$part_id.'.items'}});
+ }
+ } elsif ($analysis->{$part_id.'.type'} eq 'rankresponse') {
+ if (ref($analysis->{$part_id.'.foils'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis->{$part_id.'.foils'}});
+ }
}
- } elsif ($analysis{$part_id.'.type'} eq 'matchresponse') {
- if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') {
- $numbub = scalar(@{$analysis{$part_id.'.items'}});
+ if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') {
+ $numshown = scalar(@{$analysis->{$part_id.'.shown'}});
}
- } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') {
- if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') {
- $numbub = scalar(@{$analysis{$part_id.'.foils'}});
+ my $bubbles_per_line = 10;
+ my $inner_bubble_lines = int($numbub/$bubbles_per_line);
+ if (($numbub % $bubbles_per_line) != 0) {
+ $inner_bubble_lines++;
}
- }
- if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') {
- $numshown = scalar(@{$analysis{$part_id.'.shown'}});
- }
- my $bubbles_per_line = 10;
- my $inner_bubble_lines = int($numshown/$bubbles_per_line);
- if (($numshown % $bubbles_per_line) != 0) {
- $inner_bubble_lines++;
- }
- for (my $i=0; $i<$numshown; $i++) {
- $subdivided_bubble_lines{$response_number} .=
- $inner_bubble_lines.',';
- }
- $subdivided_bubble_lines{$response_number} =~ s/,$//;
- }
-
- $first_bubble_line{$response_number} = $bubble_line;
- $bubble_lines_per_response{$response_number} = $lines;
- $responsetype_per_response{$response_number} =
- $analysis{$part_id.'.type'};
- $response_number++;
+ for (my $i=0; $i<$numshown; $i++) {
+ $subdivided_bubble_lines{$response_number} .=
+ $inner_bubble_lines.',';
+ }
+ $subdivided_bubble_lines{$response_number} =~ s/,$//;
+ $lines = $numshown * $inner_bubble_lines;
+ } else {
+ $lines = $analysis->{"$part_id.bubble_lines"};
+ }
- $bubble_line += $lines;
- $total_lines += $lines;
- }
+ $first_bubble_line{$response_number} = $bubble_line;
+ $bubble_lines_per_response{$response_number} = $lines;
+ $responsetype_per_response{$response_number} =
+ $analysis->{$part_id.'.type'};
+ $response_number++;
+ $bubble_line += $lines;
+ $total_lines += $lines;
+ }
+ }
}
- &Apache::lonnet::delenv('scantron\.');
+ &Apache::lonnet::delenv('scantron.');
&save_bubble_lines();
$env{'form.scantron_maxbubble'} =
@@ -7240,16 +7333,6 @@ sub scantron_get_maxbubble {
return $env{'form.scantron_maxbubble'};
}
-=pod
-
-=item scantron_validate_missingbubbles
-
- Validates all scanlines in the selected file to not have any
- answers that don't have bubbles that have not been verified
- to be bubble free.
-
-=cut
-
sub scantron_validate_missingbubbles {
my ($r,$currentphase) = @_;
#get student info
@@ -7303,35 +7386,15 @@ sub scantron_validate_missingbubbles {
return (0,$currentphase+1);
}
-=pod
-
-=item scantron_process_students
-
- Routine that does the actual grading of the bubble sheet information.
-
- The parsed scanline hash is added to %env
-
- Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
- foreach resource , with the form data of
-
- 'submitted' =>'scantron'
- 'grade_target' =>'grade',
- 'grade_username'=> username of student
- 'grade_domain' => domain of student
- 'grade_courseid'=> of course
- 'grade_symb' => symb of resource to grade
-
- This triggers a grading pass. The problem grading code takes care
- of converting the bubbled letter information (now in %env) into a
- valid submission.
-
-=cut
sub scantron_process_students {
my ($r) = @_;
+
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
my ($symb)=&get_symb($r);
- if (!$symb) {return '';}
+ if (!$symb) {
+ return '';
+ }
my $default_form_data=&defaultFormData($symb);
my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
@@ -7342,6 +7405,7 @@ sub scantron_process_students {
my $map=$navmap->getResourceByUrl($sequence);
my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
# $r->print("geto ".scalar(@resources)." ");
+ my ($uname,$udom);
my $result= <
@@ -7350,20 +7414,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(' ');
my $start=&Time::HiRes::time();
my $i=-1;
- my ($uname,$udom,$started);
+ my $started;
&scantron_get_maxbubble(); # Need the bubble lines array to parse.
+ # If an ssi failed in scantron_get_maxbubble, put an error message out to
+ # the user and return.
+
+ if ($ssi_error) {
+ $r->print("");
+ &ssi_print_error($r);
+ $r->print(&show_grading_menu_form($symb));
+ &Apache::lonnet::remove_lock($lock);
+ return ''; # Dunno why the other returns return '' rather than just returning.
+ }
+
+ my %lettdig = &letter_to_digits();
+ my $numletts = scalar(keys(%lettdig));
+
while ($i<$scanlines->{'count'}) {
($uname,$udom)=('','');
$i++;
@@ -7389,41 +7469,113 @@ SCANTRONFORM
}
($uname,$udom)=split(/:/,$uname);
+ my %partids_by_symb;
+ foreach my $resource (@resources) {
+ my $ressymb = $resource->symb();
+ my ($analysis,$parts) =
+ &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom); $partids_by_symb{$ressymb} = $parts;
+ }
+
&Apache::lonxml::clear_problem_counter();
- &Apache::lonnet::appenv(%$scan_record);
+ &Apache::lonnet::appenv($scan_record);
if (&scantron_clear_skip($scanlines,$scan_data,$i)) {
&scantron_putfile($scanlines,$scan_data);
}
- my $i=0;
- foreach my $resource (@resources) {
- $i++;
- my %form=('submitted' =>'scantron',
- 'grade_target' =>'grade',
- 'grade_username'=>$uname,
- 'grade_domain' =>$udom,
- 'grade_courseid'=>$env{'request.course.id'},
- 'grade_symb' =>$resource->symb());
- if (exists($scan_record->{'scantron.CODE'})
- &&
- &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) {
- $form{'CODE'}=$scan_record->{'scantron.CODE'};
- } else {
- $form{'CODE'}='';
- }
- my $result=&Apache::lonnet::ssi($resource->src(),%form);
- if ($result ne '') {
- }
- if (&Apache::loncommon::connection_aborted($r)) { last; }
- }
+ my $scancode;
+ if ((exists($scan_record->{'scantron.CODE'})) &&
+ (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
+ $scancode = $scan_record->{'scantron.CODE'};
+ } else {
+ $scancode = '';
+ }
+
+ if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
+ \@resources,\%partids_by_symb) eq 'ssi_error') {
+ $ssi_error = 0; # So end of handler error message does not trigger.
+ $r->print("");
+ &ssi_print_error($r);
+ $r->print(&show_grading_menu_form($symb));
+ &Apache::lonnet::remove_lock($lock);
+ return ''; # Why return ''? Beats me.
+ }
+
$completedstudents{$uname}={'line'=>$line};
- if (&Apache::loncommon::connection_aborted($r)) { last; }
+ if ($env{'form.verifyrecord'}) {
+ my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
+ my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
+ chomp($studentdata);
+ $studentdata =~ s/\r$//;
+ my $studentrecord = '';
+ my $counter = -1;
+ foreach my $resource (@resources) {
+ my $ressymb = $resource->symb();
+ ($counter,my $recording) =
+ &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
+ $counter,$studentdata,$partids_by_symb{$ressymb},
+ \%scantron_config,\%lettdig,$numletts);
+ $studentrecord .= $recording;
+ }
+ if ($studentrecord ne $studentdata) {
+ &Apache::lonxml::clear_problem_counter();
+ if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
+ \@resources,\%partids_by_symb) eq 'ssi_error') {
+ $ssi_error = 0; # So end of handler error message does not trigger.
+ $r->print("");
+ &ssi_print_error($r);
+ $r->print(&show_grading_menu_form($symb));
+ &Apache::lonnet::remove_lock($lock);
+ delete($completedstudents{$uname});
+ return '';
+ }
+ $counter = -1;
+ $studentrecord = '';
+ foreach my $resource (@resources) {
+ my $ressymb = $resource->symb();
+ ($counter,my $recording) =
+ &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
+ $counter,$studentdata,$partids_by_symb{$ressymb},
+ \%scantron_config,\%lettdig,$numletts);
+ $studentrecord .= $recording;
+ }
+ if ($studentrecord ne $studentdata) {
+ $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(' '.&Apache::loncommon::start_data_table()."\n".
+ &Apache::loncommon::start_data_table_header_row()."\n".
+ '
'.&mt('Source').' '.&mt('Bubbled responses').' '.
+ &Apache::loncommon::end_data_table_header_row()."\n".
+ &Apache::loncommon::start_data_table_row().
+ ''.&mt('Bubble Sheet').' '.
+ ''.$studentdata.' '.
+ &Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::start_data_table_row().
+ 'Stored submissions '.
+ ''.$studentrecord.' '."\n".
+ &Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::end_data_table().'');
+ } else {
+ $r->print(''.
+ &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'}).' '.
+ &mt("As a consequence, this user's submission history records two tries.").
+ ' ');
+ }
+ }
+ }
+ if (&Apache::loncommon::connection_aborted($r)) { last; }
} continue {
&Apache::lonxml::clear_problem_counter();
- &Apache::lonnet::delenv('scantron\.');
+ &Apache::lonnet::delenv('scantron.');
}
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+ &Apache::lonnet::remove_lock($lock);
# my $lasttime = &Time::HiRes::time()-$start;
# $r->print("took $lasttime
");
@@ -7432,13 +7584,36 @@ 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,$parts) = @_;
+ if (ref($resources) eq 'ARRAY') {
+ my $count = 0;
+ foreach my $resource (@{$resources}) {
+ my $ressymb = $resource->symb();
+ my %form = ('submitted' => 'scantron',
+ 'grade_target' => 'grade',
+ 'grade_username' => $uname,
+ 'grade_domain' => $udom,
+ 'grade_courseid' => $env{'request.course.id'},
+ 'grade_symb' => $ressymb,
+ 'CODE' => $scancode
+ );
+ if (ref($parts) eq 'HASH') {
+ if (ref($parts->{$ressymb}) eq 'ARRAY') {
+ foreach my $part (@{$parts->{$ressymb}}) {
+ $form{'scantron_questnum_start.'.$part} =
+ 1+$env{'form.scantron.first_bubble_line.'.$count};
+ $count++;
+ }
+ }
+ }
+ 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)=@_;
@@ -7453,7 +7628,7 @@ sub scantron_upload_scantron_data {