--- loncom/homework/grades.pm 2003/11/21 21:31:34 1.160 +++ loncom/homework/grades.pm 2004/04/20 06:11:49 1.186 @@ -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.186 2004/04/20 06:11:49 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -48,6 +48,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,10 +89,15 @@ 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 ''; } + if ($symb eq '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } + } return ($symb,$url); } @@ -168,7 +174,7 @@ sub showResourceInfo { my $col=3; if ($checkboxes) { $col=4; } my $result =''. - ''."\n"; my ($partlist,$handgrade,$responseType) = &response_type($url); my %resptype = (); @@ -290,7 +296,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; } @@ -504,7 +511,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 +526,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 +559,11 @@ sub verifyreceipt { '
Current Resource: '. + '
'.&mt('Current Resource').': '. $probTitle.'
 '."\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); @@ -678,10 +697,11 @@ 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; foreach (keys(%status)) { $submitted = 1 if ($status{$_} ne 'nothing'); - $graded = 0 if ($status{$_} =~ /^correct/); + $graded = 1 if ($status{$_} !~ /^correct/); + my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; @@ -735,9 +755,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/; @@ -1272,10 +1295,10 @@ sub gradeBox { 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++; } @@ -1375,7 +1398,9 @@ sub submission { 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 = ''; @@ -1644,7 +1669,7 @@ KEYWORDS $partid.'( ID '.$respid. ' )   '; if ($record{"resource.$partid.$respid.uploadedurl"}) { - $lastsubonly.=' File uploaded by studentLike all files provided by users, this file may contain virusses
'; + $lastsubonly.=' File uploaded by studentLike all files provided by users, this file may contain virusses
'; } $lastsubonly.='Submitted Answer: '. &cleanRecord($subval,$responsetype,$symb,$partid, @@ -1674,12 +1699,15 @@ KEYWORDS my $toGrade.='  '."\n" if (&canmodify($usec)); - $toGrade.='
'.$ctr."
'."\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 @@ -2243,8 +2271,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 @@ -3027,6 +3061,14 @@ sub displayPage { my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); my ($uname,$udom) = split(/:/,$ENV{'form.student'}); my $usec=$classlist->{$ENV{'form.student'}}[5]; + + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + if (!&canview($usec)) { $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); $request->print(&show_grading_menu_form($symb,$url)); @@ -3198,7 +3240,7 @@ sub displaySubByDates { } if (exists $$record{"$version:resource.$partid.regrader"}) { $displaySub[2].=$$record{"$version:resource.$partid.regrader"}. - ' (Part: '.$partid.')'; + ' ('.&mt('Part').': '.$partid.')'; } } # needed because old essay regrader has not parts info @@ -3379,7 +3421,7 @@ sub scantron_uploads { my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, - &Apache::locommon::propath($cdom,$cname)); + &Apache::loncommon::propath($cdom,$cname)); foreach my $filename (@files) { ($filename)=split(/&/,$filename); if ($filename!~/^scantron_orig_/) { next ; } @@ -3403,6 +3445,30 @@ sub scantron_scantab { return $result; } +sub scantron_CODElist { + my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum); + my $namechoice=''; + foreach my $name (@names) { + $namechoice.=''; + } + $namechoice=''; + return $namechoice; +} + +sub scantron_CODEunique { + my $result=' + Yes + + + No + '; + return $result; +} + sub scantron_selectphase { my ($r) = @_; my ($symb,$url)=&get_symb_and_url($r); @@ -3412,54 +3478,115 @@ sub scantron_selectphase { my $grading_menu_button=&show_grading_menu_form($symb,$url); my $file_selector=&scantron_uploads(); my $format_selector=&scantron_scantab(); + my $CODE_selector=&scantron_CODElist(); + my $CODE_unique=&scantron_CODEunique(); my $result; #FIXME allow instructor to be able to download the scantron file # and to upload it, $result.= < - - $default_form_data - +
+SCANTRONFORM + + $r->print($result); + + if (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'}) || + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + + $r->print(< + + +SCANTRONFORM + } + + $r->print(< - $grading_menu_button SCANTRONFORM - return $result; + return } sub get_scantron_config { @@ -3508,7 +3635,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 +3647,19 @@ sub scantron_fixup_scanline { &scan_data($scan_data,"$whichline.user", $args->{'username'}.':'.$args->{'domain'}); } + } elsif ($field eq 'CODE') { + 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'}; + if ($args->{'CODE'}=~/^\s*$/) { + &scan_data($scan_data,"$whichline.CODE",$args->{'CODE'}); + } } elsif ($field eq 'answer') { my $length=$scantron_config->{'Qlength'}; my $off=$scantron_config->{'Qoff'}; @@ -3634,18 +3774,6 @@ sub scantron_filter { 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'}); @@ -3665,6 +3793,11 @@ 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 $newCODE=$ENV{'form.scantron_CODE'}; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'CODE',{'CODE'=>$newCODE}); } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { foreach my $question (split(',',$ENV{'form.scantron_questions'})) { ($line,$err,$errmsg)= @@ -3755,10 +3888,6 @@ sub scantron_getfile { 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 +3907,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); @@ -3810,7 +3939,7 @@ sub scantron_putfile { &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), $prefix.'skipped_'. $ENV{'form.scantron_selectfile'}); - &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname); + &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); } sub scantron_get_line { @@ -3862,7 +3991,7 @@ sub scantron_validate_ID { $line,'duplicateID',$username); return(1); } - #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 { @@ -3898,7 +4027,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"); @@ -3909,7 +4038,7 @@ sub scantron_get_correction { $r->print(''."\n"); $r->print(''."\n"); if ($error =~ /ID$/) { - if ($error eq 'unknownID') { + if ($error eq 'incorrectID') { $r->print("The encoded ID is not in the classlist

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

\n"); @@ -3927,9 +4056,23 @@ 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 $arg, and CODEs were supposed to be unique

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

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

"); + $r->print("

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

+
+ + $default_form_data - - + - + - + + + + + + + + + +
-  Specify file location and which Folder/Sequence to grade + +  Specify file and which Folder/Sequence to grade
- Sequence to grade: $sequence_selector - Sequence to grade: $sequence_selector
- Filename of scoring office file: $file_selector - Filename of scoring office file: $file_selector
- Format of data file: $format_selector - Format of data file: $format_selector
Saved CODEs to validate against: $CODE_selector
Each CODE is only to be used once: $CODE_unique
- Last line to expect an answer on: + Last line to expect an answer on:
+ +
+
+ + + + + + +
+  Specify a Scantron data file to upload. +
+SCANTRONFORM + my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + my $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cnum= $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + $r->print(< + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("Please use the browse button to select a file from your local directory."); + return false; + } + formname.submit(); + } + + +
+ $default_form_data + + + + File to upload: +
+ +
+UPLOAD + + $r->print(< +
+
+ + + + + +
$select_link
Course ID:
Course Name:
Domain: $domsel
File to upload:
-File to upload: -
UPLOAD @@ -4197,7 +4344,24 @@ 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 ''; + } + $r->print("Doing upload to ".$ENV{'form.courseid'}."
"); my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'}, $ENV{'form.domainid'}); my $fname=$ENV{'form.upfile.filename'}; @@ -4215,10 +4379,21 @@ sub scantron_upload_scantron_data_save { # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } $fname='scantron_orig_'.$fname; - &Apache::lonnet::logthis("fname is $fname"); - $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, - $ENV{'form.domainid'}, - $home,'upfile',$fname)); + 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.") occured when attempting to upload the file, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"').""); + } + } + if ($symb) { + $r->print(&show_grading_menu_form($symb,$url)); + } else { + $r->print($doanotherupload); + } return ''; } @@ -4325,7 +4500,7 @@ GRADINGMENUJS $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"; } @@ -4505,12 +4681,16 @@ sub handler { } 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 'scantrondownload' && + &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + $request->print(&scantron_download_scantron_data($request)); } elsif ($command) { $request->print("Access Denied ($command)"); }
'."\n". - ' Select Section: '."\n"; if (ref($sections)) { foreach (sort (@$sections)) { $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'}). '-'. '