--- loncom/homework/grades.pm 2003/10/14 22:52:24 1.130.2.1.2.10 +++ loncom/homework/grades.pm 2003/11/04 19:38:09 1.146 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.130.2.1.2.10 2003/10/14 22:52:24 albertel Exp $ +# $Id: grades.pm,v 1.146 2003/11/04 19:38:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -55,17 +55,35 @@ my %perm=(); # ----- These first few routines are general use routines.---- # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_(\w+)_.*/) { - push(@parts,$key); + my ($url,$symb) = @_; + my $partorder = &Apache::lonnet::metadata($url, 'partorder'); + my @parts; + if ($partorder) { + for my $part (split (/,/,$partorder)) { + if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { + push(@parts, $part); + } + } + } else { + my $metadata = &Apache::lonnet::metadata($url, 'packages'); + foreach (split(/\,/,$metadata)) { + if ($_ =~ /^part_(.*)$/) { + if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { + push(@parts, $1); + } + } } } - return @parts; + my @stores; + foreach my $part (@parts) { + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } + } + } + return @stores; } # --- Get the symbolic name of a problem and the url @@ -120,6 +138,9 @@ sub response_type { if (/^\w+response_\w+.*/) { my ($responsetype,$part) = split(/_/,$_,2); my ($partid,$respid) = split(/_/,$part); + if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { + next; + } $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'); @@ -185,7 +206,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; } @@ -218,7 +239,8 @@ sub commonJSfunctions { } } } else { - if (selectOne.selected) return selectOne.value; + // only one value it must be the selected one + return selectOne.value; } } @@ -506,9 +528,12 @@ LISTJAVASCRIPT my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; my $gradeTable='
'."\n". - ' View Problem Text: no '."\n". + ' View Problem Text: no '."\n". ' one student '."\n". ' all students
'."\n". + ' View Answer: no '."\n". + ' one student '."\n". + ' all students
'."\n". ' Submissions: '."\n"; if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { $gradeTable.=' essay part only'."\n"; @@ -517,8 +542,8 @@ LISTJAVASCRIPT my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'}; $ENV{'form.Status'} = $saveStatus; - $gradeTable.=' last sub only'."\n". - ' last sub & parts info'."\n". + $gradeTable.=' last submission only'."\n". + ' last submission & parts info'."\n". ' by dates and submissions'."\n". ' all details'."\n". ''."\n". @@ -544,7 +569,7 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; - + $gradeTable.='Check For Plagiarism'; my (undef, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.=''."\n"; + ($saveCmd eq 'submission' ? 'checked' : '').'> '.'Current Resource: For one or more students '. + ''."\n"; $result.='
'. ''; @@ -568,18 +593,21 @@ LISTJAVASCRIPT my %status = (); if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); - my $statusflg = ''; + my $submitted = 0; + my $graded = 1; foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 0 if ($status{$_} =~ /^correct/); my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { - $statusflg = ''; + $submitted = 0; $gradeTable.=''; } } - next if ($statusflg eq '' && $submitonly eq 'yes'); + next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); + next if (!$graded && $submitonly eq 'graded'); } $ctr++; @@ -621,7 +649,7 @@ LISTJAVASCRIPT } else { $gradeTable='
 '. 'No submissions found for this resource for any students. ('.$num_students. - ' checked for submissions
'; + ' checked for submissions)
'; } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; @@ -1195,27 +1223,46 @@ sub gradeBox { } sub show_problem { - my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_; - my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $ENV{'request.course.id'}); + my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_; + my $rendered; + if ($mode eq 'both' or $mode eq 'text') { + $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, + $ENV{'request.course.id'}); + } if ($removeform) { $rendered=~s|||g; $rendered=~s|||g; $rendered=~s|name="submit"|name="would_have_been_submit"|g; } - my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $ENV{'request.course.id'}); + my $companswer; + if ($mode eq 'both' or $mode eq 'answer') { + $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $ENV{'request.course.id'}); + } if ($removeform) { $companswer=~s|||g; $companswer=~s|||g; - $rendered=~s|name="submit"|name="would_have_been_submit"|g; + $companswer=~s|name="submit"|name="would_have_been_submit"|g; } my $result.='
'; $result.=''; - $result.='' if ($viewon); - $result.=''; + } + if ($mode eq 'both') { + $result.='
View of the problem - '.$ENV{'form.fullname'}. - '
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; + if ($viewon) { + $result.='
'; + if ($mode eq 'both' or $mode eq 'text') { + $result.='View of the problem - '; + } else { + $result.='Correct answer: '; + } + $result.=$ENV{'form.fullname'}.'
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + } elsif ($mode eq 'text') { + $result.='
'.$rendered; + } elsif ($mode eq 'answer') { + $result.='
'.$companswer; + } $result.='
'; $result.='

'; return $result; @@ -1264,8 +1311,16 @@ sub submission { # option to display problem, only once else it cause problems # with the form later since the problem has a form. - if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) { - $request->print(&show_problem($request,$symb,$uname,$udom,0,1)); + if ($ENV{'form.vProb'} eq 'yes' or $ENV{'form.vAns'} eq 'yes') { + my $mode; + if ($ENV{'form.vProb'} eq 'yes' && $ENV{'form.vAns'} eq 'yes') { + $mode='both'; + } elsif ($ENV{'form.vProb'} eq 'yes') { + $mode='text'; + } elsif ($ENV{'form.vAns'} eq 'yes') { + $mode='answer'; + } + $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); } # kwclr is the only variable that is guaranteed to be non blank @@ -1300,6 +1355,7 @@ sub submission { ''."\n". ''."\n". ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -1350,10 +1406,19 @@ KEYWORDS } } - if ($ENV{'form.vProb'} eq 'all') { + if ($ENV{'form.vProb'} eq 'all' or $ENV{'form.vAns'} eq 'all') { $request->print('


') if ($counter > 0); - $request->print(&show_problem($request,$symb,$uname,$udom,1,1)); + my $mode; + if ($ENV{'form.vProb'} eq 'all' && $ENV{'form.vAns'} eq 'all') { + $mode='both'; + } elsif ($ENV{'form.vProb'} eq 'all' ) { + $mode='text'; + } elsif ($ENV{'form.vAns'} eq 'all') { + $mode='answer'; + } + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode)); } + my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); my ($partlist,$handgrade) = &response_type($url,$symb); @@ -1461,13 +1526,20 @@ KEYWORDS my ($ressub,$subval) = split(/:/,$_,2); # Similarity check my $similar=''; - my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); - if ($osim) { - $osim=int($osim*100.0); - $similar='

Essay is '.$osim. - '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). - '

'. - &keywords_highlight($oessay).'
'; + my $oname; + my $odom; + my $ocrsid; + my $oessay; + my $osim; + if($ENV{'form.checkPlag'}){ + ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval); + if ($osim) { + $osim=int($osim*100.0); + $similar='

Essay is '.$osim. + '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom). + '

'. + &keywords_highlight($oessay).'
'; + } } $lastsubonly.='
Part '. $partid.' ( ID '.$respid. @@ -1480,7 +1552,7 @@ KEYWORDS 'this file may contain virusses
':''). 'Submitted Answer: '. &cleanRecord($subval,$responsetype,$symb). - '

'.$similar."\n" + '

'.$similar."\n" if ($ENV{'form.lastSub'} eq 'lastonly' || ($ENV{'form.lastSub'} eq 'hdgrade' && $$handgrade{$part} =~ /:yes$/)); @@ -1782,15 +1854,25 @@ sub processHandGrade { } $ctr = 0; @parsedlist = reverse @parsedlist if ($button eq 'Previous'); + my ($partlist) = &response_type($url); foreach my $student (@parsedlist) { + my $submitonly=$ENV{'form.submitonly'}; my ($uname,$udom) = split(/:/,$student); - if ($ENV{'form.submitonly'} eq 'yes') { - my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my $statusflg = ''; - foreach (split(/:/,$ENV{'form.gradePartRespid'})){ - $statusflg = 1 if (exists ($record{'resource.'.$_.'.submission'})); + if ($submitonly =~ /^(yes|graded)$/) { +# 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; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 0 if ($status{$_} =~ /^correct/); + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } } - next if ($statusflg eq ''); + next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); + next if (!$graded && $submitonly eq 'graded'); } push @nextlist,$student if ($ctr < $ntstu); last if ($ctr == $ntstu); @@ -2132,7 +2214,7 @@ sub viewgrades { $result.= ' @@ -3238,7 +3306,6 @@ 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; } @@ -3255,12 +3322,6 @@ 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; @@ -3276,53 +3337,8 @@ 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,$whichline,$scantron_config,$scan_data)=@_; + my ($line,$scantron_config)=@_; my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); @@ -3336,15 +3352,6 @@ 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) { @@ -3352,25 +3359,17 @@ 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); + 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.'

'); + } if (length($array[0]) eq $$scantron_config{'Qlength'}) { $record{"scantron.$questnum.answer"}=''; - if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { - push(@{$record{"scantron.missingerror"}},$questnum); - } } else { $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])]; } - if (scalar(@array) gt 2) { - push(@{$record{'scantron.doubleerror'}},$questnum); - my @ans=@array; - my $i=length($ans[0]);shift(@ans); - while ($#ans) { - $i+=length($ans[0])+1; - $record{"scantron.$questnum.answer"}.=$alphabet[$i]; - shift(@ans); - } - } } $record{'scantron.maxquest'}=$questnum; return \%record; @@ -3378,6 +3377,7 @@ sub scantron_parse_scanline { sub scantron_add_delay { my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; + Apache->request->print('add_delay_error '.$_[2] ); push(@$delayqueue, {'line' => $scanline, 'emsg' => $errormessage, 'ecode' => $errorcode } @@ -3385,13 +3385,12 @@ sub scantron_add_delay { } sub scantron_find_student { - my ($scantron_record,$scan_data,$idmap,$line)=@_; + my ($scantron_record,$idmap)=@_; 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}; } } @@ -3406,411 +3405,31 @@ 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); - } -} - +#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) = @_; - my ($symb,$url)=&get_symb_and_url($r); - if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); - - if ($ENV{'form.scantron_corrections'}) { - &scantron_process_corrections($r); - } - #get the student pick code ready - $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= < - - - - - $default_form_data -SCANTRONFORM - $r->print($result); - - my @validate_phases=( 'ID', - 'CODE', - 'doublebubble', - 'missingbubbles'); - if (!$ENV{'form.validatepass'}) { - $ENV{'form.valiadatepass'} = 0; - } - my $currentphase=$ENV{'form.valiadatepass'}; - - if ($ENV{'form.scantron_selectfile'}=~m-^/-) { - #first pass copy file to classdir - - } - my $stop=0; - while (!$stop && $currentphase < scalar(@validate_phases)) { - $r->print("

Validating ".$validate_phases[$currentphase]."

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

An error was detected ($error) "); - if ( defined($$scan_record{'scantron.PaperID'}) ) { - $r->print(" for PaperID ". - $$scan_record{'scantron.PaperID'}." \n"); - } else { - $r->print(" in scanline $i 

".
-		  $line."
\n"); - } - $r->print(''."\n"); - $r->print(''."\n"); - if ($error =~ /ID$/) { - if ($error eq 'unknownID') { - $r->print("The encoded ID is not in the classlist

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

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

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

"); - $r->print("

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

  • "); - #FIXME it would be nice if this sent back the user ID and - #could do partial userID matches - $r->print(&Apache::loncommon::selectstudent_link('scantronupload', - 'scantron_username','scantron_domain')); - $r->print(": "); - $r->print("\n@". - &Apache::loncommon::select_dom_form(undef,'scantron_domain')); - - $r->print('
    • '); - } elsif ($error eq 'doublebubble') { -#FIXME Need to print out who this is along with the paper info - $r->print("

    There have been multiple bubbles scanned for a some question(s)

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

    Please indicate which bubble should be used for grading

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

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

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

    Please indicate which bubble should be used for grading

    "); - $r->print("Some questions have no scanned bubbles\n"); - $r->print(''); - foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; - &scantron_bubble_selector($r,$scan_config,$question); - } - } else { - $r->print("\n
      "); - } - $r->print("\n
    "); - -} - -sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected)=@_; - my $max=$$scan_config{'Qlength'}; - my @alphabet=('A'..'Z'); - $r->print("
'."\n". ''. '\n"; - my (@parts) = sort(&getpartlist($url)); + my (@parts) = sort(&getpartlist($url,$symb)); foreach my $part (@parts) { my $display=&Apache::lonnet::metadata($url,$part.'.display'); $display =~ s|^Number of Attempts|Tries
|; # makes the column narrower @@ -2249,7 +2331,7 @@ sub editgrades { my %columns = (); my ($i,$ctr,$count,$rec_update) = (0,0,0,0); - my (@parts) = sort(&getpartlist($url)); + my (@parts) = sort(&getpartlist($url,$symb)); my $header; while ($ctr < $ENV{'form.totalparts'}) { my $partid = $ENV{'form.partid_'.$ctr}; @@ -2327,18 +2409,17 @@ sub editgrades { $newrecord{'resource.'.$_.'.awarded'} = 0; $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; $updateflag = 1; + } elsif (!($old_part eq $partial && $old_score eq $score)) { + $updateflag = 1; + $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; + $newrecord{'resource.'.$_.'.solved'} = $score; + $rec_update++; } $line .= ''. ''; - if (!($old_part eq $partial && $old_score eq $score)) { - $updateflag = 1; - $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne ''; - $newrecord{'resource.'.$_.'.solved'} = $score; - $rec_update++; - } my $partid=$_; foreach my $stores (@parts) { @@ -2515,8 +2596,8 @@ ENDPICK } sub csvupload_fields { - my ($url) = @_; - my (@parts) = &getpartlist($url); + my ($url,$symb) = @_; + my (@parts) = &getpartlist($url,$symb); my @fields=(['username','Student Username'],['domain','Student Domain']); foreach my $part (sort(@parts)) { my @datum; @@ -2599,7 +2680,7 @@ sub csvuploadmap { &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url); + my @fields=&csvupload_fields($url,$symb); if ($ENV{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); @@ -2726,7 +2807,9 @@ LISTJAVASCRIPT $result.=''."\n"; $result.=' Problems from:'."\n". ''."\n"; - $result.=' View Problems Text: no '."\n". + $result.=' View Problems Text: no '."\n". ' yes '."
\n"; $result.=' Submission Details: '. @@ -2798,9 +2881,7 @@ LISTJAVASCRIPT sub getSymbMap { my ($request) = @_; - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db'); -# $navmap->init(); + my $navmap = Apache::lonnavmaps::navmap->new(); my %symbx = (); my @titles = (); @@ -2845,9 +2926,8 @@ sub displayPage { &sub_page_js($request); $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps my $iterator = $navmap->getIterator($map->map_start(), @@ -2888,8 +2968,9 @@ sub displayPage { $studentTable.=''; $studentTable.=' - - -
 No. '.&nameUserString('header')."'.$old_aw.' '.$awarded. ($score eq 'excused' ? $score : '').' 
'.$question. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'		'; - if ($ENV{'form.vProb'} eq 'yes') { - $studentTable.=&show_problem($request,$symbx,$uname,$udom,1); + if ($ENV{'form.vProb'} eq 'yes' ) { + $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, + undef,'both'); } else { my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'}); $companswer =~ s|||g; @@ -3008,9 +3089,8 @@ sub updateGradeByPage { $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps my $iterator = $navmap->getIterator($map->map_start(), @@ -3132,7 +3212,7 @@ sub getSequenceDropDown { my ($request,$symb)=@_; my $result=''; - 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::loncreatecourse::propath($cdom,$cname)); + opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'}); + my @files=sort(readdir(DIR)); foreach my $filename (@files) { - ($filename)=split(/&/,$filename); - if ($filename!~/^scantron_orig_/) { next ; } - $filename=~s/^scantron_orig_//; + if ($filename eq '.' or $filename eq '..') { next; } $result.="\n"; } + closedir(DIR); $result.=""; return $result; } @@ -3185,8 +3262,6 @@ sub scantron_selectphase { my $file_selector=&scantron_uploads(); my $format_selector=&scantron_scantab(); my $result; - #FIXME allow instructor to be able to download the scantron file - # and to upload it, $result.= < @@ -3215,13 +3290,6 @@ sub scantron_selectphase { Format of data file: $format_selector
- - Last line to expect an answer on: - -
"); - for (my $i=0;$i<$max+1;$i++) { - $r->print(''); - } - $r->print(''); - for (my $i=0;$i<$max;$i++) { - $r->print('"); - } - $r->print(''); - $r->print('
$quest'); - if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } - else { $r->print(' '); } - $r->print('
'.$alphabet[$i]." No bubble
'); -} - -sub scantron_validate_CODE { - my ($r,$currentphase) = @_; - #FIXME doesn't do anything yet - return (0,$currentphase+1); -} - -sub scantron_validate_doublebubble { - my ($r,$currentphase) = @_; - #get student info - my $classlist=&Apache::loncoursedata::get_classlist(); - my %idmap=&username_to_idmap($classlist); - - #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my ($scanlines,$scan_data)=&scantron_getfile(); - for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); - if ($line=~/^[\s\cz]*$/) { next; } - my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); - if (!defined($$scan_record{'scantron.doubleerror'})) { next; } - &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, - 'doublebubble', - $$scan_record{'scantron.doubleerror'}); - return (1,$currentphase); - } - return (0,$currentphase+1); -} - -sub scantron_validate_missingbubbles { - my ($r,$currentphase) = @_; - #get student info - my $classlist=&Apache::loncoursedata::get_classlist(); - my %idmap=&username_to_idmap($classlist); - - #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my ($scanlines,$scan_data)=&scantron_getfile(); - my $max_bubble=$ENV{'form.scantron_maxbubble'}; - if (!$max_bubble) { $max_bubble=2**31; } - for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); - if ($line=~/^[\s\cz]*$/) { next; } - my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); - if (!defined($$scan_record{'scantron.missingerror'})) { next; } - my @to_correct; - foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { - if ($missing > $max_bubble) { next; } - push(@to_correct,$missing); - } - if (@to_correct) { - &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'missingbubble',\@to_correct); - return (1,$currentphase); - } - - } - return (0,$currentphase+1); } sub scantron_process_students { my ($r) = @_; - my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'}); + my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'}); my ($symb,$url)=&get_symb_and_url($r); if (!$symb) {return '';} my $default_form_data=&defaultFormData($symb,$url); my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my ($scanlines,$scan_data)=&scantron_getfile(); + my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}"); + my @scanlines=<$scanlines>; 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 $navmap=Apache::lonnavmaps::navmap->new(); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); # $r->print("geto ".scalar(@resources)."
"); @@ -3824,23 +3443,18 @@ SCANTRONFORM my @delayqueue; my %completedstudents; - my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', - 'Scantron Progress',$scanlines->{'count'}); + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, + 'Scantron Status','Scantron Progress',scalar(@scanlines)); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); my $start=&Time::HiRes::time(); - my $i=-1; - my ($uname,$udom); - while ($i<$scanlines->{'count'}) { - ($uname,$udom)=('',''); - $i++; - my $line=&scantron_get_line($scanlines,$i); -# $r->print('
line is'.$line.'
'); - if ($line=~/^[\s\cz]*$/) { next; } - my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); - unless ($uname=&scantron_find_student($scan_record,$scan_data, - \%idmap,$i)) { + foreach my $line (@scanlines) { + $r->print('
line is'.$line.'
'); + + chomp($line); + my $scan_record=&scantron_parse_scanline($line,\%scantron_config); + my ($uname,$udom); + unless ($uname=&scantron_find_student($scan_record,\%idmap)) { &scantron_add_delay(\@delayqueue,$line, 'Unable to find a student that matches',1); next; @@ -3850,7 +3464,7 @@ SCANTRONFORM 'Student '.$uname.' has multiple sheets',2); next; } -# $r->print('
doing studnet'.$uname.'
'); + $r->print('
doing studnet'.$uname.'
'); ($uname,$udom)=split(/:/,$uname); &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::appenv(%$scan_record); @@ -3890,7 +3504,8 @@ SCANTRONFORM } continue { &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::delenv('scantron\.'); - &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,$uname); + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student'); #last; #FIXME #get iterator for $sequence @@ -3901,7 +3516,7 @@ SCANTRONFORM } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); my $lasttime = &Time::HiRes::time()-$start; - #$r->print("

took $lasttime

"); + $r->print("

took $lasttime

"); #$Apache::lonxml::debug=0; foreach my $delay (@delayqueue) { @@ -3918,55 +3533,7 @@ SCANTRONFORM # to ignore delayed students, possibly saving the delay queue for later $navmap->untieHashes(); - $r->print("

Done

"); - $r->print(&show_grading_menu_form($symb,$url)); - return ''; } - -sub scantron_upload_scantron_data { - my ($r)=@_; - $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'})); - my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', - 'domainid'); - my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, - 'domainid'); - $r->print(< - function checkUpload(formname) { - if (formname.upfile.value == "") { - alert("Please use the browse button to select a file from your local directory."); - return false; - } - formname.submit(); - } - - -
-Course: -Domain: $domsel $select_link -
- -File to upload: -
- -
-UPLOAD - return ''; -} - -sub scantron_upload_scantron_data_save { - my($r)=@_; - $r->print("Doing upload to ".$ENV{'form.courseid'}); - my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'}, - $ENV{'form.domainid'}); - my $fname='scantron_orig_'.$ENV{'form.upfile.filename'}; - $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, - $ENV{'form.domainid'}, - $home,'upfile',$fname)); - return ''; -} - - #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -4018,7 +3585,7 @@ sub gradingmenu { } formname.command.value = cmd; formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+ - ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); + ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); if (val < 5) formname.submit(); if (val == 5) { if (!checkReceiptNo(formname,'notOK')) { return false;} @@ -4086,12 +3653,14 @@ GRADINGMENUJS $result.='
'. ' '.'Current Resource: For one or more students'. - '
            -->For students with '. - ' submissions or '. - ' for all
'. 'content_type('text/xml'); + &Apache::loncommon::content_type($request,'text/xml'); } else { - $request->content_type('text/html'); + &Apache::loncommon::content_type($request,'text/html'); } $request->send_http_header; return '' if $request->header_only; @@ -4149,11 +3718,11 @@ sub handler { my $command=$ENV{'form.command'}; if (!$url) { my ($temp1,$temp2); - ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb); + ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb); $url = $ENV{'form.url'}; } &send_header($request); - if ($url eq '' && $symb eq '' && $command eq '') { + if ($url eq '' && $symb eq '') { if ($ENV{'user.adv'}) { if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && ($ENV{'form.codethree'})) { @@ -4162,7 +3731,7 @@ sub handler { my ($tsymb,$tuname,$tudom,$tcrsid)= &Apache::lonnet::checkin($token); if ($tsymb) { - my ($map,$id,$url)=split(/\_\_\_/,$tsymb); + my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { $request->print(&Apache::lonnet::ssi_body('/res/'.$url, ('grade_username' => $tuname, @@ -4194,6 +3763,7 @@ sub handler { delete($perm{'mgr'}); } } + if ($command eq 'submission' && $perm{'vgr'}) { ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { @@ -4237,15 +3807,8 @@ sub handler { $request->print(&scantron_validate_file($request)); } elsif ($command eq 'scantron_process' && $perm{'mgr'}) { $request->print(&scantron_process_students($request)); - } elsif ($command eq 'scantronupload' && - &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) { - $request->print(&scantron_upload_scantron_data($request)); - - } elsif ($command eq 'scantronupload_save' && - &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) { - $request->print(&scantron_upload_scantron_data_save($request)); } elsif ($command) { - $request->print("$command ".join(':',%perm)."Access Denied"); + $request->print("Access Denied"); } } &send_footer($request); @@ -4261,7 +3824,6 @@ sub send_header { #remotewindow.close(); #"); $request->print(&Apache::loncommon::bodytag('Grading')); - $request->rflush(); } sub send_footer {