--- loncom/homework/grades.pm 2005/11/15 15:55:11 1.294 +++ loncom/homework/grades.pm 2007/01/04 14:59:57 1.386 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.294 2005/11/15 15:55:11 albertel Exp $ +# $Id: grades.pm,v 1.386 2007/01/04 14:59:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,10 +36,15 @@ use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; use Apache::loncoursedata; -use Apache::lonmsg qw(:user_normal_msg); +use Apache::lonmsg(); use Apache::Constants qw(:common); use Apache::lonlocal; +use Apache::lonenc; use String::Similarity; +use lib '/home/httpd/lib/perl'; +use LONCAPA; + +use POSIX qw(floor); my %oldessays=(); my %perm=(); @@ -48,7 +53,8 @@ my %perm=(); # # --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url,$symb) = @_; + my ($symb) = @_; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); my $partorder = &Apache::lonnet::metadata($url, 'partorder'); my @parts; if ($partorder) { @@ -78,7 +84,7 @@ sub getpartlist { } # --- Get the symbolic name of a problem and the url -sub get_symb_and_url { +sub get_symb { my ($request,$silent) = @_; (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); @@ -88,7 +94,7 @@ sub get_symb_and_url { return (); } } - return ($symb,$url); + return ($symb); } #--- Format fullname, username:domain if different for display @@ -106,44 +112,39 @@ sub nameUserString { #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { - my ($url,$symb) = shift; - $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq ''); - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my %vPart; - foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { - $vPart{$partid}=1; - } - my %seen = (); - my (@partlist,%handgrade,%responseType); - foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_.*/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { - next; - } - if (%vPart && !exists($vPart{$partid})) { - next; - } - $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! - my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); - $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); - if (!exists($responseType{$partid})) { $responseType{$partid}={}; } - $responseType{$partid}->{$respid}=$responsetype; - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; - } - } - return \@partlist,\%handgrade,\%responseType; + my ($symb) = shift; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $response_types{$part}{$ids[$i]} = $types[$i]; + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types); +} + +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; } sub get_display_part { - my ($partID,$url,$symb)=@_; - if (!defined($symb) || $symb eq '') { - $symb=$env{'form.symb'}; - if ($symb eq '') { $symb=&Apache::lonnet::symbread($url) } - } + my ($partID,$symb)=@_; my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); if (defined($display) and $display ne '') { $display.= " (id $partID)"; @@ -156,35 +157,36 @@ sub get_display_part { #--- Show resource title #--- and parts and response type sub showResourceInfo { - my ($url,$probTitle,$checkboxes) = @_; + my ($symb,$probTitle,$checkboxes) = @_; my $col=3; if ($checkboxes) { $col=4; } my $result =''. ''."\n"; - my ($partlist,$handgrade,$responseType) = &response_type($url); + my ($partlist,$handgrade,$responseType) = &response_type($symb); my %resptype = (); my $hdgrade='no'; my %partsseen; - for my $part_resID (sort keys(%$handgrade)) { - my $handgrade=$$handgrade{$part_resID}; - my ($partID,$resID) = split(/_/,$part_resID); - my $responsetype = $responseType->{$partID}->{$resID}; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''; - if ($checkboxes) { - if (exists($partsseen{$partID})) { - $result.=""; - } else { - $result.=""; + 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'); + $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=""; + } + $partsseen{$partID}=1; } - $partsseen{$partID}=1; - } - my $display_part=&get_display_part($partID,$url); - $result.=''. - ''; + my $display_part=&get_display_part($partID,$symb); + $result.=''. + ''; # ''; + } } $result.='
'.&mt('Current Resource').': '. $probTitle.'
 
 Part: '.$display_part.' '. - $resID.'Type: '.$responsetype.'
Part: '.$display_part.' '. + $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'."\n"; return $result,$responseType,$hdgrade,$partlist,$handgrade; @@ -207,9 +209,11 @@ sub get_order { return ($analyze{"$partid.$respid.shown"}); } #--- Clean response type for display -#--- Currently filters option/rank/radiobutton/match/essay response types only. +#--- Currently filters option/rank/radiobutton/match/essay/Task +# response types only. sub cleanRecord { - my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_; + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, + $uname,$udom) = @_; my $grayFont = ''; if ($response =~ /^(option|rank)$/) { my %answer=&Apache::lonnet::str2hash($answer); @@ -290,6 +294,37 @@ sub cleanRecord { my $jme=$record->{$version."resource.$partid.$respid.molecule"}; $result.=&Apache::chemresponse::jme_img($jme,$answer,400); return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
',($version,@matches)); + + + } else { + my $result = + '

' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'

'; + + $result .= ''; + return $result; + } + } return $answer; } @@ -429,7 +464,7 @@ sub canview { #--- Retrieve the grade status of a student for all the parts sub student_gradeStatus { - my ($url,$symb,$udom,$uname,$partlist) = @_; + my ($symb,$udom,$uname,$partlist) = @_; my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); my %partstatus = (); foreach (@$partlist) { @@ -446,7 +481,7 @@ sub student_gradeStatus { # Use by verifyscript and viewgrades # Shows a student's view of problem and submission sub jscriptNform { - my ($url,$symb) = @_; + my ($symb) = @_; my $jscript=''."\n"; $jscript.= '
'."\n". ''."\n". - ''."\n". ''."\n". ''."\n". ''."\n". @@ -467,6 +501,33 @@ sub jscriptNform { return $jscript; } +# Given the score (as a number [0-1] and the weight) what is the final +# point value? This function will round to the nearest tenth, third, +# or quarter if one of those is within the tolerance of .00001. +sub compute_points { + my ($score, $weight) = @_; + + my $tolerance = .00001; + my $points = $score * $weight; + + # Check for nearness to 1/x. + my $check_for_nearness = sub { + my ($factor) = @_; + my $num = ($points * $factor) + $tolerance; + my $floored_num = floor($num); + if ($num - $floored_num < 2 * $tolerance * $factor) { + return $floored_num / $factor; + } + return $points; + }; + + $points = $check_for_nearness->(10); + $points = $check_for_nearness->(3); + $points = $check_for_nearness->(4); + + return $points; +} + #------------------ End of general use routines -------------------- # @@ -528,15 +589,11 @@ sub verifyreceipt { my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $url = $env{'form.url'}; - my $symb = $env{'form.symb'}; - unless ($symb) { - $symb = &Apache::lonnet::symbread($url); - } + my ($symb) = &get_symb($request); my $title.='

Verifying Submission Receipt '. $receipt.'

'."\n". - 'Resource: '.$env{'form.probTitle'}.'

'."\n"; + 'Resource: '.$env{'form.probTitle'}.'

'."\n"; my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); @@ -544,7 +601,7 @@ sub verifyreceipt { my $receiptparts=0; if ($env{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } my $parts=['0']; - if ($receiptparts) { ($parts)=&response_type($url,$symb); } + if ($receiptparts) { ($parts)=&response_type($symb); } foreach (sort { if (lc($$fullname{$a}) ne lc($$fullname{$b})) { @@ -572,7 +629,7 @@ sub verifyreceipt { if ($matches == 0) { $string = $title.'No match found for the above receipt.'; } else { - $string = &jscriptNform($url,$symb).$title. + $string = &jscriptNform($symb).$title. 'The above receipt matches the following student'. ($matches <= 1 ? '.' : 's.')."\n". ''."\n".$contents. '
'."\n". @@ -586,7 +643,7 @@ sub verifyreceipt { $string.='
'."\n"; } - return $string.&show_grading_menu_form($symb,$url); + return $string.&show_grading_menu_form($symb); } #--- This is called by a number of programs. @@ -596,7 +653,7 @@ sub verifyreceipt { sub listStudents { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); + my ($symb) = &get_symb($request); my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; @@ -609,7 +666,7 @@ sub listStudents { my $result='

 '.$viewgrade. ' Submissions for a Student or a Group of Students

'; - my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); + my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); $request->print(< @@ -668,14 +725,20 @@ LISTJAVASCRIPT $gradeTable.=''."\n". ''."\n". ''."\n". - ''."\n". + '
'."\n". + ' Grading Increments: '. + ''."\n". ''."\n". '
'."\n". '
'."\n". ''."\n". ''."\n". - ''."\n". ''."\n". ''."\n"; @@ -704,12 +767,16 @@ LISTJAVASCRIPT while ($loop < 2) { $gradeTable.=' No.  Select '. ''.&nameUserString('header').' Section/Group'; - if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { foreach (sort(@$partlist)) { - my $display_part=&get_display_part((split(/_/))[0],$url,$symb); + my $display_part=&get_display_part((split(/_/))[0],$symb); $gradeTable.=' Part: '.$display_part. ' Status '; } + } elsif ($submitonly eq 'queued') { + $gradeTable.=' '.&mt('Queue Status').' '; } $loop++; # $gradeTable.='' if ($loop%2 ==1); @@ -726,9 +793,21 @@ LISTJAVASCRIPT } (keys(%$fullname))) { my ($uname,$udom) = split(/:/,$student); + my %status = (); - if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { - (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + next if (!defined($queue_status{'gradingqueue'})); + $status{'gradingqueue'} = $queue_status{'gradingqueue'}; + } + + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { + (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); my $submitted = 0; my $graded = 0; my $incorrect = 0; @@ -778,10 +857,14 @@ LISTJAVASCRIPT } if ($ctr%2 ==1) { $gradeTable.='   '; - if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { foreach (@$partlist) { $gradeTable.=' '; } + } elsif ($submitonly eq 'queued') { + $gradeTable.=' '; } $gradeTable.=''; } @@ -798,6 +881,7 @@ LISTJAVASCRIPT my $submissions='submissions'; if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } + if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } $gradeTable='
 '. 'No '.$submissions.' found for this resource for any students. ('.$num_students. ' students checked for '.$submissions.')
'; @@ -805,7 +889,7 @@ LISTJAVASCRIPT } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; } - $gradeTable.=&show_grading_menu_form($symb,$url); + $gradeTable.=&show_grading_menu_form($symb); $request->print($gradeTable); return ''; } @@ -1061,6 +1145,81 @@ sub sub_page_kw_js { my $request = shift; my $iconpath = $request->dir_config('lonIconsURL'); &commonJSfunctions($request); + + my $inner_js_msg_central=< + function checkInput() { + opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); + var nmsg = opener.document.SCORE.savemsgN.value; + var usrctr = document.msgcenter.usrctr.value; + var newval = opener.document.SCORE["newmsg"+usrctr]; + newval.value = opener.checkEntities(document.msgcenter.newmsg.value); + + var msgchk = ""; + if (document.msgcenter.subchk.checked) { + msgchk = "msgsub,"; + } + var includemsg = 0; + for (var i=1; i<=nmsg; i++) { + var opnmsg = opener.document.SCORE["savemsg"+i]; + var frmmsg = document.msgcenter["msg"+i]; + opnmsg.value = opener.checkEntities(frmmsg.value); + var showflg = opener.document.SCORE["shownOnce"+i]; + showflg.value = "1"; + var chkbox = document.msgcenter["msgn"+i]; + if (chkbox.checked) { + msgchk += "savemsg"+i+","; + includemsg = 1; + } + } + if (document.msgcenter.newmsgchk.checked) { + msgchk += "newmsg"+usrctr; + includemsg = 1; + } + imgformname = opener.document.SCORE["mailicon"+usrctr]; + imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); + var includemsg = opener.document.SCORE["includemsg"+usrctr]; + includemsg.value = msgchk; + + self.close() + + } + +INNERJS + + my $inner_js_highlight_central=< + function updateChoice(flag) { + opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr); + opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize); + opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle); + opener.document.SCORE.refresh.value = "on"; + if (opener.document.SCORE.keywords.value!=""){ + opener.document.SCORE.submit(); + } + self.close() + } + +INNERJS + + my $start_page_msg_central = + &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, + {'js_ready' => 1, + 'only_body' => 1, + 'bgcolor' =>'#FFFFFF',}); + my $end_page_msg_central = + &Apache::loncommon::end_page({'js_ready' => 1}); + + + my $start_page_highlight_central = + &Apache::loncommon::start_page('Highlight Central', + $inner_js_highlight_central, + {'js_ready' => 1, + 'only_body' => 1, + 'bgcolor' =>'#FFFFFF',}); + my $end_page_highlight_central = + &Apache::loncommon::end_page({'js_ready' => 1}); + my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); $docopen=~s/^document\.//; $request->print(<"); - pDoc.write("Message Central"); - - pDoc.write(" LISTJAVASCRIPT &commonJSfunctions($request); - my ($symb,$url) = &get_symb_and_url($request); + my ($symb) = &get_symb($request); my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; @@ -3393,7 +3797,7 @@ LISTJAVASCRIPT '>'.$showtitle.''."\n"; $ctr++; } - $result.= ''."
\n"; + $result.= ''."
\n"; $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -3415,16 +3819,18 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n". ''."\n". - ''."\n". ''."\n". ''."
\n"; + $result.=' '.&mt('Use CODE:').' '. + '
'."\n"; + $result.=' 
'."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. + my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. '
'. ''. ''. @@ -3449,12 +3855,12 @@ LISTJAVASCRIPT $studentTable.=($ptr%2 == 0 ? '' : ''); $ptr++; } - $studentTable.='
 No.
  ' if ($ptr%2 == 0); - $studentTable.='
'."\n"; + $studentTable.='  ' if ($ptr%2 == 0); + $studentTable.=''."\n"; $studentTable.=''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; @@ -3473,9 +3879,10 @@ sub getSymbMap { 1,0,1); for my $sequence ($navmap->getById('0.0'), @sequences) { if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { - my $title = $minder.'.'.$sequence->compTitle(); - push @titles, $title; # minder in case two titles are identical - $symbx{$title} = $sequence->symb(); + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); $minder++; } } @@ -3487,7 +3894,7 @@ sub getSymbMap { sub displayPage { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); + my ($symb) = &get_symb($request); my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; @@ -3505,12 +3912,17 @@ sub displayPage { if (!&canview($usec)) { $request->print('Unable to view requested student.('.$env{'form.student'}.')'); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(&show_grading_menu_form($symb)); return; } my $result='

 '.$env{'form.title'}.'

'; $result.='

 Student: '.&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom). '

'."\n"; + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $result.='

 CODE: '.$env{'form.CODE'}.'

'."\n"; + } else { + delete($env{'form.CODE'}); + } &sub_page_js($request); $request->print($result); @@ -3519,7 +3931,7 @@ sub displayPage { my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps if (!$map) { $request->print('Unable to view requested sequence. ('.$resUrl.')'); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(&show_grading_menu_form($symb)); return; } my $iterator = $navmap->getIterator($map->map_start(), @@ -3531,12 +3943,16 @@ sub displayPage { ''."\n". ''."\n". ''."\n". - ''."\n". ''."\n". ''."\n". ''."\n"; - my $checkIcon = ''."\n"; + } + my $checkIcon = ''.&mt('Check Mark').
+	''; $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. @@ -3546,6 +3962,7 @@ sub displayPage { ' Prob. '. ' '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade'; + &Apache::lonxml::clear_problem_counter(); my ($depth,$question,$prob) = (1,1,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" @@ -3553,26 +3970,27 @@ sub displayPage { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''.$prob. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; + my %form = ('CODE' => $env{'form.CODE'},); if ($env{'form.vProb'} eq 'yes' ) { $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, - undef,'both'); + undef,'both',\%form); } else { - my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'}); + my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form); $companswer =~ s|||g; $companswer =~ s|||g; # while ($companswer =~ /()/s) { #\n"); +# $request->print('match='.$1."
\n"); # } # $companswer =~ s||
|g; - $studentTable.=' '.$title.' 
 Correct answer:
'.$companswer; + $studentTable.=' '.$title.' 
 Correct answer:
'.$companswer; } my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); @@ -3615,11 +4033,11 @@ sub displayPage { $curRes = $iterator->next(); } - $studentTable.='
'."\n". + $studentTable.=''."\n". ''. + 'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'. ''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; @@ -3628,6 +4046,7 @@ sub displayPage { sub displaySubByDates { my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $isCODE=0; + my $isTask = ($symb =~/\.task$/); if (exists($record->{'resource.CODE'})) { $isCODE=1; } my $studentTable='
'. ''. @@ -3642,8 +4061,17 @@ sub displaySubByDates { if (!exists($$record{'1:timestamp'})) { return '
 Nothing submitted - no attempts
'; } + + my $interaction; for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = scalar(localtime($$record{$version.':timestamp'})); + if (exists($$record{$version.':resource.0.version'})) { + $interaction = $$record{$version.':resource.0.version'}; + } + + my $where = ($isTask ? "$version:resource.$interaction" + : "$version:resource"); + #&Apache::lonnet::logthis(" got $where"); $studentTable.=''; if ($isCODE) { $studentTable.=''; @@ -3651,40 +4079,57 @@ sub displaySubByDates { my @versionKeys = split(/\:/,$$record{$version.':keys'}); my @displaySub = (); foreach my $partid (@{$parts}) { - my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); + my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) + : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); + + # next if ($$record{"$version:resource.$partid.solved"} eq ''); - my $display_part=&get_display_part($partid,undef,$symb); + my $display_part=&get_display_part($partid,$symb); foreach my $matchKey (@matchKey) { if (exists($$record{$version.':'.$matchKey}) && $$record{$version.':'.$matchKey} ne '') { - my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/); + + my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) + : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); + #&Apache::lonnet::logthis("match $matchKey $responseId (".$$record{$version.':'.$matchKey}); $displaySub[0].='Part: '.$display_part.' '; $displaySub[0].='(ID '. $responseId.') '; - if ($$record{"$version:resource.$partid.tries"} eq '') { + if ($$record{"$where.$partid.tries"} eq '') { $displaySub[0].='Trial not counted'; } else { $displaySub[0].='Trial '. - $$record{"$version:resource.$partid.tries"}; + $$record{"$where.$partid.tries"}; } - my $responseType=$responseType->{$partid}->{$responseId}; + my $responseType=($isTask ? 'Task' + : $responseType->{$partid}->{$responseId}); if (!exists($orders{$partid})) { $orders{$partid}={}; } if (!exists($orders{$partid}->{$responseId})) { $orders{$partid}->{$responseId}= &get_order($partid,$responseId,$symb,$uname,$udom); } $displaySub[0].='  '. - &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'
'; + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'
'; } } - if (exists $$record{"$version:resource.$partid.award"}) { + if (exists($$record{"$where.$partid.checkedin"})) { + $displaySub[1].='Checked in by '. + $$record{"$where.$partid.checkedin"}.' into slot '. + $$record{"$where.$partid.checkedin.slot"}. + '
'; + } + if (exists $$record{"$where.$partid.award"}) { $displaySub[1].='Part: '.$display_part.'  '. - lc($$record{"$version:resource.$partid.award"}).' '. - $mark{$$record{"$version:resource.$partid.solved"}}. + lc($$record{"$where.$partid.award"}).' '. + $mark{$$record{"$where.$partid.solved"}}. '
'; } - if (exists $$record{"$version:resource.$partid.regrader"}) { - $displaySub[2].=$$record{"$version:resource.$partid.regrader"}. + if (exists $$record{"$where.$partid.regrader"}) { + $displaySub[2].=$$record{"$where.$partid.regrader"}. + ' ('.&mt('Part').': '.$display_part.')'; + } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { + $displaySub[2].= + $$record{"$version:resource.$partid.regrader"}. ' ('.&mt('Part').': '.$display_part.')'; } } @@ -3715,7 +4160,7 @@ sub updateGradeByPage { my $usec=$classlist->{$env{'form.student'}}[5]; if (!&canmodify($usec)) { $request->print('Unable to modify requested student.('.$env{'form.student'}.''); - $request->print(&show_grading_menu_form($env{'form.symb'},$env{'form.url'})); + $request->print(&show_grading_menu_form($env{'form.symb'})); return; } my $result='

 '.$env{'form.title'}.'

'; @@ -3729,8 +4174,8 @@ sub updateGradeByPage { my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps if (!$map) { $request->print('Unable to grade requested sequence. ('.$resUrl.')'); - my ($symb,$url)=&get_symb_and_url($request); - $request->print(&show_grading_menu_form($symb,$url)); + my ($symb)=&get_symb($request); + $request->print(&show_grading_menu_form($symb)); return; } my $iterator = $navmap->getIterator($map->map_start(), @@ -3750,12 +4195,12 @@ sub updateGradeByPage { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; my %newrecord=(); @@ -3797,18 +4242,16 @@ sub updateGradeByPage { $aggregateflag = 1; } } - my $display_part=&get_display_part($partid,undef, - $curRes->symb()); + my $display_part=&get_display_part($partid,$curRes->symb()); my $oldstatus = $env{'form.solved'.$question.'_'.$partid}; $displayPts[0].=' Part: '.$display_part.' = '. (($oldstatus eq 'excused') ? 'excused' : $oldpts). - ' 
'; + ' 
'; $displayPts[1].=' Part: '.$display_part.' = '. (($score eq 'excused') ? 'excused' : $newpts). - ' 
'; - + ' 
'; $question++; - next if ($dropMenu eq 'reset status' || ($newpts == $oldpts && $score ne 'excused')); + next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; @@ -3818,9 +4261,24 @@ sub updateGradeByPage { $changeflag++; } if (scalar(keys(%newrecord)) > 0) { + my %record = + &Apache::lonnet::restore($symbx,$env{'request.course.id'}, + $udom,$uname); + + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $newrecord{'resource.CODE'} = $env{'form.CODE'}; + } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { + $newrecord{'resource.CODE'} = ''; + } &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, $udom,$uname); + %record = &Apache::lonnet::restore($symbx, + $env{'request.course.id'}, + $udom,$uname); + &check_and_remove_from_queue($parts,\%record,undef,$symbx, + $cdom,$cnum,$udom,$uname); } + if ($aggregateflag) { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, $env{'course.'.$env{'request.course.id'}.'.domain'}, @@ -3837,7 +4295,7 @@ sub updateGradeByPage { } $studentTable.='
'.$timestamp.''.$record->{$version.':resource.CODE'}.'
'.$prob. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'
 '.$title.' 
'; - $studentTable.=&show_grading_menu_form($env{'form.symb'},$env{'form.url'}); + $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.')); @@ -3855,10 +4313,9 @@ sub updateGradeByPage { #------ start of section for handling grading by page/sequence --------- sub defaultFormData { - my ($symb,$url)=@_; + my ($symb)=@_; return ' '."\n". - ''."\n". ''."\n". ''."\n"; } @@ -3884,7 +4341,7 @@ sub scantron_filenames { my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, - &Apache::loncommon::propath($cdom,$cname)); + &propath($cdom,$cname)); my @possiblenames; foreach my $filename (sort(@files)) { ($filename)=split(/&/,$filename); @@ -3935,24 +4392,24 @@ sub scantron_CODElist { } sub scantron_CODEunique { - my $result=' + my $result=' - - + value="yes" checked="checked" /> Yes + + - '; + value="no" /> No + '; return $result; } sub scantron_selectphase { my ($r,$file2grade) = @_; - my ($symb,$url)=&get_symb_and_url($r); + my ($symb)=&get_symb($r); if (!$symb) {return '';} my $sequence_selector=&getSequenceDropDown($r,$symb); - my $default_form_data=&defaultFormData($symb,$url); - my $grading_menu_button=&show_grading_menu_form($symb,$url); + my $default_form_data=&defaultFormData($symb); + my $grading_menu_button=&show_grading_menu_form($symb); my $file_selector=&scantron_uploads($file2grade); my $format_selector=&scantron_scantab(); my $CODE_selector=&scantron_CODElist(); @@ -3992,7 +4449,8 @@ sub scantron_selectphase { Options:
- +
+ @@ -4023,7 +4481,7 @@ SCANTRONFORM SCANTRONFORM - my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + 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(<
+ $default_form_data @@ -4242,7 +4701,8 @@ sub scantron_parse_scanline { substr($questions,0,$$scantron_config{'Qlength'})=''; if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } if ($$scantron_config{'Qon'} eq 'letter') { - if ($currentquest eq '?') { + if ($currentquest eq '?' + || $currentquest eq '*') { push(@{$record{'scantron.doubleerror'}},$questnum); $record{"scantron.$questnum.answer"}=''; } elsif (!$currentquest @@ -4256,7 +4716,8 @@ sub scantron_parse_scanline { $record{"scantron.$questnum.answer"}=$currentquest; } } elsif ($$scantron_config{'Qon'} eq 'number') { - if ($currentquest eq '?') { + if ($currentquest eq '?' + || $currentquest eq '*') { push(@{$record{'scantron.doubleerror'}},$questnum); $record{"scantron.$questnum.answer"}=''; } elsif (!$currentquest @@ -4267,8 +4728,14 @@ sub scantron_parse_scanline { push(@{$record{"scantron.missingerror"}},$questnum); } } else { - $record{"scantron.$questnum.answer"}= - $alphabet[$currentquest-1]; + # wrap zero back to J + if ($currentquest eq '0') { + $record{"scantron.$questnum.answer"}= + $alphabet[9]; + } else { + $record{"scantron.$questnum.answer"}= + $alphabet[$currentquest-1]; + } } } else { my @array=split($$scantron_config{'Qon'},$currentquest,-1); @@ -4321,8 +4788,15 @@ sub scantron_find_student { sub scantron_filter { my ($curres)=@_; - # randomout is dysfunctional at best for this purpose - if (ref($curres) && $curres->is_problem()) { #&& !$curres->randomout) { + + if (ref($curres) && $curres->is_problem()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } return 1; } return 0; @@ -4391,21 +4865,29 @@ sub reset_skipping_status { &scantron_putfile(undef,$scan_data); } -sub allow_skipping { +sub start_skipping { my ($scan_data,$i)=@_; my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - delete($remembered{$i}); + if ($env{'form.scantron_options_redo'} =~ /^redo_/) { + $remembered{$i}=2; + } else { + $remembered{$i}=1; + } &scan_data($scan_data,'remember_skipping',join(':',%remembered)); } sub should_be_skipped { - my ($scan_data,$i)=@_; + my ($scanlines,$scan_data,$i)=@_; if ($env{'form.scantron_options_redo'} !~ /^redo_/) { # not redoing old skips + if ($scanlines->{'skipped'}[$i]) { return 1; } return 0; } my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - if (exists($remembered{$i})) { return 0; } + + if (exists($remembered{$i}) && $remembered{$i} != 2 ) { + return 0; + } return 1; } @@ -4417,7 +4899,7 @@ sub remember_current_skipped { $to_remember{$i}=1; } } - &Apache::lonnet::logthis('remembering '.join(':',%to_remember)); + &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); &scantron_putfile(undef,$scan_data); } @@ -4433,15 +4915,15 @@ sub scantron_warning_screen { my ($button_text)=@_; my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); - my $CODElist="a"; + my $CODElist; if ($scantron_config{'CODElocation'} && $scantron_config{'CODEstart'} && $scantron_config{'CODElength'}) { $CODElist=$env{'form.scantron_CODElist'}; - if ($CODElist eq '') { $CODElist='None'; } + if ($env{'form.scantron_CODElist'} eq '') { $CODElist='None'; } $CODElist= ''; + $env{'form.scantron_CODElist'}.''; } return (< @@ -4464,9 +4946,9 @@ STUFF sub scantron_do_warning { my ($r)=@_; - my ($symb,$url)=&get_symb_and_url($r); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); $r->print(&scantron_form_start().$default_form_data); if ( $env{'form.selectpage'} eq '' || $env{'form.scantron_selectfile'} eq '' || @@ -4489,7 +4971,7 @@ $warning STUFF } - $r->print("
".&show_grading_menu_form($symb,$url).""); + $r->print("
".&show_grading_menu_form($symb)); return ''; } @@ -4505,15 +4987,16 @@ sub scantron_form_start { + SCANTRONFORM return $result; } sub scantron_validate_file { my ($r) = @_; - my ($symb,$url)=&get_symb_and_url($r); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); # do the detection of only doing skipped records first befroe we delete # them when doing the corrections reset @@ -4522,7 +5005,6 @@ sub scantron_validate_file { } if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { &remember_current_skipped(); - &scantron_remove_file('skipped'); $env{'form.scantron_options_redo'}='redo_skipped_ready'; } @@ -4539,11 +5021,12 @@ sub scantron_validate_file { $r->print("

Gathering neccessary info.

");$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $max_bubble=&scantron_get_maxbubble($r); + my $max_bubble=&scantron_get_maxbubble(); my $result=&scantron_form_start($max_bubble).$default_form_data; $r->print($result); - my @validate_phases=( 'ID', + my @validate_phases=( 'sequence', + 'ID', 'CODE', 'doublebubble', 'missingbubbles'); @@ -4576,13 +5059,19 @@ STUFF $r->print(""); } if ($stop) { - $r->print(''); - $r->print(' using corrected info
'); - $r->print(""); - $r->print(" this scanline saving it for later."); + if ($validate_phases[$currentphase] eq 'sequence') { + $r->print(''); + $r->print(' this error
'); + + $r->print("

Or click the 'Grading Menu' button to start over.

"); + } else { + $r->print(''); + $r->print(' using corrected info
'); + $r->print(""); + $r->print(" this scanline saving it for later."); + } } - $r->print("
".&show_grading_menu_form($symb,$url). - ""); + $r->print("
".&show_grading_menu_form($symb)); return ''; } @@ -4685,8 +5174,8 @@ sub scantron_putfile { sub scantron_get_line { my ($scanlines,$scan_data,$i)=@_; - if (&should_be_skipped($scan_data,$i)) { return undef; } - if ($scanlines->{'skipped'}[$i]) { return undef; } + if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } + #if ($scanlines->{'skipped'}[$i]) { return undef; } if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} return $scanlines->{'orig'}[$i]; } @@ -4706,12 +5195,60 @@ sub scantron_put_line { my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { $scanlines->{'skipped'}[$i]=$newline; - &allow_skipping($scan_data,$i); + &start_skipping($scan_data,$i); return; } $scanlines->{'corrected'}[$i]=$newline; } +sub scantron_clear_skip { + my ($scanlines,$scan_data,$i)=@_; + if (exists($scanlines->{'skipped'}[$i])) { + undef($scanlines->{'skipped'}[$i]); + return 1; + } + return 0; +} + +sub scantron_filter_not_exam { + my ($curres)=@_; + + if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } + return 1; + } + return 0; +} + +sub scantron_validate_sequence { + my ($r,$currentphase) = @_; + + my $navmap=Apache::lonnavmaps::navmap->new(); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($env{'form.selectpage'}); + + my $map=$navmap->getResourceByUrl($sequence); + + $r->print(''); + if ($env{'form.validate_sequence_exam'} ne 'ignore') { + my @resources= + $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); + if (@resources) { + $r->print("

".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."

"); + return (1,$currentphase); + } + } + + return (0,$currentphase+1); +} + sub scantron_validate_ID { my ($r,$currentphase) = @_; @@ -4782,7 +5319,7 @@ sub scantron_get_correction { #the previous one or the current one $r->print("

An error was detected ($error)"); - if ( defined($$scan_record{'scantron.PaperID'}) ) { + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { $r->print(" for PaperID ". $$scan_record{'scantron.PaperID'}." \n"); } else { @@ -4858,13 +5395,15 @@ function change_radio(field) { ENDSCRIPT my $href="/adm/pickcode?". - "form=".&Apache::lonnet::escape("scantronupload"). - "&scantron_format=".&Apache::lonnet::escape($env{'form.scantron_format'}). - "&scantron_CODElist=".&Apache::lonnet::escape($env{'form.scantron_CODElist'}). - "&curCODE=".&Apache::lonnet::escape($$scan_record{'scantron.CODE'}). - "&scantron_selectfile=".&Apache::lonnet::escape($env{'form.scantron_selectfile'}); - $r->print(" Selected CODE is "); - $r->print("\n
"); + "form=".&escape("scantronupload"). + "&scantron_format=".&escape($env{'form.scantron_format'}). + "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). + "&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("\n
"); + } $r->print(" as the CODE."); $r->print("\n

"); } elsif ($error eq 'doublebubble') { @@ -5038,28 +5577,29 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } -sub scantron_get_maxbubble { - my ($r)=@_; +sub scantron_get_maxbubble { if (defined($env{'form.scantron_maxbubble'}) && $env{'form.scantron_maxbubble'}) { return $env{'form.scantron_maxbubble'}; } + my $navmap=Apache::lonnavmaps::navmap->new(); my (undef,undef,$sequence)= &Apache::lonnet::decode_symb($env{'form.selectpage'}); + my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - &Apache::lonnet::delenv('form.counter'); + + &Apache::lonxml::clear_problem_counter(); + foreach my $resource (@resources) { - my $result=&Apache::lonnet::ssi($resource->src().'?symb='.&Apache::lonnet::escape($resource->symb())); + my $result=&Apache::lonnet::ssi($resource->src(), + ('symb' => $resource->symb())); } &Apache::lonnet::delenv('scantron\.'); - my $envfile=$env{'user.environment'}; - $envfile=~/\/([^\/]+)\.id$/; - $envfile=$1; - &Apache::lonnet::transfer_profile_to_env($r->dir_config('lonIDsDir'), - $envfile); - $env{'form.scantron_maxbubble'}=$env{'form.counter'}-1; + $env{'form.scantron_maxbubble'} = + &Apache::lonxml::get_problem_counter()-1; + return $env{'form.scantron_maxbubble'}; } @@ -5098,9 +5638,9 @@ sub scantron_validate_missingbubbles { sub scantron_process_students { my ($r) = @_; my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); - my ($symb,$url)=&get_symb_and_url($r); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); @@ -5153,8 +5693,13 @@ SCANTRONFORM next; } ($uname,$udom)=split(/:/,$uname); - &Apache::lonnet::delenv('form.counter'); + + &Apache::lonxml::clear_problem_counter(); &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) { @@ -5165,8 +5710,9 @@ SCANTRONFORM 'grade_domain' =>$udom, 'grade_courseid'=>$env{'request.course.id'}, 'grade_symb' =>$resource->symb()); - if (exists($scan_record->{'scantron.CODE'}) && - $scan_record->{'scantron.CODE'}) { + if (exists($scan_record->{'scantron.CODE'}) + && + &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) { $form{'CODE'}=$scan_record->{'scantron.CODE'}; } else { $form{'CODE'}=''; @@ -5181,7 +5727,7 @@ SCANTRONFORM $completedstudents{$uname}={'line'=>$line}; if (&Apache::loncommon::connection_aborted($r)) { last; } } continue { - &Apache::lonnet::delenv('form.counter'); + &Apache::lonxml::clear_problem_counter(); &Apache::lonnet::delenv('scantron\.'); } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); @@ -5189,7 +5735,7 @@ SCANTRONFORM # $r->print("

took $lasttime

"); $r->print(""); - $r->print(&show_grading_menu_form($symb,$url)); + $r->print(&show_grading_menu_form($symb)); return ''; } @@ -5201,7 +5747,7 @@ sub scantron_upload_scantron_data { 'coursename'); my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, 'domainid'); - my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + my $default_form_data=&defaultFormData(&get_symb($r,1)); $r->print(< function checkUpload(formname) { @@ -5231,7 +5777,7 @@ UPLOAD sub scantron_upload_scantron_data_save { my($r)=@_; - my ($symb,$url)=&get_symb_and_url($r,1); + my ($symb)=&get_symb($r,1); my $doanotherupload= '
'."\n". ''."\n". @@ -5242,7 +5788,7 @@ sub scantron_upload_scantron_data_save { $env{'form.domainid'}.'_'.$env{'form.courseid'})) { $r->print("You are not allowed to upload Scantron data to the requested course.
"); if ($symb) { - $r->print(&show_grading_menu_form($symb,$url)); + $r->print(&show_grading_menu_form($symb)); } else { $r->print($doanotherupload); } @@ -5287,7 +5833,6 @@ sub scantron_upload_scantron_data_save { sub valid_file { my ($requested_file)=@_; foreach my $filename (sort(&scantron_filenames())) { - &Apache::lonnet::logthis("$requested_file $filename"); if ($requested_file eq $filename) { return 1; } } return 0; @@ -5295,7 +5840,7 @@ sub valid_file { sub scantron_download_scantron_data { my ($r)=@_; - my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + my $default_form_data=&defaultFormData(&get_symb($r,1)); my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $file=$env{'form.scantron_selectfile'}; @@ -5305,7 +5850,7 @@ sub scantron_download_scantron_data { The requested file name was invalid.

ERROR - $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + $r->print(&show_grading_menu_form(&get_symb($r,1))); return; } my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; @@ -5325,7 +5870,7 @@ ERROR Skipped, a file of records that were skipped.

DOWNLOAD - $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + $r->print(&show_grading_menu_form(&get_symb($r,1))); return ''; } @@ -5337,10 +5882,9 @@ DOWNLOAD # #--- Show a Grading Menu button - Calls the next routine --- sub show_grading_menu_form { - my ($symb,$url)=@_; + my ($symb)=@_; my $result.='
'."\n". ''."\n". - ''."\n". ''."\n". ''."\n". ''."\n". @@ -5363,7 +5907,7 @@ sub savedState { #--- Displays the main menu page ------- sub gradingmenu { my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $probTitle = &Apache::lonnet::gettitle($symb); @@ -5405,7 +5949,7 @@ sub gradingmenu { GRADINGMENUJS &commonJSfunctions($request); my $result='

 Manual Grading/View Submission

'; - my ($table,undef,$hdgrade) = &showResourceInfo($url,$probTitle); + my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); $result.=$table; my (undef,$sections) = &getclasslist('all','0'); my $savedState = &savedState(); @@ -5416,7 +5960,6 @@ GRADINGMENUJS $result.=''."\n". ''."\n". - ''."\n". ''."\n". ''."\n". ''."\n". @@ -5424,12 +5967,12 @@ GRADINGMENUJS ''."\n". ''."\n"; - $result.='
List of CODES to validate against:'. - $CODElist.'
'."\n". - '
'."\n". + $result.='
'."\n". + ''."\n". '
'."\n". ' Select a Grading/Viewing Option
'."\n"; - $result.=''; + $result.='
'; $result.=''."\n"; + ($saveSub eq 'all' ? 'selected="on"' : '').' />'.&mt('with any status').''."\n"; $result.=''."\n"; $result.=''."\n"; $result.='
'."\n". ' '.&mt('Select Section').':
'. '
'. '

'. @@ -5473,7 +6018,7 @@ GRADINGMENUJS $result.='
'; - $result.=''; + $result.='
'; $result.=''."\n"; @@ -5487,7 +6032,7 @@ GRADINGMENUJS ''. ' '.&mt('receipt').': '. &Apache::lonnet::recprefix($env{'request.course.id'}). - '-'. + '-'. ''."\n"; } $result.='
'. ''. ' '.&mt('scores from file').'
'. @@ -5509,18 +6054,18 @@ sub reset_perm { sub init_perm { &reset_perm(); - if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}))) { - if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { - $perm{'vgr_section'}=$env{'request.course.sec'}; - } else { - delete($perm{'vgr'}); - } - } - if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$env{'request.course.id'}))) { - if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$env{'request.course.id'}.'/'.$env{'request.course.sec'})) { - $perm{'mgr_section'}=$env{'request.course.sec'}; - } else { - delete($perm{'mgr'}); + foreach my $test_perm ('vgr','mgr','opa') { + + my $scope = $env{'request.course.id'}; + if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) { + + $scope .= '/'.$env{'request.course.sec'}; + if ( $perm{$test_perm}= + &Apache::lonnet::allowed($test_perm,$scope)) { + $perm{$test_perm.'_section'}=$env{'request.course.sec'}; + } else { + delete($perm{$test_perm}); + } } } } @@ -5537,20 +6082,14 @@ sub handler { $request->send_http_header; return '' if $request->header_only; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); - my $url=$env{'form.url'}; - my $symb=$env{'form.symb'}; + my $symb=&get_symb($request,1); my @commands=&Apache::loncommon::get_env_multiple('form.command'); my $command=$commands[0]; if ($#commands > 0) { &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); } - if (!$url) { - my ($temp1,$temp2); - ($temp1,$temp2,$env{'form.url'})=&Apache::lonnet::decode_symb($symb); - $url = $env{'form.url'}; - } - &send_header($request); - if ($url eq '' && $symb eq '' && $command eq '') { + $request->print(&Apache::loncommon::start_page('Grading')); + if ($symb eq '' && $command eq '') { if ($env{'user.adv'}) { if (($env{'form.codeone'}) && ($env{'form.codetwo'}) && ($env{'form.codethree'})) { @@ -5640,27 +6179,10 @@ sub handler { $request->print("Access Denied ($command)"); } } - &send_footer($request); + $request->print(&Apache::loncommon::end_page()); return ''; } -sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); -# $request->print(" -#"); - $request->print(&Apache::loncommon::bodytag('Grading')); - $request->rflush(); -} - -sub send_footer { - my ($request)= @_; - $request->print(''); -} - 1; __END__;