--- loncom/homework/grades.pm 2003/11/21 21:31:34 1.160 +++ loncom/homework/grades.pm 2005/03/30 21:11:44 1.251 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.160 2003/11/21 21:31:34 albertel Exp $ +# $Id: grades.pm,v 1.251 2005/03/30 21:11:44 banghart 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=(); @@ -88,30 +79,16 @@ sub getpartlist { # --- 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 @@ -119,7 +96,7 @@ sub get_fullname { sub nameUserString { my ($type,$fullname,$uname,$udom) = @_; if ($type eq 'header') { - return ' Fullname (Username) '; + return ' Fullname (Username)'; } else { return ' '.$fullname.' ('.$uname. ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; @@ -161,6 +138,20 @@ sub response_type { 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 { @@ -168,7 +159,7 @@ sub showResourceInfo { my $col=3; if ($checkboxes) { $col=4; } my $result =''. - ''."\n"; my ($partlist,$handgrade,$responseType) = &response_type($url); my %resptype = (); @@ -188,7 +179,8 @@ sub showResourceInfo { } $partsseen{$partID}=1; } - $result.=''. ''; # ''; @@ -290,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; } @@ -342,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 = (); @@ -504,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'}; @@ -519,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". - ''. - ''."\n"; - - $matches++; + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.=''."\n". + ''. + ''; + if ($receiptparts) { + $contents.=''; + } + $contents.=''."\n"; + + $matches++; + } } } if ($matches == 0) { @@ -543,8 +554,11 @@ sub verifyreceipt { '
Current Resource: '. + '
'.&mt('Current Resource').': '. $probTitle.'
Part '.$partID.' '. + my $display_part=&get_display_part($partID,$url); + $result.='Part: '.$display_part.' '. $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
 '."\n". - ''.$$fullname{$_}.'  '.$uname.'  '.$udom.' 
 '."\n". + ''.$$fullname{$_}.'  '.$uname.'  '.$udom.'  '.$part.' 
'."\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); @@ -650,20 +664,26 @@ LISTJAVASCRIPT $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"; + +# checkall buttons + $gradeTable.=&check_script('gradesub', 'stuinfo'); $gradeTable.=''."\n"; + 'value="Next->" />
'."\n"; + $gradeTable.=&check_buttons(); $gradeTable.='Check For Plagiarism'; - my (undef, undef, $fullname) = &getclasslist($getsec,'1'); + my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; my $loop = 0; while ($loop < 2) { $gradeTable.=''. - ''; + ''; 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++; @@ -678,10 +698,13 @@ LISTJAVASCRIPT if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); my $submitted = 0; - my $graded = 1; + my $graded = 0; + my $incorrect = 0; foreach (keys(%status)) { $submitted = 1 if ($status{$_} ne 'nothing'); - $graded = 0 if ($status{$_} =~ /^correct/); + $graded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); + my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; @@ -691,20 +714,25 @@ LISTJAVASCRIPT $status{'resource.'.$partid.'.submitted_by'}.'" />'; } } + next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'incorrect' || $submitonly eq 'graded')); - next if (!$graded && ($submitonly eq 'graded' || - $submitonly eq 'incorrect')); + next if (!$graded && ($submitonly eq 'graded')); + next if (!$incorrect && $submitonly eq 'incorrect'); } $ctr++; + my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + if ( $perm{'vgr'} eq 'F' ) { $gradeTable.='' if ($ctr%2 ==1); $gradeTable.=''. - ''."\n". - ''."\n"; + ''."\n".''."\n"; if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { @@ -726,7 +754,7 @@ LISTJAVASCRIPT $gradeTable.=''; } - $gradeTable.='
 No.  Select '.&nameUserString('header').''.&nameUserString('header').' Section/Group Part '.(split(/_/))[0].' Status  Part: '.$display_part. + ' Status 
'.$ctr.' '.&nameUserString(undef,$$fullname{$student},$uname,$udom).''. + &nameUserString(undef,$$fullname{$student},$uname,$udom). + ' '.$section.'
'. + $gradeTable.=''."\n". ''."\n"; @@ -735,9 +763,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/; @@ -748,6 +779,52 @@ LISTJAVASCRIPT } #---- Called from the listStudents routine + +sub check_script { + my ($form, $type)=@_; + my $chkallscript=''."\n"; + return $chkallscript; +} + +sub check_buttons { + my $buttons.=''; + $buttons.=' '; + $buttons.=''; + $buttons.=' '; + return $buttons; +} + # Displays the submissions for one student or a group of students sub processGroup { my ($request) = shift; @@ -952,6 +1029,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(< @@ -1061,10 +1140,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"); @@ -1192,10 +1271,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"); @@ -1266,16 +1345,17 @@ sub gradeBox { '' : $$record{'resource.'.$partid.'.awarded'}*$wgt); my $result=''."\n"; + my $display_part=&get_display_part($partid,undef,$symb); $result.='
'. - '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++; } @@ -1363,19 +1443,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 = ''; @@ -1597,11 +1680,12 @@ KEYWORDS 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 '.$partid. - ' Collaborative submission by: '. + my $submitby='Part: '.$display_part. + ' Collaborative submission by: '. ''. @@ -1611,8 +1695,8 @@ KEYWORDS } my $responsetype = $responseType->{$partid}->{$respid}; if (!exists($record{"resource.$partid.$respid.submission"})) { - $lastsubonly.='
'.$ctr."
Part '. - $partid.' ( ID '.$respid. + $lastsubonly.='
Part: '. + $display_part.' ( ID '.$respid. ' )   '. 'Nothing submitted - no attempts

'; next; @@ -1640,11 +1724,30 @@ KEYWORDS if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} eq 'yes')) { - $lastsubonly.='
Part '. - $partid.' ( ID '.$respid. + 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"}) { - $lastsubonly.=' File uploaded by student Like all files provided by users, this file may contain virusses
'; + 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, @@ -1674,12 +1777,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 @@ -1957,10 +2063,12 @@ sub processHandGrade { # 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; + my $ungraded = 0; + my $incorrect = 0; foreach (keys(%status)) { $submitted = 1 if ($status{$_} ne 'nothing'); - $graded = 0 if ($status{$_} =~ /^correct/); + $ungraded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; @@ -1969,8 +2077,8 @@ sub processHandGrade { next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'incorrect' || $submitonly eq 'graded')); - next if (!$graded && ($submitonly eq 'graded' || - $submitonly eq 'incorrect')); + next if (!$ungraded && ($submitonly eq 'graded')); + next if (!$incorrect && $submitonly eq 'incorrect'); } push @nextlist,$student if ($ctr < $ntstu); last if ($ctr == $ntstu); @@ -2005,6 +2113,7 @@ sub saveHandGrade { $ENV{'request.course.id'}); if (!&canmodify($usec)) { return('not_allowed'); } my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$domain,$stuname); + my @parts_graded; my %newrecord = (); my ($pts,$wgt) = ('',''); foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { @@ -2021,11 +2130,11 @@ 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.'_'.$_} : @@ -2039,6 +2148,8 @@ sub saveHandGrade { if ($partial eq $record{'resource.'.$_.'.awarded'}) { #do not update score for part if not changed. next; + } else { + push @parts_graded, $_; } if ($record{'resource.'.$_.'.awarded'} ne $partial) { $newrecord{'resource.'.$_.'.awarded'} = $partial; @@ -2062,12 +2173,27 @@ sub saveHandGrade { } } if (scalar(keys(%newrecord)) > 0) { + &version_portfiles(\%record, \@parts_graded, $ENV{'request.course.id'}, $symb, $domain, $stuname); &Apache::lonnet::cstore(\%newrecord,$symb, $ENV{'request.course.id'},$domain,$stuname); } return '',$pts,$wgt; } +# ----------- Handles creating versions for portfolio files as answers +sub version_portfiles { + my ($record, $parts_graded, $courseid, $symb, $domain, $stuname) = @_; + my $parts = join '|', @$parts_graded; + foreach my $key (sort keys %$record) { + if ($key =~ /^resource\.($parts)\./ && $key =~ /\.portfiles$/) { + &Apache::lonnet::logthis('found key portfiles '.$key); + &Apache::lonnet::logthis('found value portfiles '.$$record{$key}); + } + } + + +} + #-------------------------------------------------------------------------------------- # #-------------------------- Next few routines handles grading by section or whole class @@ -2243,8 +2369,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 @@ -2263,7 +2395,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'}.''; @@ -2290,7 +2422,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 @@ -2329,14 +2462,17 @@ sub viewgrades { 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.=''; @@ -2345,9 +2481,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); @@ -2371,18 +2504,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"; @@ -2391,7 +2527,7 @@ sub viewstudentgrade { $status = 'nothing' if ($status eq ''); $result.=''."\n"; - $result.=''."\n"; } @@ -2466,9 +2602,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 .= ''; @@ -2562,7 +2699,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 .= '
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}.')
No Changes Occurred For the Students Below
No Changes Occurred For the Students Below
'."\n". &show_grading_menu_form ($symb,$url); @@ -2591,24 +2728,26 @@ sub split_part_type { # #--- Javascript to handle csv upload sub csvupload_javascript_reverse_associate { + my $error1=&mt('You need to specify the username or ID'); + my $error2=&mt('You need to specify at least one grading field'); return(<2) { foundsomething=1; } - } - if (founduname==0 || founddomain==0) { - alert('You need to specify at both the username and domain'); - return; + if (tw==1) { foundID=1; } + if (tw==2) { founduname=1; } + if (tw>3) { foundsomething=1; } + } + if (founduname==0 && foundID==0) { + alert('$error1'); + return; } if (foundsomething==0) { - alert('You need to specify at least one grading field'); - return; + alert('$error2'); + return; } vf.submit(); } @@ -2673,7 +2814,8 @@ sub csvuploadmap_header { } my ($result) = &showResourceInfo($url,$ENV{'form.probTitle'}); - + my $checked=(($ENV{'form.noFirstLine'})?' checked="checked"':''); + my $ignore=&mt('Ignore First Line'); $request->print(<

Uploading Class Grades

@@ -2684,6 +2826,7 @@ Total number of records found in file: $ Enter as many fields as you can. The system will inform you and bring you back to this page if the data selected is insufficient to run your class.
+ @@ -2695,7 +2838,7 @@ to this page if the data selected is ins - +
+ +
+ $default_form_data + + + + File to upload: +
+ +
+UPLOAD + + $r->print(< +SCANTRONFORM + } + $r->print(< +
+ + + + + + + + + + + + +
+  Download a scoring office file +
Filename of scoring office file: $file_selector
+ +
+ +
+ +SCANTRONFORM + + $r->print(< - - $grading_menu_button SCANTRONFORM - return $result; + return } sub get_scantron_config { @@ -3508,7 +3874,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', @@ -3520,6 +3886,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'}; @@ -3550,14 +3931,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 } @@ -3573,6 +3961,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) { @@ -3580,25 +3970,49 @@ 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,-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); - } + if ($$scantron_config{'Qon'} eq 'letter') { + if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || + $currentquest !~ /^[A-Z]$/) { + $record{"scantron.$questnum.answer"}=''; + if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { + push(@{$record{"scantron.missingerror"}},$questnum); + } + } else { + $record{"scantron.$questnum.answer"}=$currentquest; + } + } elsif ($$scantron_config{'Qon'} eq 'number') { + if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || + $currentquest !~ /^\d$/) { + $record{"scantron.$questnum.answer"}=''; + if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { + push(@{$record{"scantron.missingerror"}},$questnum); + } + } else { + $record{"scantron.$questnum.answer"}= + $alphabet[$currentquest-1]; + } } else { - $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])]; + 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); + } + } } - 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; @@ -3628,31 +4042,20 @@ sub scantron_find_student { 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; } -#FIXME I think I am doing this in the wrong order, I think it would be -#better to make a several passes analyzing all of the lines in the -#file for common errors wrong/invalid PID/username duplicated -#PID/username, missing bubbles, double bubbles, missing/invalid CODE -#and then get the instructor to fix all of these errors, then grade -#the corrected one, I'll still need to catch error conditions, but -#maybe most will taken care even before we start - -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 $line=&scantron_get_line($scanlines,$scan_data,$which); my ($skip,$err,$errmsg); if ($ENV{'form.scantron_skip_record'}) { $skip=1; @@ -3665,6 +4068,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)= @@ -3678,31 +4101,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' +

+ + + +
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', @@ -3710,14 +4257,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]."

"); @@ -3729,9 +4272,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(""); @@ -3747,18 +4295,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'}; @@ -3778,7 +4357,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); @@ -3796,34 +4375,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; @@ -3842,7 +4435,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); @@ -3856,13 +4449,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 { @@ -3872,18 +4465,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); } } } @@ -3898,7 +4491,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"); @@ -3906,19 +4499,21 @@ sub scantron_get_correction { $r->print(" in scanline $i 

".
 		  $line."
\n"); } + my $message="

The ID on the form is ". + $$scan_record{'scantron.ID'}."
\n". + "The name on the paper is ". + $$scan_record{'scantron.LastName'}.",". + $$scan_record{'scantron.FirstName'}."

"; + $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"); } - $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($message); $r->print("

How should I handle this?
\n"); $r->print("\n

  • "); #FIXME it would be nice if this sent back the user ID and @@ -3927,14 +4522,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($message); + $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(''); + $r->print($message); $r->print("

    Please indicate which bubble should be used for grading

    "); foreach my $question (@{$arg}) { my $selected=$$scan_record{"scantron.$question.answer"}; @@ -3942,6 +4584,7 @@ sub scantron_get_correction { } } elsif ($error eq 'missingbubble') { $r->print("

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

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

    Please indicate which bubble should be used for grading

    "); $r->print("Some questions have no scanned bubbles\n"); $r->print('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, - 'last student'); - #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 ''; } @@ -4168,9 +4884,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) { @@ -4183,12 +4901,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 @@ -4197,7 +4918,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'}; @@ -4214,20 +4953,75 @@ 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 ------- # #------------------------------------------------------------------- - #-------------------------- Menu interface ------------------------- # #--- Show a Grading Menu button - Calls the next routine --- @@ -4280,6 +5074,7 @@ sub gradingmenu { if (!checkReceiptNo(formname,'notOK')) { return false;} formname.submit(); } + if (val < 7) formname.submit(); } function checkReceiptNo(formname,nospace) { @@ -4325,26 +5120,23 @@ GRADINGMENUJS $result.=''; $result.=''; $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"; } + $result.=''."\n"; $result.='
    '."\n". - ' Select Section: '."\n"; if (ref($sections)) { foreach (sort (@$sections)) { $result.=''."\n"; } } - $result.= '   '; - $result.='Student Status:'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); + $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); - if (ref($sections) && (grep /no/,@$sections)) { - $result.=' (Section "no" implies the students were not assigned a section.)
    '; - } $result.='
    '. ' '.'Current Resource: For one or more students '. - ''. ''. '
    '. ' scantron forms
    '. - ''. - ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). + ''. + ' '.&mt('receipt').': '. + &Apache::lonnet::recprefix($ENV{'request.course.id'}). '-'. '
    '. + ' access times.
    '."\n". ''."\n". @@ -4485,9 +5281,9 @@ sub handler { $request->print(&csvupload($request)); } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) { $request->print(&csvuploadmap($request)); - } elsif ($command eq 'csvuploadassign' && $perm{'mgr'}) { + } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) { if ($ENV{'form.associate'} ne 'Reverse Association') { - $request->print(&csvuploadassign($request)); + $request->print(&csvuploadoptions($request)); } else { if ( $ENV{'form.upfile_associate'} ne 'reverse' ) { $ENV{'form.upfile_associate'} = 'reverse'; @@ -4496,21 +5292,27 @@ sub handler { } $request->print(&csvuploadmap($request)); } + } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) { + $request->print(&csvuploadassign($request)); } 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_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)); - + (&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.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("Access Denied ($command)"); } @@ -4533,8 +5335,7 @@ sub send_header { sub send_footer { my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); + $request->print(''); } 1;