--- loncom/homework/grades.pm 2004/02/24 23:22:24 1.177 +++ loncom/homework/grades.pm 2004/04/24 08:31:57 1.188 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.177 2004/02/24 23:22:24 albertel Exp $ +# $Id: grades.pm,v 1.188 2004/04/24 08:31:57 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -511,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'}; @@ -531,7 +531,6 @@ sub verifyreceipt { if ($ENV{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } my $parts=['0']; if ($receiptparts) { ($parts)=&response_type($url,$symb); } - $request->print("got Parts ".join(':',@$parts)); foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { my ($uname,$udom)=split(/\:/); foreach my $part (@$parts) { @@ -1296,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++; } @@ -1705,8 +1704,10 @@ KEYWORDS ($ENV{'form.command'} eq 'processGroup' && $counter == $total)) { $toGrade.=''.&show_grading_menu_form($symb,$url) } - $request = print($toGrade); + $request->print($toGrade); return; + } else { + $request->print('
'.$ctr."
'."\n"); } # essay grading message center @@ -3444,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); @@ -3453,6 +3478,8 @@ 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, @@ -3460,7 +3487,7 @@ sub scantron_selectphase {
-
+ $default_form_data @@ -3479,6 +3506,12 @@ sub scantron_selectphase { + + + + + + + + + + @@ -3546,6 +3586,40 @@ UPLOAD SCANTRONFORM } + $r->print(< + + +SCANTRONFORM $r->print(< @@ -3602,7 +3676,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', @@ -3614,6 +3688,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'}; @@ -3644,7 +3731,7 @@ sub scan_data { } sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data)=@_; + my ($line,$whichline,$scantron_config,$scan_data,$justCODE)=@_; my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); @@ -3656,6 +3743,7 @@ sub scantron_parse_scanline { #FIXME interpret first N questions } } + if ($justCODE) { return \%record; } $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, $$scantron_config{'IDlength'}); $record{'scantron.PaperID'}= @@ -3747,6 +3835,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)= @@ -3940,7 +4033,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 { @@ -3987,7 +4080,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"); @@ -4005,9 +4098,47 @@ sub scantron_get_correction { 'scantron_username','scantron_domain')); $r->print(": "); $r->print("\n@". - &Apache::loncommon::select_dom_form($ENV{'request.role..domain'},'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 CODE on the form is ". + $$scan_record{'scantron.CODE'}."
\n"); + $r->print("

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

"); + $r->print("

How should I handle this?
\n"); + $r->print("\n
"); + $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.scan_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"); @@ -4059,6 +4190,48 @@ sub scantron_bubble_selector { sub scantron_validate_CODE { my ($r,$currentphase) = @_; #FIXME doesn't do anything yet + my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + if ($scantron_config{'CODElocation'} && + $scantron_config{'CODEstart'} && + $scantron_config{'CODElength'}) { + if (!$ENV{'form.scantron_CODElist'}) { + &FIXME_blow_up() + } + } else { + &Apache::lonnet::logthis(" CODE stuf $scantron_config{'CODElocation'}:$scantron_config{'CODEstart'}:$scantron_config{'CODElength'}"); + return (0,$currentphase+1); + } + + my %usedCODEs; + + my $old_name=$ENV{'form.scantron_CODElist'}; + my $cdom =$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cnum =$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my %result=&Apache::lonnet::get('CODEs',[$old_name],$cdom,$cnum); + my %allcodes=map {($_,1)} split(',',$result{$old_name}); + + my ($scanlines,$scan_data)=&scantron_getfile(); + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $CODE=$$scan_record{'scantron.CODE'}; + my $error=0; + if (!exists($allcodes{$CODE})) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectCODE',$CODE); + return(1); + } + if (exists($usedCODEs{$CODE}) && $ENV{'form.scantron_CODEunique'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateCODE',$CODE); + return(1); + } + $usedCODEs{$CODE}++; + } return (0,$currentphase+1); } @@ -4203,7 +4376,8 @@ 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)); @@ -4220,12 +4394,14 @@ sub scantron_upload_scantron_data {
$default_form_data -Course: -Domain: $domsel $select_link -
+
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: @@ -3486,6 +3519,13 @@ sub scantron_selectphase {
Options: + Redo skipped records
+ Ignore Original Corrections +
+ + + + + + + + + + + + + + + + +
+  Download a scoring office file +
Filename of scoring office file: $file_selector
+ Records to download + + Skipped Records
+ Corrected Records
+ Original Records +
+ +
+ +
+ + + + + +
$select_link
Course ID:
Course Name:
Domain: $domsel
File to upload:
-File to upload: -
UPLOAD @@ -4234,11 +4410,21 @@ UPLOAD sub scantron_upload_scantron_data_save { my($r)=@_; + 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.
"); - $r->print(&show_grading_menu_form(&get_symb_and_url($r))); + if ($symb) { + $r->print(&show_grading_menu_form($symb,$url)); + } else { + $r->print($doanotherupload); + } return ''; } $r->print("Doing upload to ".$ENV{'form.courseid'}."
"); @@ -4259,17 +4445,20 @@ sub scantron_upload_scantron_data_save { # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } $fname='scantron_orig_'.$fname; - $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, - $ENV{'form.domainid'}, - $home,'upfile',$fname)); - my ($symb,$url)=&get_symb_and_url($r); + 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(&get_symb_and_url($r))); + $r->print(&show_grading_menu_form($symb,$url)); } else { - $r->print('
'."\n". - ''."\n". - ''."\n". - '
'."\n"); + $r->print($doanotherupload); } return ''; } @@ -4424,17 +4613,18 @@ 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"; }
'. - ''. - ' scores from file
'. ' scantron forms
'. - ''. - ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). + ''. + ' '.&mt('receipt').': '. + &Apache::lonnet::recprefix($ENV{'request.course.id'}). '-'. '