--- loncom/homework/grades.pm 2003/10/13 22:36:59 1.130.2.1.2.8 +++ loncom/homework/grades.pm 2003/09/19 21:54:07 1.140 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.130.2.1.2.8 2003/10/13 22:36:59 albertel Exp $ +# $Id: grades.pm,v 1.140 2003/09/19 21:54:07 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -218,7 +218,8 @@ sub commonJSfunctions { } } } else { - if (selectOne.selected) return selectOne.value; + // only one value it must be the selected one + return selectOne.value; } } @@ -517,8 +518,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 +545,7 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; - + $gradeTable.='Check For Plagiarism'; my (undef, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; @@ -1461,13 +1462,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.=''. ''; - 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) { @@ -2726,7 +2733,9 @@ LISTJAVASCRIPT $result.=''."\n"; $result.=' Problems from:'."\n"; my ($titles,$symbx) = &getSymbMap($request); - my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/); + my ($curpage)=&Apache::lonnet::decode_symb($symb); my $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -3146,8 +3151,6 @@ sub getSequenceDropDown { } sub scantron_uploads { - #FIXME need to support scantron files put in another location, - # maybe the course directory? a scantron dir in the course directory? if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; my $result= ' + $default_form_data
Part '. $partid.' ( ID '.$respid. @@ -1480,7 +1488,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$/)); @@ -2327,18 +2335,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 .= '		'.$old_aw.' '.$awarded. ($score eq 'excused' ? $score : '').' 
@@ -3214,18 +3215,11 @@ sub scantron_selectphase { Format of data file: $format_selector - - -
- - Last line to expect an answer on: - -
- + $grading_menu_button SCANTRONFORM @@ -3237,7 +3231,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; } @@ -3254,12 +3247,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; @@ -3275,53 +3262,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); @@ -3335,15 +3277,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) { @@ -3351,26 +3284,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) { - Apache->request->print("snippet is 
$currentquest
"); - push(@{$record{'scantron.doubleerror'}},$questnum); - my @ans=@array; - my $i=length($ans[0]);shift(@ans); - while ($#ans) { - $i+=length($ans[0])+1; - $record{"scantron.$questnum.answer"}.=$alphabet[$i]; - shift(@ans); - } - } } $record{'scantron.maxquest'}=$questnum; return \%record; @@ -3386,11 +3310,8 @@ 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)) { @@ -3409,403 +3330,26 @@ sub scantron_filter { return 0; } -sub scantron_process_corrections { - my ($r) = @_; - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my ($scanlines,$scan_data)=&scantron_getfile(); - my $classlist=&Apache::loncoursedata::get_classlist(); - my $which=$ENV{'form.scantron_line'}; - my $line=&scantron_get_line($scanlines,$which); - my ($skip,$err,$errmsg); - if ($ENV{'form.scantron_skip_record'}) { - $skip=1; - } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { - my $newstudent=$ENV{'form.scantron_username'}.':'. - $ENV{'form.scantron_domain'}; - my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; - ($line,$err,$errmsg)= - &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, - 'ID',{'newid'=>$newid, - 'username'=>$ENV{'form.scantron_username'}, - 'domain'=>$ENV{'form.scantron_domain'}}); - } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { - foreach my $question (split(',',$ENV{'form.scantron_questions'})) { - ($line,$err,$errmsg)= - &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, - $which,'answer', - { 'question'=>$question, - 'response'=>$ENV{"form.scantron_correct_Q_$question"}}); - if ($err) { last; } - } - } - if ($err) { - $r->print("Unable to accept last correction, an error occurred :$errmsg:"); - } else { - &scantron_put_line($scanlines,$which,$line,$skip); - &scantron_putfile($scanlines,$scan_data); - } -} - - -sub scantron_validate_file { - my ($r) = @_; - my ($symb,$url)=&get_symb_and_url($r); - if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); - - if ($ENV{'form.scantron_corrections'}) { - &scantron_process_corrections($r); - } - #get the student pick code ready - $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= < - - - - - $default_form_data -SCANTRONFORM - $r->print($result); - - my @validate_phases=( 'ID', - 'CODE', - 'doublebubble', - 'missingbubbles'); - if (!$ENV{'form.validatepass'}) { - $ENV{'form.valiadatepass'} = 0; - } - my $currentphase=$ENV{'form.valiadatepass'}; - - if ($ENV{'form.scantron_selectfile'}=~m-^/-) { - #first pass copy file to classdir - - } - my $stop=0; - while (!$stop && $currentphase < scalar(@validate_phases)) { - $r->print("

Validating ".$validate_phases[$currentphase]."

"); - $r->rflush(); - my $which="scantron_validate_".$validate_phases[$currentphase]; - { - no strict 'refs'; - ($stop,$currentphase)=&$which($r,$currentphase); - } - } - if (!$stop) { - $r->print("Validation process complete, click 'Submit' to start proccssing"); - $r->print(''); - } else { - $r->print(''); - $r->print(""); - } - $r->print(''); - return ''; -} - -sub scantron_getfile { - #FIXME really would prefer a scantron directory but tokenwrapper - # doesn't allow access to subdirs of userfiles - my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $lines; - $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. - 'scantron_orig_'.$ENV{'form.scantron_selectfile'}); - if ($lines eq '-1') { - #FIXME need to actually replicate file to course space - #FIXME when replicating strip CRLF to LF or CR to LF - } - my %scanlines; - $scanlines{'orig'}=[(split("\n",$lines,-1))]; - my $temp=$scanlines{'orig'}; - $scanlines{'count'}=$#$temp; - - $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. - 'scantron_corrected_'.$ENV{'form.scantron_selectfile'}); - if ($lines eq '-1') { - $scanlines{'corrected'}=[]; - } else { - $scanlines{'corrected'}=[(split("\n",$lines,-1))]; - } - $lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'. - 'scantron_skipped_'.$ENV{'form.scantron_selectfile'}); - if ($lines eq '-1') { - $scanlines{'skipped'}=[]; - } else { - $scanlines{'skipped'}=[(split("\n",$lines,-1))]; - } - my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname); - if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } - my %scan_data = @tmp; - return (\%scanlines,\%scan_data); -} - -sub lonnet_putfile { - my ($contents,$filename)=@_; - my $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; - $ENV{'form.sillywaytopassafilearound'}=$contents; - &Apache::lonnet::finishuserfileupload($docuname,$docudom,$docuhome,'sillywaytopassafilearound',$filename); - -} - -sub scantron_putfile { - my ($scanlines,$scan_data) = @_; - #FIXME really would prefer a scantron directory but tokenwrapper - # doesn't allow access to subdirs of userfiles - my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $prefix='scantron_'; -# no need to update orig, shouldn't change -# &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'. -# $ENV{'form.scantron_selectfile'}); - &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), - $prefix.'corrected_'. - $ENV{'form.scantron_selectfile'}); - &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), - $prefix.'skipped_'. - $ENV{'form.scantron_selectfile'}); - &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname); -} - -sub scantron_get_line { - my ($scanlines,$i)=@_; - if ($scanlines->{'skipped'}[$i]) {return undef;} - if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} - return $scanlines->{'orig'}[$i]; -} - -sub scantron_put_line { - my ($scanlines,$i,$newline,$skip)=@_; - if ($skip) { - $scanlines->{'skipped'}[$i]=$newline; - return; - } - $scanlines->{'corrected'}[$i]=$newline; -} - -sub scantron_validate_ID { - my ($r,$currentphase) = @_; - - #get student info - my $classlist=&Apache::loncoursedata::get_classlist(); - my %idmap=&username_to_idmap($classlist); - - #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my ($scanlines,$scan_data)=&scantron_getfile(); - - my %found=('ids'=>{},'usernames'=>{}); - for (my $i=0;$i<=$scanlines->{'count'};$i++) { - my $line=&scantron_get_line($scanlines,$i); - if (!$line) { next; } - my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); - my $id=$$scan_record{'scantron.ID'}; -# $r->print("

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

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

Using $checkid for encoded $id

\n"); - } - $found=$checkid;last; - } - } - if ($found) { - my $username=$idmap{$found}; - if ($found{'ids'}{$found}) { - &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'duplicateID',$found); - return(1); - } elsif ($found{'usernames'}{$username}) { - &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'duplicateID',$username); - return(1); - } - #FIXME store away line we prviously saw the ID on to use above - $found{'ids'}{$found}++; - $found{'usernames'}{$username}++; - } else { - if ($id =~ /^\s*$/) { - my $username=&scan_data($scan_data,"$i.user"); - if (defined($username) && $found{'usernames'}{$username}) { - &scantron_get_correction($r,$i,$scan_record, - \%scantron_config, - $line,'duplicateID',$username); - return(1); - } elsif (!defined($username)) { - &scantron_get_correction($r,$i,$scan_record, - \%scantron_config, - $line,'incorrectID'); - return(1); - } - $found{'usernames'}{$username}++; - } else { - &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'incorrectID'); - return(1); - } - } - } - - return (0,$currentphase+1); -} - -sub scantron_get_correction { - my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; - -#FIXME in the case of a duplicated ID the previous line, probaly need -#to show both the current line and the previous one and allow skipping -#the previous one or the current one - - $r->print("

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

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

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

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

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

"); - $r->print("

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