--- loncom/homework/grades.pm 2003/07/25 20:35:40 1.125 +++ loncom/homework/grades.pm 2003/09/30 06:35:20 1.130.2.1.2.7 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.125 2003/07/25 20:35:40 ng Exp $ +# $Id: grades.pm,v 1.130.2.1.2.7 2003/09/30 06:35:20 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -96,6 +96,18 @@ sub get_fullname { return $fullname; } +#--- Format fullname, username:domain if different for display +#--- Use anywhere where the student names are listed +sub nameUserString { + my ($type,$fullname,$uname,$udom) = @_; + if ($type eq 'header') { + return ' Fullname (Username) '; + } else { + return ' '.$fullname.' ('.$uname. + ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; + } +} + #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { @@ -109,9 +121,8 @@ sub response_type { my ($responsetype,$part) = split(/_/,$_,2); my ($partid,$respid) = split(/_/,$part); $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'); #a bug $value is 'yes' regardless - $handgrade{$part} = $responsetype.':'.(($allkeys =~ /parameter_$part\_handgrade/) ? 'yes' : 'no'); + my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); + $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no'); next if ($seen{$partid} > 0); $seen{$partid}++; push @partlist,$partid; @@ -127,7 +138,7 @@ sub showResourceInfo { my $result =''. ''."\n"; my ($partlist,$handgrade) = &response_type($url); - my %resptype = (); #,$hdgrade)=('','no'); + my %resptype = (); my $hdgrade='no'; for (sort keys(%$handgrade)) { my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); @@ -154,12 +165,12 @@ sub cleanRecord { push @ans,$ans; } my $grayFont = ''; - return '
Current Resource: '.$probTitle.'
'. + return '
'. ''. ''. - '
Answer'. (join '',@ans).'
'.$grayFont.'Option ID'.$grayFont. (join ''.$grayFont,@IDs).'
'; + ''; } if ($response eq 'essay') { if (! exists ($ENV{'form.'.$symb})) { @@ -174,7 +185,7 @@ 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); + return '

'.&keywords_highlight($answer).'
'; } return $answer; } @@ -299,7 +310,7 @@ sub student_gradeStatus { my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my %partstatus = (); foreach (@$partlist) { - my ($status,$foo) = split(/_/,$record{"resource.$_.solved"},2); + my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); $status = 'nothing' if ($status eq ''); $partstatus{$_} = $status; my $subkey = "resource.$_.submitted_by"; @@ -475,7 +486,7 @@ sub listStudents { sense = "the student"; } if (ctr == 0) { - alert("Please select "+sense+" before clicking on the $viewgrade button."); + alert("Please select "+sense+" before clicking on the Next button."); return false; } document.gradesub.submit(); @@ -527,27 +538,27 @@ LISTJAVASCRIPT &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'
'; } - $gradeTable.='To '.lc($viewgrade).' a submission, click on the check box next to the student\'s name. Then '."\n". - 'click on the '.$viewgrade.' button. To view the submissions for a group of students, click'."\n". - ' on the check boxes for the group of students.
'."\n". + $gradeTable.='To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '. + 'next to the student\'s name(s). Then click on the Next button.
'."\n". ''."\n"; $gradeTable.=''."\n"; + 'value="Next->" />'."\n"; my (undef, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; my $loop = 0; while ($loop < 2) { - $gradeTable.=''; + $gradeTable.=''. + ''; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort(@$partlist)) { $gradeTable.=''; } } $loop++; +# $gradeTable.='' if ($loop%2 ==1); } $gradeTable.=''."\n"; @@ -574,10 +585,10 @@ LISTJAVASCRIPT $ctr++; if ( $perm{'vgr'} eq 'F' ) { $gradeTable.='' if ($ctr%2 ==1); - $gradeTable.=''. + ''."\n". - ''."\n"; + ''."\n"; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { @@ -585,11 +596,12 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; } } +# $gradeTable.='' if ($ctr%2 ==1); $gradeTable.=''."\n" if ($ctr%2 ==0); } } if ($ctr%2 ==1) { - $gradeTable.=''; + $gradeTable.=''; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (@$partlist) { $gradeTable.=''; @@ -601,7 +613,7 @@ LISTJAVASCRIPT $gradeTable.='
 Select  Fullname '. - '(Username)  No.  Select '.&nameUserString('header').' Part '.(split(/_/))[0].' Status 
'.$ctr.'  '.$$fullname{$student}.' '."\n". - '('.$uname.')'.&nameUserString(undef,$$fullname{$student},$uname,$udom).' '.$status{$_}.' 
      
'. ''."\n"; + 'value="Next->" />'."\n"; if ($ctr == 0) { my $num_students=(scalar(keys(%$fullname))); if ($num_students eq 0) { @@ -752,12 +764,13 @@ sub sub_page_js { for (i=0;i<=total;i++) { for (j=0;j"); pDoc.write("Message Central"); @@ -1027,6 +1036,7 @@ sub sub_page_kw_js { pDoc.write("

"); pDoc.write(""); pDoc.write(""); + pDoc.close(); } //====================== Script for keyword highlight options ============== @@ -1070,6 +1080,7 @@ sub sub_page_kw_js { hwdWin = window.open('', 'KeywordHighlightCentral', '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.write(""); hDoc.write("Highlight Central"); @@ -1118,6 +1129,7 @@ sub sub_page_kw_js { hDoc.write("

"); hDoc.write(""); hDoc.write(""); + hDoc.close(); } @@ -1351,9 +1363,7 @@ KEYWORDS my $result=''; } @@ -3006,8 +3003,8 @@ sub updateGradeByPage { return; } my $result='

 '.$ENV{'form.title'}.'

'; - $result.='

 Student: '.$ENV{'form.fullname'}. - ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')

'."\n"; + $result.='

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

'."\n"; $request->print($result); @@ -3062,7 +3059,6 @@ sub updateGradeByPage { $score = 'excused'; } elsif ($dropMenu eq 'reset status' && $ENV{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists - print "got to reset = $ENV{'form.solved'.$question.'_'.$partid}:
"; $newrecord{'resource.'.$partid.'.tries'} = 0; $newrecord{'resource.'.$partid.'.solved'} = ''; $newrecord{'resource.'.$partid.'.award'} = ''; @@ -3150,6 +3146,8 @@ sub getSequenceDropDown { } sub scantron_uploads { + #FIXME need to support scantron files put in another location, + # maybe the course directory? a scantron dir in the course directory? if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; my $result= ' + $default_form_data
'."\n". '
'."\n"; - $result.='Fullname: '.$ENV{'form.fullname'}. - '   Username: '.$uname. - ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').'
'."\n"; + $result.='Fullname: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom).'
'."\n"; $result.=''."\n"; @@ -1468,11 +1478,9 @@ KEYWORDS '"> File uploaded by student '. 'Like all files provided by users, '. 'this file may contain virusses
':''). - 'Submitted Answer: '.($responsetype =~ /^(essay|option)$/ ? - '
' : ''). + 'Submitted Answer: '. &cleanRecord($subval,$responsetype,$symb). - ($responsetype =~ /^(essay|option)$/ ? '

' : - '

').$similar."\n" + '

'.$similar."\n" if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} =~ /:yes$/)); @@ -1519,7 +1527,6 @@ KEYWORDS $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; } $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript -# $result.='
'."\n". $result=''."\n". ''."\n"; $result.=' '."\n"; + $result.=''."\n" if ($counter == 0); my $ctr = 0; while ($ctr < scalar(@partlist)) { $result.='$nsel  '."\n". - '  '; - $endform.='(Next and Previous do not save the scores.)'."\n" ; + $endform.='  '."\n". + '  '; + $endform.='(Next and Previous (student) do not save the scores.)'."\n" ; $endform.='
'; $endform.=&show_grading_menu_form($symb,$url); $request->print($endform); @@ -1770,21 +1781,19 @@ sub processHandGrade { } } $ctr = 0; - my ($partlist,$handgrade) = &response_type($ENV{'form.url'},$symb); @parsedlist = reverse @parsedlist if ($button eq 'Previous'); foreach my $student (@parsedlist) { my ($uname,$udom) = split(/:/,$student); if ($ENV{'form.submitonly'} eq 'yes') { - my (%status) = &student_gradeStatus($ENV{'form.url'},$symb,$udom,$uname,$partlist) ; + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my $statusflg = ''; - foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); - my ($foo,$partid,$foo1) = split(/\./); - $statusflg = '' if ($status{'resource.'.$partid.'.submitted_by'} ne ''); + foreach (split(/:/,$ENV{'form.gradePartRespid'})){ + $statusflg = 1 if (exists ($record{'resource.'.$_.'.submission'})); } next if ($statusflg eq ''); } push @nextlist,$student if ($ctr < $ntstu); + last if ($ctr == $ntstu); $ctr++; } @@ -2059,14 +2068,15 @@ sub viewgrades { ''."\n". ''."\n"; - $result.='

Assign Common Grade To '; + my $sectionClass; if ($ENV{'form.section'} eq 'all') { - $result.='Class

'; + $sectionClass='Class '; } elsif ($ENV{'form.section'} eq 'no') { - $result.='Students in no Section '; + $sectionClass='Students in no Section '; } else { - $result.='Students in Section '.$ENV{'form.section'}.''; + $sectionClass='Students in Section '.$ENV{'form.section'}.''; } + $result.='

Assign Common Grade To '.$sectionClass; $result.= ''."\n"; @@ -2197,17 +2199,13 @@ sub viewstudentgrade { $status = 'nothing' if ($status eq ''); $result.=''."\n"; - $result.='\n"; + $result.=" \n"; } else { $result.=''. @@ -2231,9 +2229,11 @@ sub editgrades { my $title='

Current Grade Status

'; $title.='Current Resource: '.$ENV{'form.probTitle'}.'
'."\n"; $title.='Section: '.$ENV{'form.section'}.''."\n"; + my $result= '
'."\n". ''."\n"; ''. ''."\n"; $ctsparts++; @@ -2119,21 +2128,14 @@ sub viewgrades { #table listing all the students in a section/class #header of table - $result.= '

Assign Grade to Specific Students in '; - if ($ENV{'form.section'} eq 'all') { - $result.='the Class

'; - } elsif ($ENV{'form.section'} eq 'no') { - $result.='no Section '; - } else { - $result.='Section '.$ENV{'form.section'}.''; - } + $result.= '

Assign Grade to Specific Students in '.$sectionClass; $result.= '

'; #radio buttons/text box for assigning points for a section or class. @@ -2107,7 +2117,6 @@ sub viewgrades { 'onChange="javascript:writeRadText(\''.$partid.'\','. $weight{$partid}.')"> '. ''. -# '
'."\n". - ''. - ''."\n"; + '
Fullname (Username)
'. + '\n"; my (@parts) = sort(&getpartlist($url)); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); - $display =~ s/^Number of Attempts/Tries/; # makes the column narrower + $display =~ s|^Number of Attempts|Tries
|; # makes the column narrower if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); } if ($display =~ /^Partial Credit Factor/) { my ($partid) = &split_part_type($part); @@ -2154,13 +2156,13 @@ sub viewgrades { my $uname = $_; $uname=~s/:/_/; $result.=''."\n"; - $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, - $_,$$fullname{$_},\@parts,\%weight); $ctr++; + $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'}, + $_,$$fullname{$_},\@parts,\%weight,$ctr); } $result.='
 No. '.&nameUserString('header')."
'; $result.=''."\n"; - $result.=''."\n"; if (scalar(%$fullname) eq 0) { my $colspan=3+scalar(@parts); @@ -2173,11 +2175,11 @@ sub viewgrades { #--- call by previous routine to display each student sub viewstudentgrade { - my ($url,$symb,$courseid,$student,$fullname,$parts,$weight) = @_; + my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr) = @_; my ($uname,$udom) = split(/:/,$student); $student=~s/:/_/; my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname); - my $result='
'. + my $result='
'.$ctr.'  '. ''.$fullname.' '. '('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).')'."\n"; -# my $optsel = ''."\n"; -# $optsel = ''."\n" -# if ($status eq 'excused'); -# $result.=$optsel; $result.= (($status eq 'excused') ? '' : '')."\n"; $result.=''; - $result.="
'."\n"; $result.= ''. - ''."\n"; + ''. + '\n"; my %scoreptr = ( 'correct' =>'correct_by_override', @@ -2283,6 +2283,7 @@ sub editgrades { $result .= $header; $result .= ''."\n"; my $noupdate; + my ($updateCtr,$noupdateCtr) = (1,1); for ($i=0; $i<$ENV{'form.total'}; $i++) { my $line; my $user = $ENV{'form.ctr'.$i}; @@ -2291,12 +2292,10 @@ sub editgrades { my ($uname,$udom)=split(/_/,$user); my %newrecord; my $updateflag = 0; - $line .= ''; + $line .= ''; my $usec=$classlist->{"$uname:$udom"}[5]; if (!&canmodify($usec)) { - my $numcols=scalar(@partid)*(scalar(@parts)-1)*2; + my $numcols=scalar(@partid)*4+2; $noupdate.=$line.""; next; } @@ -2322,7 +2321,6 @@ sub editgrades { if ($dropMenu eq 'reset status' && $old_score ne '') { # ignore if no previous attempts => nothing to reset - print "reset status
"; $newrecord{'resource.'.$_.'.tries'} = 0; $newrecord{'resource.'.$_.'.solved'} = ''; $newrecord{'resource.'.$_.'.award'} = ''; @@ -2363,14 +2361,17 @@ sub editgrades { $count++; &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'}, $udom,$uname); - $result.=$line; + $result.=''.$line; + $updateCtr++; } else { - $noupdate.=$line; + $noupdate.=''.$line; + $noupdateCtr++; } } if ($noupdate) { - my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; - $result .= ''.$noupdate; +# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; + my $numcols=scalar(@partid)*4+2; + $result .= ''.$noupdate; } $result .= '
UsernameDomainFullname No. '.&nameUserString('header')."
'.$uname.' '. - $udom.' '. - $$fullname{$usercolon}.' '.&nameUserString(undef,$$fullname{$usercolon},$uname,$udom).'Not allowed to modify student
 '.$updateCtr.' 
 '.$noupdateCtr.' 
No Changes Occured For the Students Below
No Changes Occurred For the Students Below
'."\n". &show_grading_menu_form ($symb,$url); @@ -2509,7 +2510,6 @@ to this page if the data selected is ins $javascript ENDPICK - $request->print(&show_grading_menu_form($symb,$url)); return ''; } @@ -2762,34 +2762,33 @@ LISTJAVASCRIPT ''."
\n"; $result.=' 
'."\n"; + 'onClick="javascript:checkPickOne(this.form);"value="Next->" />
'."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade
'. + my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. '
'. ''. - ''. - ''. - ''. - ''; + ''. + ''. + ''. + ''; my (undef,undef,$fullname) = &getclasslist($getsec,'1'); my $ptr = 1; foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { my ($uname,$udom) = split(/:/,$student); - $studentTable.=($ptr%4 == 1 ? '' : ''); + $studentTable.=($ptr%2 == 1 ? '' : ''); + $studentTable.=''; + $studentTable.='' : ''); $ptr++; } - $studentTable.='
 Fullname (username) Fullname (username) Fullname (username) Fullname (username)
 No.'.&nameUserString('header').' No.'.&nameUserString('header').'
' : ''); - $studentTable.=' '.$$fullname{$student}. - ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')'."\n"; - $studentTable.=($ptr%4 == 0 ? '
'.$ptr.'   ' + .&nameUserString(undef,$$fullname{$student},$uname,$udom)."\n"; + $studentTable.=($ptr%2 == 0 ? '
   ' if ($ptr%4 == 2); - $studentTable.='  ' if ($ptr%4 == 3); - $studentTable.=' ' if ($ptr%4 == 0); + $studentTable.='  ' if ($ptr%2 == 0); $studentTable.='
'."\n"; - $studentTable.='
'."\n"; + $studentTable.=''."\n"; $studentTable.=&show_grading_menu_form($symb,$url); $request->print($studentTable); @@ -2801,7 +2800,7 @@ sub getSymbMap { my ($request) = @_; my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', $ENV{'request.course.fn'}.'_parms.db'); - $navmap->init(); +# $navmap->init(); my %symbx = (); my @titles = (); @@ -2841,9 +2840,8 @@ sub displayPage { return; } my $result='

 '.$ENV{'form.title'}.'

'; - $result.='

 Student: '.$$fullname{$ENV{'form.student'}}. - ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')

'."\n"; - + $result.='

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

'."\n"; &sub_page_js($request); $request->print($result); @@ -2883,7 +2881,6 @@ sub displayPage { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } -# if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); @@ -2982,7 +2979,7 @@ sub displaySubByDates { $$record{"$version:resource.$partid.regrader"}.' (Part: '.$partid.')' : ''; } $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ? - $$record{"$version:resource.regrader"} : ''; + $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info $studentTable.='		'.$displaySub[0].' '.$displaySub[1]. ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).' 
@@ -3214,11 +3214,18 @@ sub scantron_selectphase { Format of data file: $format_selector + + +
+ + Last line to expect an answer on: + +
- + $grading_menu_button SCANTRONFORM @@ -3230,6 +3237,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; } @@ -3246,6 +3254,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; @@ -3261,8 +3275,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); @@ -3276,6 +3335,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) { @@ -3283,31 +3351,52 @@ 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) { + Apache->request->print("snippet is 
$currentquest
"); + 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; } sub scantron_add_delay { + my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; + Apache->request->print('add_delay_error '.$_[2] ); + push(@$delayqueue, + {'line' => $scanline, 'emsg' => $errormessage, + 'ecode' => $errorcode } + ); } 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}; } + #Apache->request->print('
checking studnet -'.$id.'- againt -'.$scanID.'-
'); + if (lc($id) eq lc($scanID)) { + #Apache->request->print('success'); + return $$idmap{$id}; + } } return undef; } @@ -3320,6 +3409,391 @@ sub scantron_filter { return 0; } +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, click 'Submit' to start proccssing"); + $r->print(''); + } else { + $r->print(''); + $r->print(""); + } + $r->print(''); + 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) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $id=$$scan_record{'scantron.ID'}; +# $r->print("

Checking ID ".$$scan_record{'scantron.ID'}. +# " on paper ID ".$$scan_record{'scantron.PaperID'}."

\n"); + my $found; + foreach my $checkid (keys(%idmap)) { + if (lc($checkid) eq lc($id)) { + if ($checkid ne $id) { + #$r->print("

Using $checkid for encoded $id

\n"); + } + $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("

This scantron record has an error ($error). "); + if ( defined($$scan_record{'scantron.PaperID'}) ) { + $r->print("The current PaperID is ". + $$scan_record{'scantron.PaperID'}." \n"); + } else { + $r->print("The current scanline is 

".
+		  $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("

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

"); + $r->print("

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

  • Pick a specific user -- username:"); + $r->print("\ndomain:". + &Apache::loncommon::select_dom_form(undef,'scantron_domain')); + #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('
    • '); + } elsif ($error eq 'doublebubble') { + $r->print("
    $line
    "); + $Apache::lonxml::debug=1; + &Apache::lonhomework::showhashsubset($scan_record,'.'); + $Apache::lonxml::debug=0; + $r->print("There have been multiple bubbles scanned for a single question\n"); + $r->print(''); + foreach my $question (@{$arg}) { + my $selected=$$scan_record{"scantron.$question.answer"}; + $r->print("

    For question $question, selected bubbles were ". + join(" ",split('',$selected,-1)). + "
    Please pick which one should be used for grading
    "); + &scantron_bubble_selector($r,$scan_config,$question); + } + } elsif ($error eq 'missingbubble') { + $r->print("Some questions have no scanned bubbles\n"); + $r->print(''); + foreach my $question (@{$arg}) { + my $selected=$$scan_record{"scantron.$question.answer"}; + $r->print("

    Question $question, Please select a bubble to use "); + &scantron_bubble_selector($r,$scan_config,$question); + } + } else { + $r->print("\n

      "); + } + $r->print("
    • Skip this scanline saving it for later "); + $r->print("\n
    "); +} + +sub scantron_bubble_selector { + my ($r,$scan_config,$quest)=@_; + my $max=$$scan_config{'Qlength'}; + my @alphabet=('A'..'Z'); + for (my $i=0;$i<$max;$i++) { + $r->print(''.$alphabet[$i]); + } + $r->print(' Nothing'); + $r->print('
    '); +} + +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) { 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) { 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)=split(/___/,$ENV{'form.selectpage'}); @@ -3328,14 +3802,13 @@ 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($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - $r->print("geto ".scalar(@resources)."
    "); +# $r->print("geto ".scalar(@resources)."
    "); my $result= < @@ -3344,29 +3817,43 @@ SCANTRONFORM $r->print($result); my @delayqueue; - my $totalcorrect; - my $totalincorrect; - - my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, - 'Scantron Status','Scantron Progress',scalar(@scanlines)); - foreach my $line (@scanlines) { - my $studentcorrect; - my $studentincorrect; - - chomp($line); - my $scan_record=&scantron_parse_scanline($line,\%scantron_config); + my %completedstudents; + + 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(); + my $i=-1; + while ($i<$scanlines->{'count'}) { + $i++; + my $line=&scantron_get_line($scanlines,$i); + $r->print('
    line is'.$line.'
    '); + if (!defined($line)) { + $r->print('skipping'); + next; + } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); my ($uname,$udom); - if ($uname=&scantron_find_student($scan_record,\%idmap)) { + unless ($uname=&scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { &scantron_add_delay(\@delayqueue,$line, - 'Unable to find a student that matches'); + '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"); +# $Apache::lonxml::debug=1; +# &Apache::lonxml::debug("line is $line"); my $i=0; foreach my $resource (@resources) { @@ -3378,31 +3865,31 @@ SCANTRONFORM '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); +# 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;} } + $completedstudents{$uname}={'line'=>$line}; + } continue { &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::delenv('scantron\.'); &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, - 'last student Who got a '.$studentcorrect.' correct and '. - $studentincorrect.' incorrect. The class has gotten '. - $totalcorrect.' correct and '.$totalincorrect.' incorrect'); - last; + 'last student'); + #last; #FIXME #get iterator for $sequence #foreach question 'submit' the students answer to the server @@ -3410,7 +3897,11 @@ SCANTRONFORM # generate data to pass back that includes grade recevied #} } - $Apache::lonxml::debug=0; + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + 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 @@ -3563,7 +4054,7 @@ GRADINGMENUJS 'The complete set/page/sequence: For one student'."\n"; $result.='
    '. - ''. + ''. ''."\n"; $result.=''; @@ -3693,6 +4184,8 @@ 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_process' && $perm{'mgr'}) { $request->print(&scantron_process_students($request)); } elsif ($command) { @@ -3712,6 +4205,7 @@ sub send_header { #remotewindow.close(); #"); $request->print(&Apache::loncommon::bodytag('Grading')); + $request->rflush(); } sub send_footer {