--- loncom/homework/grades.pm 2003/11/06 15:22:33 1.147 +++ loncom/homework/grades.pm 2003/11/21 21:31:34 1.160 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.147 2003/11/06 15:22:33 albertel Exp $ +# $Id: grades.pm,v 1.160 2003/11/21 21:31:34 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -132,6 +132,10 @@ sub response_type { my ($url,$symb) = shift; $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq ''); my $allkeys = &Apache::lonnet::metadata($url,'keys'); + my %vPart; + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + $vPart{$partid}=1; + } my %seen = (); my (@partlist,%handgrade,%responseType); foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { @@ -141,6 +145,9 @@ sub response_type { if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { next; } + if (%vPart && !exists($vPart{$partid})) { + next; + } $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); @@ -157,18 +164,31 @@ sub response_type { #--- 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"; + ''."\n"; my ($partlist,$handgrade,$responseType) = &response_type($url); my %resptype = (); my $hdgrade='no'; + my %partsseen; for my $part_resID (sort keys(%$handgrade)) { my $handgrade=$$handgrade{$part_resID}; my ($partID,$resID) = split(/_/,$part_resID); my $responsetype = $responseType->{$partID}->{$resID}; $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=""; + } + $partsseen{$partID}=1; + } + $result.=''. ''; # ''; @@ -177,26 +197,87 @@ sub showResourceInfo { 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.=''; + } else { + $toprow.=''; + } + $bottomrow.=''; } - my $grayFont = ''; return '
Current Resource: '.$probTitle.'
Current Resource: '. + $probTitle.'
Part '.$partID.' '. + $result.='
 Part '.$partID.' '. $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'.$answer{$foil}.' '.$answer{$foil}.' '.$grayFont.$foil.' 
'. - ''. - ''. - '
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'}, @@ -489,8 +570,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(< @@ -530,7 +610,8 @@ LISTJAVASCRIPT my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; - my $gradeTable='
'."\n". + my $gradeTable=''. + "\n".$table. ' View Problem Text: no '."\n". ' one student '."\n". ' all students
'."\n". @@ -604,13 +685,17 @@ LISTJAVASCRIPT my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; + my ($part)=split(/\./,$partid); $gradeTable.=''; } } - next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); - next if (!$graded && $submitonly eq 'graded'); + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$graded && ($submitonly eq 'graded' || + $submitonly eq 'incorrect')); } $ctr++; @@ -667,8 +752,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) { @@ -1373,6 +1457,9 @@ sub submission { ''."\n". ''."\n". ''."\n"); + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + $request->print(''."\n"); + } } my ($cts,$prnmsg) = (1,''); @@ -1471,8 +1558,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.=''; @@ -3693,6 +4349,8 @@ GRADINGMENUJS ($saveSub eq 'yes' ? 'selected="on"' : '').'>with submissions'. ''. + ''. ''."\n"; @@ -3749,14 +4407,18 @@ sub handler { &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'})=&Apache::lonnet::decode_symb($symb); $url = $ENV{'form.url'}; } &send_header($request); - if ($url eq '' && $symb eq '') { + if ($url eq '' && $symb eq '' && $command eq '') { if ($ENV{'user.adv'}) { if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && ($ENV{'form.codethree'})) { @@ -3797,7 +4459,6 @@ sub handler { delete($perm{'mgr'}); } } - if ($command eq 'submission' && $perm{'vgr'}) { ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { @@ -3837,12 +4498,21 @@ sub handler { } } elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { $request->print(&scantron_selectphase($request)); + } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { + $request->print(&scantron_validate_file($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) { - $request->print("Access Denied"); + $request->print("Access Denied ($command)"); } } &send_footer($request); @@ -3858,6 +4528,7 @@ sub send_header { #remotewindow.close(); #"); $request->print(&Apache::loncommon::bodytag('Grading')); + $request->rflush(); } sub send_footer {
'; @@ -1498,78 +1587,78 @@ 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); - } 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 ($partid,$respid) = split(/_/,$part); - my $responsetype = $responseType->{$partid}->{$respid}; - if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { + my ($string,$timestamp)= &get_last_submission(\%record); + my $lastsubonly=''. + ($$timestamp eq '' ? '' : 'Date Submitted: '. + $$timestamp)."
'.$$string[0]; + } else { + my %seenparts; + for my $part (sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/,$part); + if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { + if (exists($seenparts{$partid})) { next; } + $seenparts{$partid}=1; + my $submitby='Part '.$partid. + ' 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 '. + $partid.' ( 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')) { $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; - my $odom; - my $ocrsid; - my $oessay; - my $osim; - if($ENV{'form.checkPlag'}){ - ($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$/)); - } + ' )   '; + if ($record{"resource.$partid.$respid.uploadedurl"}) { + $lastsubonly.=' File uploaded by student Like all files provided by users, this file may contain virusses
'; } + $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'}, @@ -1742,18 +1831,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); + } + } } } @@ -1861,7 +1953,7 @@ sub processHandGrade { foreach my $student (@parsedlist) { my $submitonly=$ENV{'form.submitonly'}; my ($uname,$udom) = split(/:/,$student); - if ($submitonly =~ /^(yes|graded)$/) { + 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; @@ -1874,8 +1966,11 @@ sub processHandGrade { $submitted = 0; } } - next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); - next if (!$graded && $submitonly eq 'graded'); + 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); @@ -1905,7 +2000,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'); } @@ -1913,6 +2008,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') { @@ -1933,27 +2030,37 @@ sub saveHandGrade { $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); @@ -2733,7 +2840,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; @@ -3002,7 +3111,7 @@ sub displayPage { } $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') { @@ -3038,7 +3147,7 @@ sub displayPage { } sub displaySubByDates { - my ($symbx,$record,$parts,$responseType,$checkIcon) = @_; + my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $studentTable=' @@ -3340,6 +3466,7 @@ sub get_scantron_config { my ($which) = @_; my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my %config; + #FIXME probably should move to XML it has already gotten a bit much now foreach my $line (<$fh>) { my ($name,$descrip)=split(/:/,$line); if ($name ne $which ) { next; } @@ -3356,6 +3483,12 @@ sub get_scantron_config { $config{'Qlength'}=$config[8]; $config{'Qoff'}=$config[9]; $config{'Qon'}=$config[10]; + $config{'PaperID'}=$config[11]; + $config{'PaperIDlength'}=$config[12]; + $config{'FirstName'}=$config[13]; + $config{'FirstNamelength'}=$config[14]; + $config{'LastName'}=$config[15]; + $config{'LastNamelength'}=$config[16]; last; } return %config; @@ -3371,8 +3504,53 @@ sub username_to_idmap { return %idmap; } +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'); + } + if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { + $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', + $args->{'newid'}); + } + substr($line,$$scantron_config{'IDstart'}-1, + $$scantron_config{'IDlength'})=$args->{'newid'}; + if ($args->{'newid'}=~/^\s*$/) { + &scan_data($scan_data,"$whichline.user", + $args->{'username'}.':'.$args->{'domain'}); + } + } elsif ($field eq 'answer') { + my $length=$scantron_config->{'Qlength'}; + my $off=$scantron_config->{'Qoff'}; + my $on=$scantron_config->{'Qon'}; + my $answer=${off}x$length; + if ($args->{'response'} eq 'none') { + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'question'},'1'); + } else { + substr($answer,$args->{'response'},1)=$on; + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'question'},undef,'1'); + } + my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; + substr($line,$where-1,$length)=$answer; + } + return $line; +} + +sub scan_data { + my ($scan_data,$key,$value,$delete)=@_; + my $filename=$ENV{'form.scantron_selectfile'}; + if (defined($value)) { + $scan_data->{$filename.'_'.$key} = $value; + } + if ($delete) { delete($scan_data->{$filename.'_'.$key}); } + return $scan_data->{$filename.'_'.$key}; +} + sub scantron_parse_scanline { - my ($line,$scantron_config)=@_; + my ($line,$whichline,$scantron_config,$scan_data)=@_; my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); @@ -3386,6 +3564,15 @@ sub scantron_parse_scanline { } $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, $$scantron_config{'IDlength'}); + $record{'scantron.PaperID'}= + substr($data,$$scantron_config{'PaperID'}-1, + $$scantron_config{'PaperIDlength'}); + $record{'scantron.FirstName'}= + substr($data,$$scantron_config{'FirstName'}-1, + $$scantron_config{'FirstNamelength'}); + $record{'scantron.LastName'}= + substr($data,$$scantron_config{'LastName'}-1, + $$scantron_config{'LastNamelength'}); my @alphabet=('A'..'Z'); my $questnum=0; while ($questions) { @@ -3393,17 +3580,25 @@ sub scantron_parse_scanline { my $currentquest=substr($questions,0,$$scantron_config{'Qlength'}); substr($questions,0,$$scantron_config{'Qlength'})=''; if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } - my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest); - if (scalar(@array) gt 2) { - #FIXME do something intelligent with double bubbles - Apache->request->print("
Wha!!!
".scalar(@array).
-				   '-'.$currentquest.'-'.$questnum.'

'); - } + my @array=split($$scantron_config{'Qon'},$currentquest,-1); if (length($array[0]) eq $$scantron_config{'Qlength'}) { $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); + while ($#ans) { + $i+=length($ans[0])+1; + $record{"scantron.$questnum.answer"}.=$alphabet[$i]; + shift(@ans); + } + } } $record{'scantron.maxquest'}=$questnum; return \%record; @@ -3411,7 +3606,6 @@ sub scantron_parse_scanline { sub scantron_add_delay { my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; - Apache->request->print('add_delay_error '.$_[2] ); push(@$delayqueue, {'line' => $scanline, 'emsg' => $errormessage, 'ecode' => $errorcode } @@ -3419,14 +3613,15 @@ sub scantron_add_delay { } sub scantron_find_student { - my ($scantron_record,$idmap)=@_; + my ($scantron_record,$scan_data,$idmap,$line)=@_; my $scanID=$$scantron_record{'scantron.ID'}; + if ($scanID =~ /^\s*$/) { + return &scan_data($scan_data,"$line.user"); + } foreach my $id (keys(%$idmap)) { - #Apache->request->print('
checking studnet -'.$id.'- againt -'.$scanID.'-
'); - if (lc($id) eq lc($scanID)) { - #Apache->request->print('success'); - return $$idmap{$id}; - } + if (lc($id) eq lc($scanID)) { + return $$idmap{$id}; + } } return undef; } @@ -3451,6 +3646,399 @@ sub scantron_validate_file { my ($r) = @_; } +sub scantron_process_corrections { + my ($r) = @_; + my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + 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 ($skip,$err,$errmsg); + if ($ENV{'form.scantron_skip_record'}) { + $skip=1; + } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { + my $newstudent=$ENV{'form.scantron_username'}.':'. + $ENV{'form.scantron_domain'}; + my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'ID',{'newid'=>$newid, + 'username'=>$ENV{'form.scantron_username'}, + 'domain'=>$ENV{'form.scantron_domain'}}); + } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { + foreach my $question (split(',',$ENV{'form.scantron_questions'})) { + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, + $which,'answer', + { 'question'=>$question, + 'response'=>$ENV{"form.scantron_correct_Q_$question"}}); + if ($err) { last; } + } + } + if ($err) { + $r->print("Unable to accept last correction, an error occurred :$errmsg:"); + } else { + &scantron_put_line($scanlines,$which,$line,$skip); + &scantron_putfile($scanlines,$scan_data); + } +} + + +sub scantron_validate_file { + my ($r) = @_; + my ($symb,$url)=&get_symb_and_url($r); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb,$url); + + if ($ENV{'form.scantron_corrections'}) { + &scantron_process_corrections($r); + } + #get the student pick code ready + $r->print(&Apache::loncommon::studentbrowser_javascript()); + my $result= < + + + + + $default_form_data +SCANTRONFORM + $r->print($result); + + my @validate_phases=( 'ID', + 'CODE', + 'doublebubble', + 'missingbubbles'); + if (!$ENV{'form.validatepass'}) { + $ENV{'form.valiadatepass'} = 0; + } + my $currentphase=$ENV{'form.valiadatepass'}; + + 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]."

"); + $r->rflush(); + my $which="scantron_validate_".$validate_phases[$currentphase]; + { + no strict 'refs'; + ($stop,$currentphase)=&$which($r,$currentphase); + } + } + if (!$stop) { + $r->print("Validation process complete.
"); + $r->print(''); + $r->print(''); + } else { + $r->print(''); + $r->print(""); + } + if ($stop) { + $r->print(''); + $r->print(' using corrected info
'); + $r->print(""); + $r->print(" this scanline saving it for later."); + } + $r->print("
".&show_grading_menu_form($symb,$url). + ""); + return ''; +} + +sub scantron_getfile { + #FIXME really would prefer a scantron directory but tokenwrapper + # doesn't allow access to subdirs of userfiles + 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'}; + $scanlines{'count'}=$#$temp; + + $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. + 'scantron_corrected_'.$ENV{'form.scantron_selectfile'}); + if ($lines eq '-1') { + $scanlines{'corrected'}=[]; + } else { + $scanlines{'corrected'}=[(split("\n",$lines,-1))]; + } + $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. + 'scantron_skipped_'.$ENV{'form.scantron_selectfile'}); + if ($lines eq '-1') { + $scanlines{'skipped'}=[]; + } else { + $scanlines{'skipped'}=[(split("\n",$lines,-1))]; + } + my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname); + if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } + my %scan_data = @tmp; + return (\%scanlines,\%scan_data); +} + +sub lonnet_putfile { + my ($contents,$filename)=@_; + my $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; + $ENV{'form.sillywaytopassafilearound'}=$contents; + &Apache::lonnet::finishuserfileupload($docuname,$docudom,$docuhome,'sillywaytopassafilearound',$filename); + +} + +sub scantron_putfile { + my ($scanlines,$scan_data) = @_; + #FIXME really would prefer a scantron directory but tokenwrapper + # doesn't allow access to subdirs of userfiles + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + 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); +} + +sub scantron_get_line { + my ($scanlines,$i)=@_; + if ($scanlines->{'skipped'}[$i]) {return undef;} + if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} + return $scanlines->{'orig'}[$i]; +} + +sub scantron_put_line { + my ($scanlines,$i,$newline,$skip)=@_; + if ($skip) { + $scanlines->{'skipped'}[$i]=$newline; + return; + } + $scanlines->{'corrected'}[$i]=$newline; +} + +sub scantron_validate_ID { + my ($r,$currentphase) = @_; + + #get student info + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + + #get scantron line setup + my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + my ($scanlines,$scan_data)=&scantron_getfile(); + + my %found=('ids'=>{},'usernames'=>{}); + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $id=$$scan_record{'scantron.ID'}; + my $found; + foreach my $checkid (keys(%idmap)) { + if (lc($checkid) eq lc($id)) { $found=$checkid;last; } + } + if ($found) { + my $username=$idmap{$found}; + if ($found{'ids'}{$found}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$found); + return(1); + } elsif ($found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$username); + return(1); + } + #FIXME store away line we prviously saw the ID on to use above + $found{'ids'}{$found}++; + $found{'usernames'}{$username}++; + } else { + if ($id =~ /^\s*$/) { + my $username=&scan_data($scan_data,"$i.user"); + if (defined($username) && $found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateID',$username); + return(1); + } elsif (!defined($username)) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectID'); + return(1); + } + $found{'usernames'}{$username}++; + } else { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'incorrectID'); + return(1); + } + } + } + + return (0,$currentphase+1); +} + +sub scantron_get_correction { + my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; + +#FIXME in the case of a duplicated ID the previous line, probaly need +#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) "); + if ( defined($$scan_record{'scantron.PaperID'}) ) { + $r->print(" for PaperID ". + $$scan_record{'scantron.PaperID'}." \n"); + } else { + $r->print(" in scanline $i 

".
+		  $line."
\n"); + } + $r->print(''."\n"); + $r->print(''."\n"); + if ($error =~ /ID$/) { + if ($error eq 'unknownID') { + $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"); + } + $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

  • "); + #FIXME it would be nice if this sent back the user ID and + #could do partial userID matches + $r->print(&Apache::loncommon::selectstudent_link('scantronupload', + 'scantron_username','scantron_domain')); + $r->print(": "); + $r->print("\n@". + &Apache::loncommon::select_dom_form(undef,'scantron_domain')); + + $r->print('
    • '); + } 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(''); + $r->print("

    Please indicate which bubble should be used for grading

    "); + foreach my $question (@{$arg}) { + my $selected=$$scan_record{"scantron.$question.answer"}; + &scantron_bubble_selector($r,$scan_config,$question,split('',$selected)); + } + } elsif ($error eq 'missingbubble') { + $r->print("

    There have been no bubbles scanned for some question(s)

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

    Please indicate which bubble should be used for grading

    "); + $r->print("Some questions have no scanned bubbles\n"); + $r->print(''); + foreach my $question (@{$arg}) { + my $selected=$$scan_record{"scantron.$question.answer"}; + &scantron_bubble_selector($r,$scan_config,$question); + } + } else { + $r->print("\n
      "); + } + $r->print("\n
    "); + +} + +sub scantron_bubble_selector { + my ($r,$scan_config,$quest,@selected)=@_; + my $max=$$scan_config{'Qlength'}; + my @alphabet=('A'..'Z'); + $r->print("
'. ''. ''. @@ -3046,6 +3155,7 @@ sub displaySubByDates { ''; my ($version); my %mark; + my %orders; $mark{'correct_by_student'} = $checkIcon; if (!exists($$record{'1:timestamp'})) { return '
 Nothing submitted - no attempts
'; @@ -3070,10 +3180,14 @@ sub displaySubByDates { $displaySub[0].='Trial '. $$record{"$version:resource.$partid.tries"}; } - &Apache::lonnet::logthis("Part is $partid responseType is ".join(':',%$responseType)); 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,$$symbx).'
'; + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'
'; } } if (exists $$record{"$version:resource.$partid.award"}) { @@ -3262,13 +3376,16 @@ sub getSequenceDropDown { sub scantron_uploads { if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; my $result= '"; return $result; } @@ -3296,6 +3413,8 @@ sub scantron_selectphase { my $file_selector=&scantron_uploads(); my $format_selector=&scantron_scantab(); my $result; + #FIXME allow instructor to be able to download the scantron file + # and to upload it, $result.= < @@ -3324,6 +3443,13 @@ sub scantron_selectphase { Format of data file: $format_selector + + +
Date/TimeStatus 
+ + Last line to expect an answer on: + +
"); + for (my $i=0;$i<$max+1;$i++) { + $r->print(''); + } + $r->print(''); + for (my $i=0;$i<$max;$i++) { + $r->print('"); + } + $r->print(''); + $r->print('
$quest'); + if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } + else { $r->print(' '); } + $r->print('
'.$alphabet[$i]." No bubble
'); +} + +sub scantron_validate_CODE { + my ($r,$currentphase) = @_; + #FIXME doesn't do anything yet + return (0,$currentphase+1); +} + +sub scantron_validate_doublebubble { + my ($r,$currentphase) = @_; + #get student info + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + + #get scantron line setup + 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); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + if (!defined($$scan_record{'scantron.doubleerror'})) { next; } + &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, + 'doublebubble', + $$scan_record{'scantron.doubleerror'}); + return (1,$currentphase); + } + return (0,$currentphase+1); +} + +sub scantron_validate_missingbubbles { + my ($r,$currentphase) = @_; + #get student info + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + + #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'}; + if (!$max_bubble) { $max_bubble=2**31; } + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + if (!defined($$scan_record{'scantron.missingerror'})) { next; } + my @to_correct; + foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { + if ($missing > $max_bubble) { next; } + push(@to_correct,$missing); + } + if (@to_correct) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'missingbubble',\@to_correct); + return (1,$currentphase); + } + + } + return (0,$currentphase+1); +} + sub scantron_process_students { my ($r) = @_; my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'}); @@ -3459,8 +4047,7 @@ sub scantron_process_students { my $default_form_data=&defaultFormData($symb,$url); my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}"); - my @scanlines=<$scanlines>; + my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); my $navmap=Apache::lonnavmaps::navmap->new(); @@ -3477,35 +4064,40 @@ SCANTRONFORM my @delayqueue; my %completedstudents; - my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, - 'Scantron Status','Scantron Progress',scalar(@scanlines)); + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', + 'Scantron Progress',$scanlines->{'count'}); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); my $start=&Time::HiRes::time(); - foreach my $line (@scanlines) { - $r->print('
line is'.$line.'
'); - - chomp($line); - my $scan_record=&scantron_parse_scanline($line,\%scantron_config); - my ($uname,$udom); - unless ($uname=&scantron_find_student($scan_record,\%idmap)) { - &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); + my $i=-1; + my ($uname,$udom); + 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"); - + my $i=0; foreach my $resource (@resources) { $i++; @@ -3567,7 +4159,70 @@ SCANTRONFORM # to ignore delayed students, possibly saving the delay queue for later $navmap->untieHashes(); + $r->print("

Done

"); + $r->print(&show_grading_menu_form($symb,$url)); + return ''; +} + +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'); + my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, + 'domainid'); + $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(); + } + + +
+Course: +Domain: $domsel $select_link +
+ +File to upload: +
+ +
+UPLOAD + return ''; } + +sub scantron_upload_scantron_data_save { + my($r)=@_; + $r->print("Doing upload to ".$ENV{'form.courseid'}); + my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'}, + $ENV{'form.domainid'}); + my $fname=$ENV{'form.upfile.filename'}; + #FIXME + #copied from lonnet::userfileupload() + #make that function able to target a specified course + # Replace Windows backslashes by forward slashes + $fname=~s/\\/\//g; + # Get rid of everything but the actual filename + $fname=~s/^.*\/([^\/]+)$/$1/; + # Replace spaces by underscores + $fname=~s/\s+/\_/g; + # Replace all other weird characters by nothing + $fname=~s/[^\w\.\-]//g; + # See if there is anything left + unless ($fname) { return 'error: no uploaded file'; } + $fname='scantron_orig_'.$fname; + &Apache::lonnet::logthis("fname is $fname"); + $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, + $ENV{'form.domainid'}, + $home,'upfile',$fname)); + return ''; +} + + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -3672,16 +4327,17 @@ GRADINGMENUJS $result.='
'."\n". ' Select Section:   '; $result.='Student Status:'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); - if (ref($sections)) { - $result.=' (Section "no" implies the students were not assigned a section.)
' - if (grep /no/,@$sections); + if (ref($sections) && (grep /no/,@$sections)) { + $result.=' (Section "no" implies the students were not assigned a section.)
'; } $result.='