--- loncom/homework/grades.pm 2003/10/16 03:51:52 1.130.2.1.2.11 +++ loncom/homework/grades.pm 2005/01/10 18:56:19 1.237 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.130.2.1.2.11 2003/10/16 03:51:52 albertel Exp $ +# $Id: grades.pm,v 1.237 2005/01/10 18:56:19 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,16 +25,6 @@ # # http://www.lon-capa.org/ # -# 2/9,2/13 Guy Albertelli -# 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng -# 8/20 Gerd Kortemeyer -# Year 2002 -# June-August H.K. Ng -# Year 2003 -# February, March H.K. Ng -# July, H. K. Ng -# package Apache::grades; use strict; @@ -48,6 +38,7 @@ use Apache::lonhomework; use Apache::loncoursedata; use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); +use Apache::lonlocal; use String::Similarity; my %oldessays=(); @@ -55,45 +46,49 @@ my %perm=(); # ----- These first few routines are general use routines.---- # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_(\w+)_.*/) { - push(@parts,$key); + my ($url,$symb) = @_; + my $partorder = &Apache::lonnet::metadata($url, 'partorder'); + my @parts; + if ($partorder) { + for my $part (split (/,/,$partorder)) { + if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { + push(@parts, $part); + } + } + } else { + my $metadata = &Apache::lonnet::metadata($url, 'packages'); + foreach (split(/\,/,$metadata)) { + if ($_ =~ /^part_(.*)$/) { + if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { + push(@parts, $1); + } + } + } + } + my @stores; + foreach my $part (@parts) { + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } } - return @parts; + return @stores; } # --- Get the symbolic name of a problem and the url sub get_symb_and_url { - my ($request) = @_; + 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))); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - return ($symb,$url); -} - -# --- Retrieve the fullname for a user. Return lastname, first middle --- -# --- Generation is attached next to the lastname if it exists. --- -sub get_fullname { - my ($uname,$udom) = @_; - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'], - $udom,$uname); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname = &Apache::loncoursedata::ProcessFullName - (@name{qw/lastname generation firstname middlename/}); - } else { - &Apache::lonnet::logthis('grades.pm: no name data for '.$uname. - '@'.$udom.':'.$tmp); + if ($symb eq '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } } - return $fullname; + return ($symb,$url); } #--- Format fullname, username:domain if different for display @@ -114,65 +109,167 @@ 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); + my (@partlist,%handgrade,%responseType); foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_\w+.*/) { + 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} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no'); + $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; + return \@partlist,\%handgrade,\%responseType; } +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 $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= " (id $partID)"; + } else { + $display=$partID; + } + return $display; +} #--- Show resource title #--- and parts and response type sub showResourceInfo { - my ($url,$probTitle) = @_; + my ($url,$probTitle,$checkboxes) = @_; + my $col=3; + if ($checkboxes) { $col=4; } my $result =''. - ''."\n"; - my ($partlist,$handgrade) = &response_type($url); + ''."\n"; + my ($partlist,$handgrade,$responseType) = &response_type($url); my %resptype = (); my $hdgrade='no'; - for (sort keys(%$handgrade)) { - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); - my $partID = (split(/_/))[0]; - $resptype{$partID} = $responsetype; + 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.=''. + $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=""; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$url); + $result.=''. ''; # ''; } $result.='
Current Resource: '.$probTitle.'
'.&mt('Current Resource').': '. + $probTitle.'
Part '.$partID.'
 Part: '.$display_part.' '. + $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'."\n"; - return $result,\%resptype,$hdgrade,$partlist,$handgrade; + return $result,$responseType,$hdgrade,$partlist,$handgrade; } + +sub get_order { + my ($partid,$respid,$symb,$uname,$udom)=@_; + 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)); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + return ($analyze{"$partid.$respid.shown"}); +} #--- Clean response type for display -#--- Currently filters option response type only. +#--- Currently filters option/rank/radiobutton/match/essay response types only. sub cleanRecord { - my ($answer,$response,$symb) = @_; - if ($response eq 'option') { - my (@IDs,@ans); - foreach (split(/\&/,&Apache::lonnet::unescape($answer))) { - my ($optionID,$ans) = split(/=/); - push @IDs,$optionID.''; - push @ans,$ans; + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_; + my $grayFont = ''; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my ($toprow,$bottomrow); + foreach my $foil (@$order) { + if ($grading{$foil} == 1) { + $toprow.=''.$answer{$foil}.' '; + } else { + $toprow.=''.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; } - my $grayFont = ''; return '
'. - ''. - ''. - '
Answer'. - (join '',@ans).'
'.$grayFont.'Option ID'.$grayFont. - (join ''.$grayFont,@IDs).'
'; - } - if ($response eq 'essay') { + 'Answer'.$toprow.''. + ''.$grayFont.'Option ID'. + $grayFont.$bottomrow.''.''; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } else { + $toprow.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $middlerow.''. + ''. + $bottomrow.''.'
Answer
'.$grayFont.'Item ID
'.$grayFont.'Option ID
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct=($order->[0])+1; + for (my $i=1;$i<=$#$order;$i++) { + my $foil=$order->[$i]; + if (exists($answer{$foil})) { + if ($i == $correct) { + $toprow.='true'; + } else { + $toprow.='true'; + } + } else { + $toprow.='false'; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'; + } elsif ($response eq 'essay') { if (! exists ($ENV{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, @@ -185,7 +282,8 @@ sub cleanRecord { $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. } - return '

'.&keywords_highlight($answer).'
'; + $answer =~ s-\n-
-g; + return '

'.&keywords_highlight($answer).'
'; } return $answer; } @@ -218,7 +316,8 @@ sub commonJSfunctions { } } } else { - if (selectOne.selected) return selectOne.value; + // only one value it must be the selected one + return selectOne.value; } } @@ -236,27 +335,36 @@ sub getclasslist { # my %sections; my %fullnames; - foreach (keys(%$classlist)) { - # the following undefs are for 'domain', and 'username' respectively. - my (undef,undef,$end,$start,$id,$section,$fullname,$status)= - @{$classlist->{$_}}; + foreach my $student (keys(%$classlist)) { + my $end = + $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; + my $start = + $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; + my $id = + $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; + my $section = + $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $fullname = + $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; + my $status = + $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; # filter students according to status selected if ($filterlist && $ENV{'form.Status'} ne 'Any') { if ($ENV{'form.Status'} ne $status) { - delete ($classlist->{$_}); + delete ($classlist->{$student}); next; } } - $section = ($section ne '' ? $section : 'no'); + $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { if ($getsec eq 'all' || $getsec eq $section) { $sections{$section}++; - $fullnames{$_}=$fullname; + $fullnames{$student}=$fullname; } else { - delete($classlist->{$_}); + delete($classlist->{$student}); } } else { - delete($classlist->{$_}); + delete($classlist->{$student}); } } my %seen = (); @@ -398,7 +506,7 @@ sub verifyreceipt { my $request = shift; my $courseid = $ENV{'request.course.id'}; - my $receipt = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. + my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $ENV{'form.receipt'}; $receipt =~ s/[^\-\d]//g; my $url = $ENV{'form.url'}; @@ -413,18 +521,27 @@ sub verifyreceipt { my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); - + + my $receiptparts=0; + if ($ENV{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } + my $parts=['0']; + if ($receiptparts) { ($parts)=&response_type($url,$symb); } foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { my ($uname,$udom)=split(/\:/); - if ($receipt eq - &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { - $contents.=' '."\n". - ''.$$fullname{$_}.' '."\n". - ' '.$uname.' '. - ' '.$udom.' '."\n"; - - $matches++; + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.=' '."\n". + ''.$$fullname{$_}.' '."\n". + ' '.$uname.' '. + ' '.$udom.' '; + if ($receiptparts) { + $contents.=' '.$part.' '; + } + $contents.=''."\n"; + + $matches++; + } } } if ($matches == 0) { @@ -437,8 +554,11 @@ sub verifyreceipt { ''."\n". ''."\n". ''."\n". - ''."\n". - $contents. + ''; + if ($receiptparts) { + $string.=''; + } + $string.=''."\n".$contents. '
 Fullname  Username  Domain 
 Domain  Problem Part 
'."\n"; } return $string.&show_grading_menu_form($symb,$url); @@ -464,8 +584,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'}); - $result.=$table; + my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'},($ENV{'form.showgrading'} eq 'yes')); $request->print(< @@ -505,10 +624,14 @@ LISTJAVASCRIPT my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; - my $gradeTable='
'."\n". - ' View Problem Text: no '."\n". + my $gradeTable=''. + "\n".$table. + ' View Problem Text: no '."\n". ' one student '."\n". ' all students
'."\n". + ' View Answer: no '."\n". + ' one student '."\n". + ' all students
'."\n". ' Submissions: '."\n"; if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { $gradeTable.=' essay part only'."\n"; @@ -517,8 +640,8 @@ LISTJAVASCRIPT my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'}; $ENV{'form.Status'} = $saveStatus; - $gradeTable.=' last sub only'."\n". - ' last sub & parts info'."\n". + $gradeTable.=' last submission only'."\n". + ' last submission & parts info'."\n". ' by dates and submissions'."\n". ' all details'."\n". ''."\n". @@ -544,7 +667,7 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; - + $gradeTable.='Check For Plagiarism'; my (undef, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; @@ -554,7 +677,9 @@ LISTJAVASCRIPT ''; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort(@$partlist)) { - $gradeTable.=''; + my $display_part=&get_display_part((split(/_/))[0],$url,$symb); + $gradeTable.=''; } } $loop++; @@ -568,18 +693,26 @@ LISTJAVASCRIPT my %status = (); if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); - my $statusflg = ''; + my $submitted = 0; + my $graded = 0; foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 1 if ($status{$_} !~ /^correct/); + my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { - $statusflg = ''; + $submitted = 0; + my ($part)=split(/\./,$partid); $gradeTable.=''; } } - next if ($statusflg eq '' && $submitonly eq 'yes'); + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$graded && ($submitonly eq 'graded' || + $submitonly eq 'incorrect')); } $ctr++; @@ -619,9 +752,12 @@ LISTJAVASCRIPT if ($num_students eq 0) { $gradeTable='
 There are no students currently enrolled.'; } else { + my $submissions='submissions'; + if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } + if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } $gradeTable='
 '. - 'No submissions found for this resource for any students. ('.$num_students. - ' checked for submissions
'; + 'No '.$submissions.' found for this resource for any students. ('.$num_students. + ' students checked for '.$submissions.')
'; } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; @@ -636,8 +772,7 @@ LISTJAVASCRIPT sub processGroup { my ($request) = shift; my $ctr = 0; - my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} - : ($ENV{'form.stuinfo'})); + my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); my $total = scalar(@stuchecked)-1; foreach (@stuchecked) { @@ -837,6 +972,8 @@ sub sub_page_kw_js { my $request = shift; my $iconpath = $request->dir_config('lonIconsURL'); &commonJSfunctions($request); + my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); + $docopen=~s/^document\.//; $request->print(< @@ -946,10 +1083,10 @@ sub sub_page_kw_js { var ypos = (screen.height-height)/2-30; ypos = (ypos < 0) ? '0' : ypos; - pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); + pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); pWin.focus(); pDoc = pWin.document; - pDoc.open('text/html','replace'); + pDoc.$docopen; pDoc.write(""); pDoc.write("Message Central"); @@ -1077,10 +1214,10 @@ sub sub_page_kw_js { var ypos = (screen.height-330)/2-30; ypos = (ypos < 0) ? '0' : ypos; - hwdWin = window.open('', 'KeywordHighlightCentral', 'toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); + hwdWin = window.open('', 'KeywordHighlightCentral', 'resizeable=yes,toolbar=no,location=no,scrollbars=no,width=400,height=300,screenx='+xpos+',screeny='+ypos); hwdWin.focus(); var hDoc = hwdWin.document; - hDoc.open('text/html','replace'); + hDoc.$docopen; hDoc.write(""); hDoc.write("Highlight Central"); @@ -1151,16 +1288,17 @@ sub gradeBox { '' : $$record{'resource.'.$partid.'.awarded'}*$wgt); my $result=''."\n"; + my $display_part=&get_display_part($partid,undef,$symb); $result.='
'.&nameUserString('header').' Part '.(split(/_/))[0].' Status  Part: '.$display_part. + ' Status 
'. - 'Part '.$partid.' Points: '."\n"; + 'Part: '.$display_part.' Points: '."\n"; my $ctr = 0; $result.=''."\n"; # display radio buttons in a nice table 10 across while ($ctr<=$wgt) { - $result.= '\n"; + ($score eq $ctr ? 'checked':'').' /> '.$ctr."\n"; $result.=(($ctr+1)%10 == 0 ? '' : ''); $ctr++; } @@ -1195,27 +1333,46 @@ sub gradeBox { } sub show_problem { - my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_; - my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $ENV{'request.course.id'}); + my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_; + my $rendered; + if ($mode eq 'both' or $mode eq 'text') { + $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $ENV{'request.course.id'}); + } if ($removeform) { $rendered=~s|||g; $rendered=~s|||g; $rendered=~s|name="submit"|name="would_have_been_submit"|g; } - my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $ENV{'request.course.id'}); + my $companswer; + if ($mode eq 'both' or $mode eq 'answer') { + $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $ENV{'request.course.id'}); + } if ($removeform) { $companswer=~s|||g; $companswer=~s|||g; - $rendered=~s|name="submit"|name="would_have_been_submit"|g; + $companswer=~s|name="submit"|name="would_have_been_submit"|g; } my $result.='
'.$ctr."
'; $result.=''; - $result.='' if ($viewon); - $result.=''; + } + if ($mode eq 'both') { + $result.='
View of the problem - '.$ENV{'form.fullname'}. - '
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; + if ($viewon) { + $result.='
'; + if ($mode eq 'both' or $mode eq 'text') { + $result.='View of the problem - '; + } else { + $result.='Correct answer: '; + } + $result.=$ENV{'form.fullname'}.'
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + } elsif ($mode eq 'text') { + $result.='
'.$rendered; + } elsif ($mode eq 'answer') { + $result.='
'.$companswer; + } $result.='
'; $result.='

'; return $result; @@ -1229,19 +1386,22 @@ sub submission { my ($uname,$udom) = ($ENV{'form.student'},$ENV{'form.userdom'}); $udom = ($udom eq '' ? $ENV{'user.domain'} : $udom); #has form.userdom changed for a student? my $usec = &Apache::lonnet::getsection($udom,$uname,$ENV{'request.course.id'}); - $ENV{'form.fullname'} = &get_fullname ($uname,$udom) if $ENV{'form.fullname'} eq ''; + $ENV{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $ENV{'form.fullname'} eq ''; my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } if (!&canview($usec)) { $request->print('Unable to view requested student.('. - $uname.$udom.$usec.$ENV{'request.course.id'}.')'); + $uname.'@'.$udom.' in section '.$usec.' in course id '. + $ENV{'request.course.id'}.')'); $request->print(&show_grading_menu_form($symb,$url)); return; } - $ENV{'form.lastSub'} = ($ENV{'form.lastSub'} eq '' ? 'datesub' : $ENV{'form.lastSub'}); + if (!$ENV{'form.lastSub'}) { $ENV{'form.lastSub'} = 'datesub'; } + if (!$ENV{'form.vProb'}) { $ENV{'form.vProb'} = 'yes'; } + if (!$ENV{'form.vAns'}) { $ENV{'form.vAns'} = 'yes'; } my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); my $checkIcon = ''; @@ -1264,8 +1424,16 @@ sub submission { # option to display problem, only once else it cause problems # with the form later since the problem has a form. - if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) { - $request->print(&show_problem($request,$symb,$uname,$udom,0,1)); + if ($ENV{'form.vProb'} eq 'yes' or $ENV{'form.vAns'} eq 'yes') { + my $mode; + if ($ENV{'form.vProb'} eq 'yes' && $ENV{'form.vAns'} eq 'yes') { + $mode='both'; + } elsif ($ENV{'form.vProb'} eq 'yes') { + $mode='text'; + } elsif ($ENV{'form.vAns'} eq 'yes') { + $mode='answer'; + } + $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); } # kwclr is the only variable that is guaranteed to be non blank @@ -1300,6 +1468,7 @@ sub submission { ''."\n". ''."\n". ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -1314,6 +1483,9 @@ sub submission { ''."\n". ''."\n". ''."\n"); + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + $request->print(''."\n"); + } } my ($cts,$prnmsg) = (1,''); @@ -1350,13 +1522,22 @@ KEYWORDS } } - if ($ENV{'form.vProb'} eq 'all') { + if ($ENV{'form.vProb'} eq 'all' or $ENV{'form.vAns'} eq 'all') { $request->print('


') if ($counter > 0); - $request->print(&show_problem($request,$symb,$uname,$udom,1,1)); + my $mode; + if ($ENV{'form.vProb'} eq 'all' && $ENV{'form.vAns'} eq 'all') { + $mode='both'; + } elsif ($ENV{'form.vProb'} eq 'all' ) { + $mode='text'; + } elsif ($ENV{'form.vAns'} eq 'all') { + $mode='answer'; + } + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode)); } + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my ($partlist,$handgrade) = &response_type($url,$symb); + my ($partlist,$handgrade,$responseType) = &response_type($url,$symb); # Display student info $request->print(($counter == 0 ? '' : '
')); @@ -1403,8 +1584,10 @@ KEYWORDS $result.=$$fullname{$_}.'     '; } $result.='
'."\n"; + my ($part)=split(/\./,$_); $result.=''."\n"; + '" value="'.$part.':'.(join ':',@goodcollaborators).'" />'. + "\n"; } if (scalar(@badcollaborators) > 0) { $result.='\n"; + if ($$timestamp eq '') { + $lastsubonly.='\n"; - if ($$timestamp eq '') { - $lastsubonly.='
'; @@ -1430,71 +1613,98 @@ KEYWORDS # (3) Last submission plus the parts info # (4) The whole record for this student if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { - if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) { - my $submitby=''. - 'Collaborative submission by: '. - ''. - $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.''; - $request->print($submitby); + my ($string,$timestamp)= &get_last_submission(\%record); + my $lastsubonly=''. + ($$timestamp eq '' ? '' : 'Date Submitted: '. + $$timestamp)."
'.$$string[0]; } else { - my ($string,$timestamp)= &get_last_submission (\%record); - my $lastsubonly=''. - ($$timestamp eq '' ? '' : 'Date Submitted: '. - $$timestamp)."
'.$$string[0]; - } else { - for my $part (sort keys(%$handgrade)) { - my ($responsetype,$foo) = split(/:/,$$handgrade{$part}); - my ($partid,$respid) = split(/_/,$part); - if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { - $lastsubonly.='
Part '. - $partid.' ( ID '.$respid. - ' )   '. - 'Nothing submitted - no attempts

'; - } else { - foreach (@$string) { - my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/; - if ($part eq ($partid.'_'.$respid)) { - my ($ressub,$subval) = split(/:/,$_,2); - # Similarity check - my $similar=''; - my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); - if ($osim) { - $osim=int($osim*100.0); - $similar='

Essay is '.$osim. - '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). - '

'. - &keywords_highlight($oessay).'
'; - } - $lastsubonly.='
Part '. - $partid.' ( ID '.$respid. - ' )   '. - ($record{"resource.$partid.$respid.uploadedurl"}? - ' File uploaded by student '. - 'Like all files provided by users, '. - 'this file may contain virusses
':''). - 'Submitted Answer: '. - &cleanRecord($subval,$responsetype,$symb). - '

'.$similar."\n" - if ($ENV{'form.lastSub'} eq 'lastonly' || - ($ENV{'form.lastSub'} eq 'hdgrade' && - $$handgrade{$part} =~ /:yes$/)); + my %seenparts; + for my $part (sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/,$part); + my $display_part=&get_display_part($partid,$url,$symb); + if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { + if (exists($seenparts{$partid})) { next; } + $seenparts{$partid}=1; + my $submitby='Part: '.$display_part. + ' Collaborative submission by: '. + ''. + $$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'
'; + $request->print($submitby); + next; + } + my $responsetype = $responseType->{$partid}->{$respid}; + if (!exists($record{"resource.$partid.$respid.submission"})) { + $lastsubonly.='
Part: '. + $display_part.' ( ID '.$respid. + ' )   '. + 'Nothing submitted - no attempts

'; + next; + } + foreach (@$string) { + my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; + if ($part ne ($partid.'_'.$respid)) { next; } + my ($ressub,$subval) = split(/:/,$_,2); + # Similarity check + my $similar=''; + if($ENV{'form.checkPlag'}){ + my ($oname,$odom,$ocrsid,$oessay,$osim)= + &most_similar($uname,$udom,$subval); + if ($osim) { + $osim=int($osim*100.0); + $similar="

Essay". + " is $osim% similar to an essay by ". + &Apache::loncommon::plainname($oname,$odom). + '

'. + &keywords_highlight($oessay). + '
'; + } + } + my $order=&get_order($partid,$respid,$symb,$uname,$udom); + if ($ENV{'form.lastSub'} eq 'lastonly' || + ($ENV{'form.lastSub'} eq 'hdgrade' && + $$handgrade{$part} eq 'yes')) { + my $display_part=&get_display_part($partid,$url,$symb); + $lastsubonly.='
Part: '. + $display_part.' ( ID '.$respid. + ' )   '; + my @files; + if ($record{"resource.$partid.$respid.portfiles"}) { + my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; + foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) { + push(@files,$file_url.$file); + + &Apache::lonnet::logthis("found a portfolio file".$record{"resource.$partid.$respid.portfiles"}); + &Apache::lonnet::logthis("uploaded URL file".$record{"resource.$partid.$respid.uploadedurl"}); } } + if ($record{"resource.$partid.$respid.uploadedurl"}) { + push(@files,$record{"resource.$partid.$respid.uploadedurl"}); + } + if (@files) { + $lastsubonly.='
Like all files provided by users, this file may contain virusses
'; + foreach my $file (@files) { + &Apache::lonnet::allowuploaded('/adm/grades',$file); + $lastsubonly.='
'.$file.''; + } + $lastsubonly.='
'; + } + $lastsubonly.='Submitted Answer: '. + &cleanRecord($subval,$responsetype,$symb,$partid, + $respid,\%record,$order); + if ($similar) {$lastsubonly.="

$similar\n";} } } } - $lastsubonly.='
'."\n"; - $request->print($lastsubonly); } + $lastsubonly.='
'."\n"; + $request->print($lastsubonly); } elsif ($ENV{'form.lastSub'} eq 'datesub') { my (undef,$responseType,undef,$parts) = &showResourceInfo($url); - $request->print(&displaySubByDates(\$symb,\%record,$parts,$responseType,$checkIcon)); + $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); } elsif ($ENV{'form.lastSub'} =~ /^(last|all)$/) { $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, $ENV{'request.course.id'}, @@ -1510,12 +1720,15 @@ KEYWORDS my $toGrade.='  '."\n" if (&canmodify($usec)); - $toGrade.='
'."\n"; - $toGrade.=&show_grading_menu_form($symb,$url) - if (($ENV{'form.command'} eq 'submission') || - ($ENV{'form.command'} eq 'processGroup' && $counter == $total)); - $request = print($toGrade); + $toGrade.='
'."\n"; + if (($ENV{'form.command'} eq 'submission') || + ($ENV{'form.command'} eq 'processGroup' && $counter == $total)) { + $toGrade.=''.&show_grading_menu_form($symb,$url) + } + $request->print($toGrade); return; + } else { + $request->print(''."\n"); } # essay grading message center @@ -1667,18 +1880,21 @@ sub processHandGrade { $ENV{'form.msgsub'},$message); } if ($ENV{'form.collaborator'.$ctr}) { - my (@collaborators) = split(/:/,$ENV{'form.collaborator'.$ctr}); - foreach (@collaborators) { - my ($errorflag,$pts,$wgt) = - &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,$ENV{'form.unamedom'.$ctr}); - if ($errorflag eq 'not_allowed') { - $request->print("Not allowed to modify grades for $_:$udom"); - next; - } else { - if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg ($_,$udom, - $ENV{'form.msgsub'}, - $message); + my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); + foreach my $collabstr (@collabstrs) { + my ($part,@collaborators) = split(/:/,$collabstr); + foreach (@collaborators) { + my ($errorflag,$pts,$wgt) = + &saveHandGrade($request,$url,$symb,$_,$udom,$ctr, + $ENV{'form.unamedom'.$ctr},$part); + if ($errorflag eq 'not_allowed') { + $request->print("Not allowed to modify grades for $_:$udom"); + next; + } else { + if ($message ne '') { + $msgstatus = &Apache::lonmsg::user_normal_msg($_,$udom,$ENV{'form.msgsub'},$message); + } + } } } @@ -1782,15 +1998,28 @@ sub processHandGrade { } $ctr = 0; @parsedlist = reverse @parsedlist if ($button eq 'Previous'); + my ($partlist) = &response_type($url); foreach my $student (@parsedlist) { + my $submitonly=$ENV{'form.submitonly'}; my ($uname,$udom) = split(/:/,$student); - if ($ENV{'form.submitonly'} eq 'yes') { - my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my $statusflg = ''; - foreach (split(/:/,$ENV{'form.gradePartRespid'})){ - $statusflg = 1 if (exists ($record{'resource.'.$_.'.submission'})); + if ($submitonly =~ /^(yes|graded|incorrect)$/) { +# my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + my $submitted = 0; + my $graded = 1; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 0 if ($status{$_} =~ /^correct/); + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } } - next if ($statusflg eq ''); + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$graded && ($submitonly eq 'graded' || + $submitonly eq 'incorrect')); } push @nextlist,$student if ($ctr < $ntstu); last if ($ctr == $ntstu); @@ -1820,7 +2049,7 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { - my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter) = @_; + my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; my $usec = &Apache::lonnet::getsection($domain,$stuname, $ENV{'request.course.id'}); if (!&canmodify($usec)) { return('not_allowed'); } @@ -1828,6 +2057,8 @@ sub saveHandGrade { my %newrecord = (); my ($pts,$wgt) = ('',''); foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { + #collaborator may vary for different parts + if ($submitter && $_ ne $part) { next; } my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_}; if ($dropMenu eq 'excused') { if ($record{'resource.'.$_.'.solved'} ne 'excused') { @@ -1839,36 +2070,46 @@ sub saveHandGrade { } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$_.'.solved'})) { #don't bother if no old records -> no attempts - $newrecord{'resource.'.$_.'.tries'} = 0; - $newrecord{'resource.'.$_.'.solved'} = ''; - $newrecord{'resource.'.$_.'.award'} = ''; - $newrecord{'resource.'.$_.'.awarded'} = 0; - $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + foreach my $key (keys (%record)) { + if ($key=~/^resource\.\Q$_\E\./) { $newrecord{$key} = ''; } + } + $newrecord{'resource.'.$_.'.regrader'}= + "$ENV{'user.name'}:$ENV{'user.domain'}"; } elsif ($dropMenu eq '') { $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? $ENV{'form.GD_BOX'.$newflg.'_'.$_} : $ENV{'form.RADVAL'.$newflg.'_'.$_}); - return 'no_score' if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq ''); + if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq '') { + next; + } $wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : $ENV{'form.WGT'.$newflg.'_'.$_}; my $partial= $pts/$wgt; - next if ($partial eq $record{'resource.'.$_.'.awarded'}); #do not update score for part if not changed. - $newrecord{'resource.'.$_.'.awarded'} = $partial - if ($record{'resource.'.$_.'.awarded'} ne $partial); + if ($partial eq $record{'resource.'.$_.'.awarded'}) { + #do not update score for part if not changed. + next; + } + if ($record{'resource.'.$_.'.awarded'} ne $partial) { + $newrecord{'resource.'.$_.'.awarded'} = $partial; + } my $reckey = 'resource.'.$_.'.solved'; if ($partial == 0) { - $newrecord{$reckey} = 'incorrect_by_override' - if ($record{$reckey} ne 'incorrect_by_override'); + if ($record{$reckey} ne 'incorrect_by_override') { + $newrecord{$reckey} = 'incorrect_by_override'; + } } else { - $newrecord{$reckey} = 'correct_by_override' - if ($record{$reckey} ne 'correct_by_override'); + if ($record{$reckey} ne 'correct_by_override') { + $newrecord{$reckey} = 'correct_by_override'; + } + } + if ($submitter && + ($record{'resource.'.$_.'.submitted_by'} ne $submitter)) { + $newrecord{'resource.'.$_.'.submitted_by'} = $submitter; } - $newrecord{'resource.'.$_.'.submitted_by'} = $submitter - if ($submitter && ($record{'resource.'.$_.'.submitted_by'} ne $submitter)); - $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + $newrecord{'resource.'.$_.'.regrader'}= + "$ENV{'user.name'}:$ENV{'user.domain'}"; } } - if (scalar(keys(%newrecord)) > 0) { &Apache::lonnet::cstore(\%newrecord,$symb, $ENV{'request.course.id'},$domain,$stuname); @@ -2051,8 +2292,14 @@ sub viewgrades { &viewgrades_js($request); my ($symb,$url) = ($ENV{'form.symb'},$ENV{'form.url'}); - my $result='

Manual Grading

'; + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + my $result='

'.&mt('Manual Grading').'

'; $result.='Current Resource: '.$ENV{'form.probTitle'}.''."\n"; #view individual student submission form - called using Javascript viewOneStudent @@ -2071,7 +2318,7 @@ sub viewgrades { my $sectionClass; if ($ENV{'form.section'} eq 'all') { $sectionClass='Class '; - } elsif ($ENV{'form.section'} eq 'no') { + } elsif ($ENV{'form.section'} eq 'none') { $sectionClass='Students in no Section '; } else { $sectionClass='Students in Section '.$ENV{'form.section'}.''; @@ -2090,7 +2337,7 @@ sub viewgrades { my ($partid,$respid) = split (/_/,$_,2); next if $seen{$partid}; $seen{$partid}++; - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); + my $handgrade=$$handgrade{$_}; my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); $weight{$partid} = $wgt eq '' ? '1' : $wgt; @@ -2098,7 +2345,8 @@ sub viewgrades { $ctsparts.'" value="'.$partid.'" />'."\n"; $result.=''."\n"; - $result.='Part '.$partid.'   Point: '; + my $display_part=&get_display_part($partid,$url,$symb); + $result.='Part: '.$display_part.'   Point: '; $result.=''; my $ctr = 0; while ($ctr<=$weight{$partid}) { # display radio buttons in a nice table 10 across @@ -2132,19 +2380,22 @@ sub viewgrades { $result.= '
'."\n". ''. '\n"; - my (@parts) = sort(&getpartlist($url)); + my (@parts) = sort(&getpartlist($url,$symb)); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); $display =~ s|^Number of Attempts|Tries
|; # makes the column narrower if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } + my ($partid) = &split_part_type($part); + my $display_part=&get_display_part($partid,$url,$symb); if ($display =~ /^Partial Credit Factor/) { - my ($partid) = &split_part_type($part); - $result.=''."\n"; + $result.=''."\n"; next; + } else { + $display =~s/\[Part: \Q$partid\E\]/Part:<\/b> $display_part/; } $display =~ s|Problem Status|Grade Status
|; - $result.=''."\n"; + $result.=''."\n"; } $result.=''; @@ -2153,9 +2404,6 @@ sub viewgrades { my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1'); my $ctr = 0; foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { - my $uname = $_; - $uname=~s/:/_/; - $result.=''."\n"; $ctr++; $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, $_,$$fullname{$_},\@parts,\%weight,$ctr); @@ -2179,18 +2427,21 @@ sub viewstudentgrade { my ($uname,$udom) = split(/:/,$student); $student=~s/:/_/; my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); - my $result=''."\n"; foreach my $apart (@$parts) { my ($part,$type) = &split_part_type($apart); my $score=$record{"resource.$part.$type"}; + $result.=''."\n"; @@ -2199,7 +2450,7 @@ sub viewstudentgrade { $status = 'nothing' if ($status eq ''); $result.=''."\n"; - $result.=''."\n"; } @@ -2249,7 +2500,7 @@ sub editgrades { my %columns = (); my ($i,$ctr,$count,$rec_update) = (0,0,0,0); - my (@parts) = sort(&getpartlist($url)); + my (@parts) = sort(&getpartlist($url,$symb)); my $header; while ($ctr < $ENV{'form.totalparts'}) { my $partid = $ENV{'form.partid_'.$ctr}; @@ -2274,9 +2525,10 @@ sub editgrades { } } foreach my $partid (@partid) { + my $display_part=&get_display_part($partid,$url,$symb); $result .= ''; + '" align="center">Part: '.$display_part. + ' (Weight = '.$weight{$partid}.')'; } $result .= ''; @@ -2327,18 +2579,17 @@ sub editgrades { $newrecord{'resource.'.$_.'.awarded'} = 0; $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; $updateflag = 1; + } elsif (!($old_part eq $partial && $old_score eq $score)) { + $updateflag = 1; + $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; + $newrecord{'resource.'.$_.'.solved'} = $score; + $rec_update++; } $line .= ''. ''; - if (!($old_part eq $partial && $old_score eq $score)) { - $updateflag = 1; - $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; - $newrecord{'resource.'.$_.'.solved'} = $score; - $rec_update++; - } my $partid=$_; foreach my $stores (@parts) { @@ -2371,7 +2622,7 @@ sub editgrades { if ($noupdate) { # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; my $numcols=scalar(@partid)*4+2; - $result .= ''.$noupdate; + $result .= ''.$noupdate; } $result .= '
 No. '.&nameUserString('header')."Score Part '.$partid.'
(weight = '. - $weight{$partid}.')		Score Part: '.$display_part. + '
(weight = '.$weight{$partid}.')		'.$display.''.$display.'
'.$ctr.'  '. + my $result='
'. + ''. + "\n".$ctr.'  '. ''.$fullname.' '. '('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).')'; if ($type eq 'awarded') { my $pts = $score eq '' ? '' : $score*$$weight{$part}; $result.=''."\n"; - $result.=' '. "\n"; - $result.='Part '.$partid. - ' (Weight = '.$weight{$partid}.')
'.$old_aw.' '.$awarded. ($score eq 'excused' ? $score : '').' 
No Changes Occurred For the Students Below
No Changes Occurred For the Students Below
'."\n". &show_grading_menu_form ($symb,$url); @@ -2515,8 +2766,8 @@ ENDPICK } sub csvupload_fields { - my ($url) = @_; - my (@parts) = &getpartlist($url); + my ($url,$symb) = @_; + my (@parts) = &getpartlist($url,$symb); my @fields=(['username','Student Username'],['domain','Student Domain']); foreach my $part (sort(@parts)) { my @datum; @@ -2599,7 +2850,7 @@ sub csvuploadmap { &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url); + my @fields=&csvupload_fields($url,$symb); if ($ENV{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); @@ -2649,7 +2900,9 @@ sub csvuploadassign { foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); my $username=$entries{$fields{'username'}}; + $username=~s/\s//g; my $domain=$entries{$fields{'domain'}}; + $domain=~s/\s//g; if (!exists($$classlist{"$username:$domain"})) { push(@skipped,"$username:$domain"); next; @@ -2726,7 +2979,9 @@ LISTJAVASCRIPT $result.='
'."\n"; $result.=' Problems from: '."\n". ''."\n"; - $result.=' View Problems Text: no '."\n". + $result.=' View Problems Text: no '."\n". ' yes '."
\n"; $result.=' Submission Details: '. @@ -2798,9 +3053,7 @@ LISTJAVASCRIPT sub getSymbMap { my ($request) = @_; - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db'); -# $navmap->init(); + my $navmap = Apache::lonnavmaps::navmap->new(); my %symbx = (); my @titles = (); @@ -2816,8 +3069,6 @@ sub getSymbMap { $minder++; } } - - $navmap->untieHashes(); return \@titles,\%symbx; } @@ -2834,6 +3085,14 @@ sub displayPage { my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); my ($uname,$udom) = split(/:/,$ENV{'form.student'}); my $usec=$classlist->{$ENV{'form.student'}}[5]; + + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + if (!&canview($usec)) { $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); $request->print(&show_grading_menu_form($symb,$url)); @@ -2845,9 +3104,8 @@ sub displayPage { &sub_page_js($request); $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps my $iterator = $navmap->getIterator($map->map_start(), @@ -2874,22 +3132,23 @@ sub displayPage { ' Prob. '. ' '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade'; - my ($depth,$question) = (1,1); + my ($depth,$question,$prob) = (1,1,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem()) { + if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''.$question. + $studentTable.=''.$prob. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; - if ($ENV{'form.vProb'} eq 'yes') { - $studentTable.=&show_problem($request,$symbx,$uname,$udom,1); + if ($ENV{'form.vProb'} eq 'yes' ) { + $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, + undef,'both'); } else { my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'}); $companswer =~ s|||g; @@ -2910,9 +3169,16 @@ sub displayPage { } else { my %responseType = (); foreach my $partid (@{$parts}) { - $responseType{$partid} = $curRes->responseType($partid); + my @responseIds =$curRes->responseIds($partid); + my @responseType =$curRes->responseType($partid); + my %responseIds; + for (my $i=0;$i<=$#responseIds;$i++) { + $responseIds{$responseIds[$i]}=$responseType[$i]; + } + $responseType{$partid} = \%responseIds; } - $studentTable.= &displaySubByDates(\$symbx,\%record,$parts,\%responseType,$checkIcon); + $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom); + } } elsif ($ENV{'form.lastSub'} eq 'all') { my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); @@ -2927,6 +3193,7 @@ sub displayPage { $studentTable.=''."\n"; $question++; } + $prob++; } $studentTable.=''; @@ -2934,8 +3201,6 @@ sub displayPage { $curRes = $iterator->next(); } - $navmap->untieHashes(); - $studentTable.=''."\n". ''. @@ -2947,41 +3212,78 @@ sub displayPage { } sub displaySubByDates { - my ($symbx,$record,$parts,$responseType,$checkIcon) = @_; + my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; + my $isCODE=0; + if (exists($record->{'resource.CODE'})) { $isCODE=1; } my $studentTable='
'. ''. ''. + ($isCODE?'':''). ''. ''; my ($version); my %mark; + my %orders; $mark{'correct_by_student'} = $checkIcon; - return '
 Nothing submitted - no attempts
' - if (!exists($$record{'1:timestamp'})); + if (!exists($$record{'1:timestamp'})) { + return '
 Nothing submitted - no attempts
'; + } for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = scalar(localtime($$record{$version.':timestamp'})); $studentTable.=''; + if ($isCODE) { + $studentTable.=''; + } my @versionKeys = split(/\:/,$$record{$version.':keys'}); my @displaySub = (); foreach my $partid (@{$parts}) { - my @matchKey = grep /^resource\.$partid\..*?\.submission$/,@versionKeys; + my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); # next if ($$record{"$version:resource.$partid.solved"} eq ''); - $displaySub[0].=(exists $$record{$version.':'.$matchKey[0]}) ? - 'Part '.$partid.' '. - ($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial not counted' : - 'Trial '.$$record{"$version:resource.$partid.tries"}).'  '. - &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid},$$symbx).'
' : ''; - $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ? - 'Part '.$partid.'  '. - lc($$record{"$version:resource.$partid.award"}).' '. - $mark{$$record{"$version:resource.$partid.solved"}}.'
' : ''; - $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ? - $$record{"$version:resource.$partid.regrader"}.' (Part: '.$partid.')' : ''; - } - $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ? - $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info - $studentTable.=''; + my $display_part=&get_display_part($partid,undef,$symb); + foreach my $matchKey (@matchKey) { + if (exists($$record{$version.':'.$matchKey}) && + $$record{$version.':'.$matchKey} ne '') { + my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/); + $displaySub[0].='Part: '.$display_part.' '; + $displaySub[0].='(ID '. + $responseId.') '; + if ($$record{"$version:resource.$partid.tries"} eq '') { + $displaySub[0].='Trial not counted'; + } else { + $displaySub[0].='Trial '. + $$record{"$version:resource.$partid.tries"}; + } + my $responseType=$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:").'
'; + } + } + if (exists $$record{"$version:resource.$partid.award"}) { + $displaySub[1].='Part: '.$display_part.'  '. + lc($$record{"$version:resource.$partid.award"}).' '. + $mark{$$record{"$version:resource.$partid.solved"}}. + '
'; + } + if (exists $$record{"$version:resource.$partid.regrader"}) { + $displaySub[2].=$$record{"$version:resource.$partid.regrader"}. + ' ('.&mt('Part').': '.$display_part.')'; + } + } + # needed because old essay regrader has not parts info + if (exists $$record{"$version:resource.regrader"}) { + $displaySub[2].=$$record{"$version:resource.regrader"}; + } + $studentTable.=''; + } $studentTable.='
Date/TimeCODESubmissionStatus 
'.$timestamp.''.$record->{$version.':resource.CODE'}.''.$displaySub[0].' '.$displaySub[1]. - ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).' 
'.$displaySub[0].' '.$displaySub[1]; + if ($displaySub[2]) { + $studentTable.='Manually graded by '.$displaySub[2]; + } + $studentTable.=' 
'; return $studentTable; @@ -3008,9 +3310,8 @@ sub updateGradeByPage { $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps my $iterator = $navmap->getIterator($map->map_start(), @@ -3025,7 +3326,7 @@ sub updateGradeByPage { $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" - my ($depth,$question,$changeflag)= (1,1,0); + my ($depth,$question,$prob,$changeflag)= (1,1,1,0); while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } @@ -3034,7 +3335,7 @@ sub updateGradeByPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''.$question. + $studentTable.=''.$prob. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=' '.$title.' '; @@ -3067,12 +3368,13 @@ sub updateGradeByPage { $changeflag++; $newpts = ''; } - + my $display_part=&get_display_part($partid,undef, + $curRes->symb()); my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid}; - $displayPts[0].=' Part '.$partid.' = '. + $displayPts[0].=' Part: '.$display_part.' = '. (($oldstatus eq 'excused') ? 'excused' : $oldpts). ' 
'; - $displayPts[1].=' Part '.$partid.' = '. + $displayPts[1].=' Part: '.$display_part.' = '. (($score eq 'excused') ? 'excused' : $newpts). ' 
'; @@ -3095,12 +3397,11 @@ sub updateGradeByPage { ''.$displayPts[1].''. ''; + $prob++; } $curRes = $iterator->next(); } - $navmap->untieHashes(); - $studentTable.=''; $studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'}); my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' : @@ -3132,7 +3433,7 @@ sub getSequenceDropDown { my ($request,$symb)=@_; my $result=''; +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, - &propath($cdom,$cname)); - foreach my $filename (@files) { + &Apache::loncommon::propath($cdom,$cname)); + my @possiblenames; + foreach my $filename (sort(@files)) { ($filename)=split(/&/,$filename); if ($filename!~/^scantron_orig_/) { next ; } $filename=~s/^scantron_orig_//; - $result.="\n"; + push(@possiblenames,$filename); + } + return @possiblenames; +} + +sub scantron_uploads { + my ($file2grade) = @_; + my $result= '"; return $result; @@ -3176,6 +3475,7 @@ sub scantron_uploads { sub scantron_scantab { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result=''.$namechoice.''; + return $namechoice; +} + +sub scantron_CODEunique { + my $result=' + Yes + + + No + '; + return $result; +} + sub scantron_selectphase { - my ($r) = @_; + my ($r,$file2grade) = @_; my ($symb,$url)=&get_symb_and_url($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 $file_selector=&scantron_uploads(); + my $file_selector=&scantron_uploads($file2grade); my $format_selector=&scantron_scantab(); + my $CODE_selector=&scantron_CODElist(); + my $CODE_unique=&scantron_CODEunique(); my $result; #FIXME allow instructor to be able to download the scantron file # and to upload it, $result.= < - - $default_form_data - +
+ + + +SCANTRONFORM + + $r->print($result); + + if (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'}) || + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + + $r->print(< + +SCANTRONFORM + } + $r->print(< +
+ + + +SCANTRONFORM + + $r->print(< - - $grading_menu_button SCANTRONFORM - return $result; + return } sub get_scantron_config { @@ -3291,7 +3700,7 @@ sub scantron_fixup_scanline { my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; if ($field eq 'ID') { if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { - return ($line,1,'New value to large'); + return ($line,1,'New value too large'); } if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', @@ -3303,6 +3712,21 @@ sub scantron_fixup_scanline { &scan_data($scan_data,"$whichline.user", $args->{'username'}.':'.$args->{'domain'}); } + } elsif ($field eq 'CODE') { + if ($args->{'CODE_ignore_dup'}) { + &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); + } + &scan_data($scan_data,"$whichline.useCODE",'1'); + if ($args->{'CODE'} ne 'use_unfound') { + if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { + return ($line,1,'New CODE value too large'); + } + if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { + $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); + } + substr($line,$$scantron_config{'CODEstart'}-1, + $$scantron_config{'CODElength'})=$args->{'CODE'}; + } } elsif ($field eq 'answer') { my $length=$scantron_config->{'Qlength'}; my $off=$scantron_config->{'Qoff'}; @@ -3333,14 +3757,21 @@ sub scan_data { } sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data)=@_; + my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_; my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); if ($$scantron_config{'CODElocation'} ne 0) { if ($$scantron_config{'CODElocation'} < 0) { - $record{'scantron.CODE'}=substr($data,$$scantron_config{'CODEstart'}-1, + $record{'scantron.CODE'}=substr($data, + $$scantron_config{'CODEstart'}-1, $$scantron_config{'CODElength'}); + if (&scan_data($scan_data,"$whichline.useCODE")) { + $record{'scantron.useCODE'}=1; + } + if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { + $record{'scantron.CODE_ignore_dup'}=1; + } } else { #FIXME interpret first N questions } @@ -3356,6 +3787,8 @@ sub scantron_parse_scanline { $record{'scantron.LastName'}= substr($data,$$scantron_config{'LastName'}-1, $$scantron_config{'LastNamelength'}); + if ($justHeader) { return \%record; } + my @alphabet=('A'..'Z'); my $questnum=0; while ($questions) { @@ -3368,20 +3801,20 @@ sub scantron_parse_scanline { $record{"scantron.$questnum.answer"}=''; if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); - } + } } else { $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])]; } - if (scalar(@array) gt 2) { - push(@{$record{'scantron.doubleerror'}},$questnum); - my @ans=@array; - my $i=length($ans[0]);shift(@ans); + if (scalar(@array) gt 2) { + push(@{$record{'scantron.doubleerror'}},$questnum); + my @ans=@array; + my $i=length($ans[0]);shift(@ans); while ($#ans) { - $i+=length($ans[0])+1; - $record{"scantron.$questnum.answer"}.=$alphabet[$i]; - shift(@ans); - } - } + $i+=length($ans[0])+1; + $record{"scantron.$questnum.answer"}.=$alphabet[$i]; + shift(@ans); + } + } } $record{'scantron.maxquest'}=$questnum; return \%record; @@ -3399,19 +3832,20 @@ sub scantron_find_student { my ($scantron_record,$scan_data,$idmap,$line)=@_; my $scanID=$$scantron_record{'scantron.ID'}; if ($scanID =~ /^\s*$/) { - return &scan_data($scan_data,"$line.user"); + return &scan_data($scan_data,"$line.user"); } foreach my $id (keys(%$idmap)) { - if (lc($id) eq lc($scanID)) { - return $$idmap{$id}; - } + if (lc($id) eq lc($scanID)) { + return $$idmap{$id}; + } } return undef; } sub scantron_filter { my ($curres)=@_; - if (ref($curres) && $curres->is_problem() && !$curres->randomout) { + # randomout is dysfunctional at best for this purpose + if (ref($curres) && $curres->is_problem()) { #&& !$curres->randomout) { return 1; } return 0; @@ -3423,7 +3857,7 @@ sub scantron_process_corrections { my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my $which=$ENV{'form.scantron_line'}; - my $line=&scantron_get_line($scanlines,$which); + my $line=&scantron_get_line($scanlines,$scan_data,$which); my ($skip,$err,$errmsg); if ($ENV{'form.scantron_skip_record'}) { $skip=1; @@ -3436,6 +3870,26 @@ sub scantron_process_corrections { 'ID',{'newid'=>$newid, 'username'=>$ENV{'form.scantron_username'}, 'domain'=>$ENV{'form.scantron_domain'}}); + } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { + my $resolution=$ENV{'form.scantron_CODE_resolution'}; + my $newCODE; + my %args; + if ($resolution eq 'use_unfound') { + $newCODE='use_unfound'; + } elsif ($resolution eq 'use_found') { + $newCODE=$ENV{'form.scantron_CODE_selectedvalue'}; + } elsif ($resolution eq 'use_typed') { + $newCODE=$ENV{'form.scantron_CODE_newvalue'}; + } elsif ($resolution =~ /^use_closest_(\d+)/) { + $newCODE=$ENV{"form.scantron_CODE_closest_$1"}; + } + if ($ENV{'form.scantron_corrections'} eq 'duplicateCODE') { + $args{'CODE_ignore_dup'}=1; + } + $args{'CODE'}=$newCODE; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'CODE',\%args); } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { foreach my $question (split(',',$ENV{'form.scantron_questions'})) { ($line,$err,$errmsg)= @@ -3449,31 +3903,155 @@ sub scantron_process_corrections { if ($err) { $r->print("Unable to accept last correction, an error occurred :$errmsg:"); } else { - &scantron_put_line($scanlines,$which,$line,$skip); + &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); &scantron_putfile($scanlines,$scan_data); } } +sub reset_skipping_status { + my ($scanlines,$scan_data)=&scantron_getfile(); + &scan_data($scan_data,'remember_skipping',undef,1); + &scantron_putfile(undef,$scan_data); +} + +sub allow_skipping { + my ($scan_data,$i)=@_; + my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); + delete($remembered{$i}); + &scan_data($scan_data,'remember_skipping',join(':',%remembered)); +} + +sub should_be_skipped { + my ($scan_data,$i)=@_; + if ($ENV{'form.scantron_options_redo'} !~ /^redo_/) { + # not redoing old skips + return 0; + } + my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); + if (exists($remembered{$i})) { return 0; } + return 1; +} + +sub remember_current_skipped { + my ($scanlines,$scan_data)=&scantron_getfile(); + my %to_remember; + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + if ($scanlines->{'skipped'}[$i]) { + $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); +} + +sub check_for_error { + my ($r,$result)=@_; + if ($result ne 'ok' && $result ne 'not_found' ) { + $r->print("An error occured ($result) when trying to Remove the existing corrections."); + } +} + +sub scantron_warning_screen { + my ($button_text)=@_; + my $title=&Apache::lonnet::gettitle($ENV{'form.selectpage'}); + return (< +Please double check the information + below before clicking on '$button_text' +

+
+ + $default_form_data - - + + + + + + + + + + + + + + + + +
-  Specify file location and which Folder/Sequence to grade + +  Specify file and which Folder/Sequence to grade
- Sequence to grade: $sequence_selector - Sequence to grade: $sequence_selector
Filename of scoring office file: $file_selector
Format of data file: $format_selector
Saved CODEs to validate against: $CODE_selector
Each CODE is only to be used once: $CODE_unique
Options: - Filename of scoring office file: $file_selector + Do only previously skipped records
+ Remove all exisiting corrections
+ +
+
+ + +  Specify a Scantron data file to upload. + +SCANTRONFORM + my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + my $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cnum= $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + $r->print(< + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("Please use the browse button to select a file from your local directory."); + return false; + } + formname.submit(); + } + + +
+ $default_form_data + + + + File to upload: +
+ + +UPLOAD + + $r->print(<
- Format of data file: $format_selector -
- - Last line to expect an answer on: - -
+ + + + + + + + + + + +
+  Download a scoring office file +
Filename of scoring office file: $file_selector
+ +
+
+ + +
Sequence To be Graded:$title
Data File that will be used:$ENV{'form.scantron_selectfile'}
+ +
+

If this information is correct, please click on '$button_text'.

+

If something is incorrect, please click the 'Grading Menu' button to start over.

+ +
+STUFF +} + +sub scantron_do_warning { + my ($r)=@_; + my ($symb,$url)=&get_symb_and_url($r); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb,$url); + $r->print(&scantron_form_start().$default_form_data); + if ( $ENV{'form.selectpage'} eq '' || + $ENV{'form.scantron_selectfile'} eq '' || + $ENV{'form.scantron_format'} eq '' ) { + $r->print("

You have forgetten to specify some information. Please go Back and try again.

"); + if ( $ENV{'form.selectpage'} eq '') { + $r->print('

You have not selected a Sequence to grade

'); + } + if ( $ENV{'form.scantron_selectfile'} eq '') { + $r->print('

You have not selected a file that contains the student\'s response data.

'); + } + if ( $ENV{'form.scantron_format'} eq '') { + $r->print('

You have not selected a the format of the student\'s response data.

'); + } + } else { + my $warning=&scantron_warning_screen('Validate Records'); + $r->print(< + +STUFF + } + $r->print("
".&show_grading_menu_form($symb,$url).""); + return ''; +} + +sub scantron_form_start { + my ($max_bubble)=@_; + my $result= < + + + + + + + + +SCANTRONFORM + return $result; +} sub scantron_validate_file { my ($r) = @_; my ($symb,$url)=&get_symb_and_url($r); if (!$symb) {return '';} my $default_form_data=&defaultFormData($symb,$url); + + # do the detection of only doing skipped records first befroe we delete + # them when doing the corrections reset + if ($ENV{'form.scantron_options_redo'} ne 'redo_skipped_ready') { + &reset_skipping_status(); + } + if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped') { + &remember_current_skipped(); + &scantron_remove_file('skipped'); + $ENV{'form.scantron_options_redo'}='redo_skipped_ready'; + } + + if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') { + &check_for_error($r,&scantron_remove_file('corrected')); + &check_for_error($r,&scantron_remove_file('skipped')); + &check_for_error($r,&scantron_remove_scan_data()); + $ENV{'form.scantron_options_ignore'}='done'; + } if ($ENV{'form.scantron_corrections'}) { &scantron_process_corrections($r); } + $r->print("

Gathering neccessary info.

");$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= < - - - - - $default_form_data -SCANTRONFORM + my $max_bubble=&scantron_get_maxbubble($r); + my $result=&scantron_form_start($max_bubble).$default_form_data; $r->print($result); my @validate_phases=( 'ID', @@ -3481,14 +4059,10 @@ SCANTRONFORM 'doublebubble', 'missingbubbles'); if (!$ENV{'form.validatepass'}) { - $ENV{'form.valiadatepass'} = 0; + $ENV{'form.validatepass'} = 0; } - my $currentphase=$ENV{'form.valiadatepass'}; + my $currentphase=$ENV{'form.validatepass'}; - if ($ENV{'form.scantron_selectfile'}=~m-^/-) { - #first pass copy file to classdir - - } my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { $r->print("

Validating ".$validate_phases[$currentphase]."

"); @@ -3500,9 +4074,14 @@ SCANTRONFORM } } if (!$stop) { - $r->print("Validation process complete.
"); - $r->print(''); - $r->print(''); + my $warning=&scantron_warning_screen('Start Grading'); + $r->print(< +$warning + + +STUFF + } else { $r->print(''); $r->print(""); @@ -3518,18 +4097,49 @@ SCANTRONFORM return ''; } +sub scantron_remove_file { + my ($which)=@_; + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $file='scantron_'; + if ($which eq 'corrected' || $which eq 'skipped') { + $file.=$which.'_'; + } else { + return 'refused'; + } + $file.=$ENV{'form.scantron_selectfile'}; + return &Apache::lonnet::removeuserfile($cname,$cdom,$file); +} + +sub scantron_remove_scan_data { + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); + my @todelete; + my $filename=$ENV{'form.scantron_selectfile'}; + foreach my $key (@keys) { + if ($key=~/^\Q$filename\E_/) { + if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped_ready' && + $key=~/remember_skipping/) { + next; + } + push(@todelete,$key); + } + } + my $result; + if (@todelete) { + $result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname); + } + return $result; +} + sub scantron_getfile { - #FIXME really would prefer a scantron directory but tokenwrapper - # doesn't allow access to subdirs of userfiles + #FIXME really would prefer a scantron directory my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; my $lines; $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. 'scantron_orig_'.$ENV{'form.scantron_selectfile'}); - if ($lines eq '-1') { - #FIXME need to actually replicate file to course space - #FIXME when replicating strip CRLF to LF or CR to LF - } my %scanlines; $scanlines{'orig'}=[(split("\n",$lines,-1))]; my $temp=$scanlines{'orig'}; @@ -3549,7 +4159,7 @@ sub scantron_getfile { } else { $scanlines{'skipped'}=[(split("\n",$lines,-1))]; } - my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname); + my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname); if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } my %scan_data = @tmp; return (\%scanlines,\%scan_data); @@ -3567,34 +4177,48 @@ sub lonnet_putfile { sub scantron_putfile { my ($scanlines,$scan_data) = @_; - #FIXME really would prefer a scantron directory but tokenwrapper - # doesn't allow access to subdirs of userfiles + #FIXME really would prefer a scantron directory my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $prefix='scantron_'; + if ($scanlines) { + my $prefix='scantron_'; # no need to update orig, shouldn't change # &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'. # $ENV{'form.scantron_selectfile'}); - &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), - $prefix.'corrected_'. - $ENV{'form.scantron_selectfile'}); - &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), - $prefix.'skipped_'. - $ENV{'form.scantron_selectfile'}); - &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname); + &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), + $prefix.'corrected_'. + $ENV{'form.scantron_selectfile'}); + &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), + $prefix.'skipped_'. + $ENV{'form.scantron_selectfile'}); + } + &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); } sub scantron_get_line { - my ($scanlines,$i)=@_; - if ($scanlines->{'skipped'}[$i]) {return undef;} + my ($scanlines,$scan_data,$i)=@_; + if (&should_be_skipped($scan_data,$i)) { return undef; } + if ($scanlines->{'skipped'}[$i]) { return undef; } if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} return $scanlines->{'orig'}[$i]; } +sub get_todo_count { + my ($scanlines,$scan_data)=@_; + my $count=0; + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + $count++; + } + return $count; +} + sub scantron_put_line { - my ($scanlines,$i,$newline,$skip)=@_; + my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { $scanlines->{'skipped'}[$i]=$newline; + &allow_skipping($scan_data,$i); return; } $scanlines->{'corrected'}[$i]=$newline; @@ -3613,7 +4237,7 @@ sub scantron_validate_ID { my %found=('ids'=>{},'usernames'=>{}); for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); + my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); @@ -3627,13 +4251,13 @@ sub scantron_validate_ID { if ($found{'ids'}{$found}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$found); - return(1); + return(1,$currentphase); } elsif ($found{'usernames'}{$username}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } - #FIXME store away line we prviously saw the ID on to use above + #FIXME store away line we previously saw the ID on to use above $found{'ids'}{$found}++; $found{'usernames'}{$username}++; } else { @@ -3643,18 +4267,18 @@ sub scantron_validate_ID { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } elsif (!defined($username)) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } $found{'usernames'}{$username}++; } else { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } } } @@ -3669,7 +4293,7 @@ sub scantron_get_correction { #to show both the current line and the previous one and allow skipping #the previous one or the current one - $r->print("

An error was detected ($error) "); + $r->print("

An error was detected ($error)"); if ( defined($$scan_record{'scantron.PaperID'}) ) { $r->print(" for PaperID ". $$scan_record{'scantron.PaperID'}." \n"); @@ -3680,7 +4304,7 @@ sub scantron_get_correction { $r->print(''."\n"); $r->print(''."\n"); if ($error =~ /ID$/) { - if ($error eq 'unknownID') { + if ($error eq 'incorrectID') { $r->print("The encoded ID is not in the classlist

\n"); } elsif ($error eq 'duplicateID') { $r->print("The encoded ID has also been used by a previous paper $arg

\n"); @@ -3698,11 +4322,61 @@ sub scantron_get_correction { 'scantron_username','scantron_domain')); $r->print(": "); $r->print("\n@". - &Apache::loncommon::select_dom_form(undef,'scantron_domain')); + &Apache::loncommon::select_dom_form($ENV{'request.role.domain'},'scantron_domain')); $r->print(''); + } elsif ($error =~ /CODE$/) { + if ($error eq 'incorrectCODE') { + $r->print("

The encoded CODE is not in the list of possible CODEs

\n"); + } elsif ($error eq 'duplicateCODE') { + $r->print("

The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique

\n"); + } + $r->print("

The CODE on the form is '". + $$scan_record{'scantron.CODE'}."'
\n"); + $r->print("

The ID on the form is ". + $$scan_record{'scantron.ID'}."
\n"); + $r->print("The name on the paper is ". + $$scan_record{'scantron.LastName'}.",". + $$scan_record{'scantron.FirstName'}."

"); + $r->print("

How should I handle this?
\n"); + $r->print("\n
"); + my $i=0; + if ($error eq 'incorrectCODE') { + my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); + foreach my $testcode (@{$closest}) { + my $checked=''; + if (!$i) { $checked=' checked="on" '; } + $r->print(" Use the similar CODE ".$testcode." instead."); + $r->print("\n
"); + $i++; + } + } + my $checked; if (!$i) { $checked=' checked="on" '; } + $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error."); + $r->print("\n
"); + + $r->print(< +function change_radio(field) { + var slct=document.scantronupload.scantron_CODE_resolution; + var i; + for (i=0;i +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(" Select a CODE from the list of all CODEs and use it. Selected CODE is "); + $r->print("\n
"); + $r->print(" Use as the CODE."); + $r->print("\n

"); } elsif ($error eq 'doublebubble') { -#FIXME Need to print out who this is along with the paper info $r->print("

There have been multiple bubbles scanned for a some question(s)

\n"); $r->print(''); @@ -3749,9 +4423,84 @@ sub scantron_bubble_selector { $r->print(''); } +sub num_matches { + my ($orig,$code) = @_; + my @code=split(//,$code); + my @orig=split(//,$orig); + my $same=0; + for (my $i=0;$i{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $CODE=$$scan_record{'scantron.CODE'}; + my $error=0; + if (!&Apache::lonnet::validCODE($CODE)) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectCODE',\%allcodes); + return(1,$currentphase); + } + if (%allcodes && !exists($allcodes{$CODE}) + && !$$scan_record{'scantron.useCODE'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectCODE',\%allcodes); + return(1,$currentphase); + } + if (exists($usedCODEs{$CODE}) + && $ENV{'form.scantron_CODEunique'} eq 'yes' + && !$$scan_record{'scantron.CODE_ignore_dup'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateCODE',$usedCODEs{$CODE}); + return(1,$currentphase); + } + push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); + } return (0,$currentphase+1); } @@ -3765,7 +4514,7 @@ sub scantron_validate_doublebubble { my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); + my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); @@ -3778,6 +4527,31 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } +sub scantron_get_maxbubble { + my ($r)=@_; + 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'); + foreach my $resource (@resources) { + my $result=&Apache::lonnet::ssi($resource->src().'?symb='.&Apache::lonnet::escape($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; + return $ENV{'form.scantron_maxbubble'}; +} + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -3787,10 +4561,10 @@ sub scantron_validate_missingbubbles { #get scantron line setup my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); - my $max_bubble=$ENV{'form.scantron_maxbubble'}; + my $max_bubble=&scantron_get_maxbubble(); if (!$max_bubble) { $max_bubble=2**31; } for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); + my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); @@ -3812,7 +4586,7 @@ sub scantron_validate_missingbubbles { sub scantron_process_students { my ($r) = @_; - my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'}); + my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'}); my ($symb,$url)=&get_symb_and_url($r); if (!$symb) {return '';} my $default_form_data=&defaultFormData($symb,$url); @@ -3821,7 +4595,7 @@ sub scantron_process_students { my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); - my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1); + my $navmap=Apache::lonnavmaps::navmap->new(); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); # $r->print("geto ".scalar(@resources)."
"); @@ -3835,101 +4609,75 @@ SCANTRONFORM my @delayqueue; my %completedstudents; + my $count=&get_todo_count($scanlines,$scan_data); my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', - 'Scantron Progress',$scanlines->{'count'}); + 'Scantron Progress',$count, + 'inline',undef,'scantronupload'); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); my $start=&Time::HiRes::time(); my $i=-1; - my ($uname,$udom); + my ($uname,$udom,$started); while ($i<$scanlines->{'count'}) { - ($uname,$udom)=('',''); - $i++; - my $line=&scantron_get_line($scanlines,$i); -# $r->print('
line is'.$line.'
'); - if ($line=~/^[\s\cz]*$/) { next; } - my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); - unless ($uname=&scantron_find_student($scan_record,$scan_data, - \%idmap,$i)) { - &scantron_add_delay(\@delayqueue,$line, - 'Unable to find a student that matches',1); - next; - } - if (exists $completedstudents{$uname}) { - &scantron_add_delay(\@delayqueue,$line, - 'Student '.$uname.' has multiple sheets',2); - next; - } -# $r->print('
doing studnet'.$uname.'
'); - ($uname,$udom)=split(/:/,$uname); - &Apache::lonnet::delenv('form.counter'); - &Apache::lonnet::appenv(%$scan_record); -# &Apache::lonhomework::showhash(%ENV); -# $Apache::lonxml::debug=1; -# &Apache::lonxml::debug("line is $line"); + ($uname,$udom)=('',''); + $i++; + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + if ($started) { + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student'); + } + $started=1; + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + unless ($uname=&scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { + &scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches',1); + next; + } + if (exists $completedstudents{$uname}) { + &scantron_add_delay(\@delayqueue,$line, + 'Student '.$uname.' has multiple sheets',2); + next; + } + ($uname,$udom)=split(/:/,$uname); + &Apache::lonnet::delenv('form.counter'); + &Apache::lonnet::appenv(%$scan_record); - my $i=0; + my $i=0; foreach my $resource (@resources) { $i++; - my $result=&Apache::lonnet::ssi($resource->src(), - ('submitted' =>'scantron', - 'grade_target' =>'grade', - 'grade_username'=>$uname, - 'grade_domain' =>$udom, - 'grade_courseid'=>$ENV{'request.course.id'}, - 'grade_symb' =>$resource->symb())); -# my %score=&Apache::lonnet::restore($resource->symb(), -# $ENV{'request.course.id'}, -# $udom,$uname); -# foreach my $part ($resource->{PARTS}) { -# if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { -# $studentcorrect++; -# $totalcorrect++; -# } else { -# $studentincorrect++; -# $totalincorrect++; -# } -# } -# $r->print('
'.
-#		      $resource->symb().'-'.
-#		      $resource->src().'-'.'
result is'.$result); -# &Apache::lonhomework::showhash(%score); - # if ($i eq 3) {last;} + 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'}) && + $scan_record->{'scantron.CODE'}) { + $form{'CODE'}=$scan_record->{'scantron.CODE'}; + } else { + $form{'CODE'}=''; + } + my $result=&Apache::lonnet::ssi($resource->src(),%form); + if ($result ne '') { + &Apache::lonnet::logthis("scantron grading error -> $result"); + &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $ENV{'request.course.id'} url ".$resource->src()); + } + if (&Apache::loncommon::connection_aborted($r)) { last; } } $completedstudents{$uname}={'line'=>$line}; + if (&Apache::loncommon::connection_aborted($r)) { last; } } continue { &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::delenv('scantron\.'); - &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,$uname); - #last; - #FIXME - #get iterator for $sequence - #foreach question 'submit' the students answer to the server - # through grade target { - # generate data to pass back that includes grade recevied - #} } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); - my $lasttime = &Time::HiRes::time()-$start; - #$r->print("

took $lasttime

"); +# my $lasttime = &Time::HiRes::time()-$start; +# $r->print("

took $lasttime

"); - #$Apache::lonxml::debug=0; - foreach my $delay (@delayqueue) { - #FIXME - #print out each delayed student with interface to select how - # to repair student provided info - #Expected errors include - # 1 bad/no stuid/username - # 2 invalid bubblings - - } - #FIXME - # if delay queue exists 2 submits one to process delayed students one - # to ignore delayed students, possibly saving the delay queue for later - - $navmap->untieHashes(); - $r->print("

Done

"); + $r->print(""); $r->print(&show_grading_menu_form($symb,$url)); return ''; } @@ -3938,9 +4686,11 @@ sub scantron_upload_scantron_data { my ($r)=@_; $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'})); my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', - 'domainid'); + 'domainid', + 'coursename'); my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, 'domainid'); + my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); $r->print(< function checkUpload(formname) { @@ -3953,12 +4703,15 @@ sub scantron_upload_scantron_data {
-Course: -Domain: $domsel $select_link -
+$default_form_data + + + + + + +
$select_link
Course ID:
Course Name:
Domain: $domsel
File to upload:
-File to upload: -
UPLOAD @@ -3967,7 +4720,25 @@ UPLOAD sub scantron_upload_scantron_data_save { my($r)=@_; - $r->print("Doing upload to ".$ENV{'form.courseid'}); + my ($symb,$url)=&get_symb_and_url($r,1); + my $doanotherupload= + '
'."\n". + ''."\n". + ''."\n". + '
'."\n"; + if (!&Apache::lonnet::allowed('usc',$ENV{'form.domainid'}) && + !&Apache::lonnet::allowed('usc', + $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)); + } else { + $r->print($doanotherupload); + } + return ''; + } + my %coursedata=&Apache::lonnet::coursedescription($ENV{'form.domainid'}.'_'.$ENV{'form.courseid'}); + $r->print("Doing upload to ".$coursedata{'description'}."
"); my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'}, $ENV{'form.domainid'}); my $fname=$ENV{'form.upfile.filename'}; @@ -3984,14 +4755,70 @@ sub scantron_upload_scantron_data_save { $fname=~s/[^\w\.\-]//g; # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } + my $uploadedfile=$fname; $fname='scantron_orig_'.$fname; - &Apache::lonnet::logthis("fname is $fname"); - $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, - $ENV{'form.domainid'}, - $home,'upfile',$fname)); + if (length($ENV{'form.upfile'}) < 2) { + $r->print("Error: The file you attempted to upload, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"').", contained no information. Please check that you entered the correct filename."); + } else { + my $result=&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},$ENV{'form.domainid'},$home,'upfile',$fname); + if ($result =~ m|^/uploaded/|) { + $r->print("Success: Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location ".$result.""); + } else { + $r->print("Error: An error (".$result.") occurred when attempting to upload the file, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"').""); + } + } + if ($symb) { + $r->print(&scantron_selectphase($r,$uploadedfile)); + } else { + $r->print($doanotherupload); + } return ''; } +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; +} + +sub scantron_download_scantron_data { + my ($r)=@_; + my $default_form_data=&defaultFormData(&get_symb_and_url($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'}; + if (! &valid_file($file)) { + $r->print(< + The requested file name was invalid. +

+ERROR + $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + return; + } + my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; + my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; + my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; + &Apache::lonnet::allowuploaded('/adm/grades',$orig); + &Apache::lonnet::allowuploaded('/adm/grades',$corrected); + &Apache::lonnet::allowuploaded('/adm/grades',$skipped); + $r->print(< + Original file as uploaded by the scantron office. +

+

+ Corrections, a file of corrected records that were used in grading. +

+

+ Skipped, a file of records that were skipped. +

+DOWNLOAD + $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + return ''; +} #-------- end of section for handling grading scantron forms ------- # @@ -4044,7 +4871,7 @@ sub gradingmenu { } formname.command.value = cmd; formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+ - ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); + ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); if (val < 5) formname.submit(); if (val == 5) { if (!checkReceiptNo(formname,'notOK')) { return false;} @@ -4095,29 +4922,31 @@ GRADINGMENUJS $result.=''; $result.=''; $result.=''."\n"; + ($saveCmd eq 'submission' ? 'checked' : '').'> '.''.&mt('Current Resource').': '.&mt('For one or more students'). + ' '."\n"; $result.=''."\n"; + ''. + ' '.&mt('scores from file').' '."\n"; $result.=''."\n"; + '" value="'.&mt('Grade').'" /> scantron forms'."\n"; if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) { $result.=''."\n"; } @@ -4163,19 +4993,23 @@ sub handler { undef(%perm); if ($ENV{'browser.mathml'}) { - $request->content_type('text/xml'); + &Apache::loncommon::content_type($request,'text/xml'); } else { - $request->content_type('text/html'); + &Apache::loncommon::content_type($request,'text/html'); } $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 $command=$ENV{'form.command'}; + 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'})=split(/___/,$symb); + ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb); $url = $ENV{'form.url'}; } &send_header($request); @@ -4188,7 +5022,7 @@ sub handler { my ($tsymb,$tuname,$tudom,$tcrsid)= &Apache::lonnet::checkin($token); if ($tsymb) { - my ($map,$id,$url)=split(/\_\_\_/,$tsymb); + my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { $request->print(&Apache::lonnet::ssi_body('/res/'.$url, ('grade_username' => $tuname, @@ -4259,19 +5093,25 @@ sub handler { } } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { $request->print(&scantron_selectphase($request)); + } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) { + $request->print(&scantron_do_warning($request)); } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { $request->print(&scantron_validate_file($request)); } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { $request->print(&scantron_process_students($request)); - } elsif ($command eq 'scantronupload' && - &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) { - $request->print(&scantron_upload_scantron_data($request)); - - } elsif ($command eq 'scantronupload_save' && - &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) { - $request->print(&scantron_upload_scantron_data_save($request)); + } elsif ($command eq 'scantronupload' && + (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})|| + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) { + $request->print(&scantron_upload_scantron_data($request)); + } elsif ($command eq 'scantronupload_save' && + (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})|| + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) { + $request->print(&scantron_upload_scantron_data_save($request)); + } elsif ($command eq 'scantron_download' && + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + $request->print(&scantron_download_scantron_data($request)); } elsif ($command) { - $request->print("$command ".join(':',%perm)."Access Denied"); + $request->print("Access Denied ($command)"); } } &send_footer($request); @@ -4292,8 +5132,7 @@ sub send_header { sub send_footer { my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); + $request->print(''); } 1; 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

'."\n". - ' Select Section: '."\n"; if (ref($sections)) { - foreach (sort (@$sections)) {$result.=''."\n";} + foreach (sort (@$sections)) { + $result.=''."\n"; + } } $result.= '
'. ' '.'Current Resource: For one or more students'. - '
            -->For students with '. - ' submissions or '. - ' for all
'. ''. - ' scores from file
'. ' scantron forms
'. - ''. - ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). + ''. + ' '.&mt('receipt').': '. + &Apache::lonnet::recprefix($ENV{'request.course.id'}). '-'. '