--- loncom/homework/grades.pm 2006/01/31 17:47:53 1.308 +++ loncom/homework/grades.pm 2006/10/13 21:49:28 1.378 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.308 2006/01/31 17:47:53 albertel Exp $ +# $Id: grades.pm,v 1.378 2006/10/13 21:49:28 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,10 +36,14 @@ 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 String::Similarity; +use lib '/home/httpd/lib/perl'; +use LONCAPA; + +use POSIX qw(floor); my %oldessays=(); my %perm=(); @@ -48,7 +52,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 +83,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 +93,7 @@ sub get_symb_and_url { return (); } } - return ($symb,$url); + return ($symb); } #--- Format fullname, username:domain if different for display @@ -106,44 +111,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 +156,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 +208,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 +293,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 +463,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 +480,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 +500,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 +588,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 +600,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 +628,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 +642,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 +652,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 +665,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 +724,20 @@ LISTJAVASCRIPT $gradeTable.=''."\n". ''."\n". ''."\n". - ''."\n". + '
'."\n". + ' Grading Increments: '. + ''."\n". ''."\n". '
'."\n". '
'."\n". ''."\n". ''."\n". - ''."\n". ''."\n". ''."\n"; @@ -708,7 +770,7 @@ LISTJAVASCRIPT && $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 '; } @@ -744,7 +806,7 @@ LISTJAVASCRIPT if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'queued' && $submitonly ne 'all') { - (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); my $submitted = 0; my $graded = 0; my $incorrect = 0; @@ -826,7 +888,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 ''; } @@ -1082,6 +1144,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'}; @@ -3549,7 +3742,7 @@ LISTJAVASCRIPT '>'.$showtitle.''."\n"; $ctr++; } - $result.= ''."
\n"; + $result.= ''."
\n"; $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -3571,7 +3764,6 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n". ''."\n". - ''."\n". ''."\n". ''."
\n"; @@ -3580,7 +3772,7 @@ LISTJAVASCRIPT $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.
'. '
'. ''. ''. @@ -3610,7 +3802,7 @@ LISTJAVASCRIPT $studentTable.=''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; @@ -3643,7 +3835,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'}; @@ -3661,7 +3853,7 @@ 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'}.'

'; @@ -3675,7 +3867,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(), @@ -3687,7 +3879,6 @@ sub displayPage { ''."\n". ''."\n". ''."\n". - ''."\n". ''."\n". ''."\n". ''."\n"; @@ -3702,6 +3893,7 @@ sub displayPage { ''. ''; + &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" @@ -3714,7 +3906,7 @@ sub displayPage { my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=' @@ -4179,7 +4397,7 @@ SCANTRONFORM '; + $env{'form.scantron_CODElist'}.''; } return (< @@ -4620,9 +4861,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 '' || @@ -4645,7 +4886,7 @@ $warning STUFF } - $r->print("
".&show_grading_menu_form($symb,$url).""); + $r->print("
".&show_grading_menu_form($symb)); return ''; } @@ -4661,15 +4902,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 @@ -4678,7 +4920,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'; } @@ -4695,11 +4936,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'); @@ -4732,13 +4974,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 ''; } @@ -4841,8 +5089,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]; } @@ -4862,12 +5110,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) = @_; @@ -4938,7 +5234,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 { @@ -5014,13 +5310,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') { @@ -5194,28 +5492,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'}; } @@ -5254,9 +5553,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(); @@ -5309,8 +5608,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) { @@ -5337,7 +5641,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); @@ -5345,7 +5649,7 @@ SCANTRONFORM # $r->print("

took $lasttime

"); $r->print(""); - $r->print(&show_grading_menu_form($symb,$url)); + $r->print(&show_grading_menu_form($symb)); return ''; } @@ -5357,7 +5661,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) { @@ -5387,7 +5691,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". @@ -5398,7 +5702,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); } @@ -5443,7 +5747,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; @@ -5451,7 +5754,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'}; @@ -5461,7 +5764,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; @@ -5481,7 +5784,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 ''; } @@ -5493,10 +5796,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". @@ -5519,7 +5821,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); @@ -5561,7 +5863,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(); @@ -5572,7 +5874,6 @@ GRADINGMENUJS $result.=''."\n". ''."\n". - ''."\n". ''."\n". ''."\n". ''."\n". @@ -5580,12 +5881,12 @@ GRADINGMENUJS ''."\n". ''."\n"; - $result.='
 No. Prob.  '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade
'.$prob. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'		'; if ($env{'form.vProb'} eq 'yes' ) { $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, @@ -3725,10 +3917,10 @@ sub displayPage { $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); @@ -3775,7 +3967,7 @@ sub displayPage { ''. ''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; @@ -3784,6 +3976,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='
'. ''. @@ -3798,8 +3991,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.=''; @@ -3807,40 +4009,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.')'; } } @@ -3871,7 +4090,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'}.'

'; @@ -3885,8 +4104,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(), @@ -3911,7 +4130,7 @@ sub updateGradeByPage { my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; my %newrecord=(); @@ -3953,15 +4172,14 @@ 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')); @@ -3993,7 +4211,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.')); @@ -4011,10 +4229,9 @@ sub updateGradeByPage { #------ start of section for handling grading by page/sequence --------- sub defaultFormData { - my ($symb,$url)=@_; + my ($symb)=@_; return ' '."\n". - ''."\n". ''."\n". ''."\n"; } @@ -4040,7 +4257,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); @@ -4104,11 +4321,11 @@ sub scantron_CODEunique { 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(); @@ -4148,7 +4365,8 @@ sub scantron_selectphase { 		Options:
- +
+
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(<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; @@ -4547,21 +4780,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; } @@ -4573,7 +4814,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); } @@ -4589,15 +4830,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= '
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').':
'. '
'. '

'. @@ -5631,7 +5932,7 @@ GRADINGMENUJS $result.='		'; - $result.=''; + $result.='
'; $result.=''."\n"; @@ -5645,7 +5946,7 @@ GRADINGMENUJS ''. ' '.&mt('receipt').': '. &Apache::lonnet::recprefix($env{'request.course.id'}). - '-'. + '-'. ''."\n"; } $result.='
'. ''. ' '.&mt('scores from file').'
'. @@ -5695,20 +5996,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'})) { @@ -5798,27 +6093,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__;