--- loncom/homework/grades.pm 2003/09/27 01:59:10 1.130.2.1.2.4 +++ loncom/homework/grades.pm 2003/08/07 17:32:21 1.132 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.130.2.1.2.4 2003/09/27 01:59:10 albertel Exp $ +# $Id: grades.pm,v 1.132 2003/08/07 17:32:21 bowersj2 Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2510,6 +2510,7 @@ to this page if the data selected is ins $javascript ENDPICK + $request->print(&show_grading_menu_form($symb,$url)); return ''; } @@ -2798,9 +2799,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,8 +2844,7 @@ 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 $navmap = Apache::lonnavmaps::navmap->new(); my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps @@ -3008,8 +3006,7 @@ 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 $navmap = Apache::lonnavmaps::navmap->new(); my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps @@ -3146,8 +3143,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 @@ -3218,7 +3211,7 @@ sub scantron_selectphase {
- + $grading_menu_button SCANTRONFORM @@ -3230,7 +3223,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; } @@ -3247,12 +3239,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; @@ -3268,22 +3254,6 @@ sub username_to_idmap { return %idmap; } -sub scantron_fixup_scanline { - my ($scantron_config,$line,$field,$newvalue) = @_; - if ($field eq 'ID') { - if ($newvalue > $$scantron_config{'IDlength'}) { - return ($line,1,'New value to large'); - } - if ($newvalue < $$scantron_config{'IDlength'}) { - $newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s', - $newvalue); - } - substr($line,$$scantron_config{'IDstart'}-1, - $$scantron_config{'IDlength'})=$newvalue; - } - return $line; -} - sub scantron_parse_scanline { my ($line,$scantron_config)=@_; my %record; @@ -3299,15 +3269,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) { @@ -3316,43 +3277,30 @@ sub scantron_parse_scanline { substr($questions,0,$$scantron_config{'Qlength'})=''; if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } 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"}=''; } else { $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])]; } - if (scalar(@array) gt 2) { - push(@{$record{'scantron.doubleerror'}},$currentquest); - my @ans=@array; - my $i=length($ans[0]);shift(@ans); - while (@ans) { - $i+=length($ans[0])+1; - $record{"scantron.$questnum.answer"}.=$alphabet[$i]; - } - } } $record{'scantron.maxquest'}=$questnum; return \%record; } sub scantron_add_delay { - my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; - Apache->request->print('add_delay_error '.$_[2] ); - push(@$delayqueue, - {'line' => $scanline, 'emsg' => $errormessage, - 'ecode' => $errorcode } - ); } sub scantron_find_student { my ($scantron_record,$idmap)=@_; my $scanID=$$scantron_record{'scantron.ID'}; 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}; - } + Apache->request->print('
checking studnet -'.$id.'- againt -'.$scanID.'-
'); + if (lc($id) eq lc($scanID)) { Apache->request->print('success');return $$idmap{$id}; } } return undef; } @@ -3365,298 +3313,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_process_corrections { - my ($r) = @_; - if ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); - my $scanlines=&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; - } else { - 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,$line,'ID',$newid); - } - if ($err) { - $r->print("Unable to accept last correction, an error occurred :$errmsg:"); - } else { - &scantron_put_line($scanlines,$which,$line,$skip); - &scantron_putfile($scanlines); - } - } -} - -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)) { - my $which="scantron_validate_".$validate_phases[$currentphase]; - { - no strict 'refs'; - ($stop,$currentphase)=&$which($r,$currentphase); - } - } - $r->print(""); - return ''; -} - -sub scantron_getfile { - #my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}"); - #FIXME really would prefer a scantron directory but tokenwrapper - # doesn't allow access to subdirs of userfiles - my $lines; - $lines=&Apache::lonnet::getfile('/uploaded/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'. - 'scantron_orig_'.$ENV{'form.scantron_selectfile'}); - if ($lines eq '-1') { - #FIXME need to actually replicate file to course space - } - my %scanlines; - $scanlines{'orig'}=[split("\n",$lines)]; - my $temp=$scanlines{'orig'}; - $scanlines{'count'}=$#$temp; - - $lines=&Apache::lonnet::getfile('/uploaded/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'. - 'scantron_corrected_'.$ENV{'form.scantron_selectfile'}); - if ($lines eq '-1') { - $scanlines{'corrected'}=[]; - } else { - $scanlines{'corrected'}=[split("\n",$lines)]; - } - $lines=&Apache::lonnet::getfile('/uploaded/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'. - 'scantron_skipped_'.$ENV{'form.scantron_selectfile'}); - if ($lines eq '-1') { - $scanlines{'skipped'}=[]; - } else { - $scanlines{'skipped'}=[split("\n",$lines)]; - } - return \%scanlines; -} - -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) = @_; - #FIXME really would prefer a scantron directory but tokenwrapper - # doesn't allow access to subdirs of userfiles - my $prefix='/uploaded/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'. - 'scantron_'; - 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'}); -} - -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=&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,\%scantron_config); - 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) { - if ($found{'ids'}{$found}) { - #FIXME store away line we prviously saw the ID on - &scantron_get_correction($r,$i,$scan_record,$line, - 'duplicateID',$found); - return(1); - } else { - $found{'ids'}{$found}++; - } - } else { - &scantron_get_correction($r,$i,$scan_record,$line, - 'incorrectID'); - return(1); - } - } - - return (0,$currentphase+1); -} - -sub scantron_get_correction { - my ($r,$i,$scan_record,$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."); - 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

"); - &scantron_end_validate_form($r); -} - -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=&scantron_getfile(); - 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,\%scantron_config); - if (!defined($$scan_record{'scantron.doubleerror'})) { next; } - &scantron_get_correction($r,$i,$scan_record,$line,'double', - $$scan_record{'scantron.doubleerror'}); - return (1,$currentphase); - } - return (0,$currentphase+1); -} - -sub scantron_end_validate_form { - my ($r) = @_; - $r->print(''); -} - sub scantron_process_students { my ($r) = @_; my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'}); @@ -3669,10 +3325,10 @@ sub scantron_process_students { 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)."
"); + $r->print("geto ".scalar(@resources)."
"); my $result= < @@ -3681,36 +3337,29 @@ SCANTRONFORM $r->print($result); my @delayqueue; - my %completedstudents; - + my $totalcorrect; + my $totalincorrect; + 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(); foreach my $line (@scanlines) { - $r->print('
line is'.$line.'
'); + my $studentcorrect; + my $studentincorrect; 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; - } - if (exists $completedstudents{$uname}) { + if ($uname=&scantron_find_student($scan_record,\%idmap)) { &scantron_add_delay(\@delayqueue,$line, - 'Student '.$uname.' has multiple sheets',2); - next; + 'Unable to find a student that matches'); } $r->print('
doing studnet'.$uname.'
'); ($uname,$udom)=split(/:/,$uname); &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::appenv(%$scan_record); # &Apache::lonhomework::showhash(%ENV); -# $Apache::lonxml::debug=1; -# &Apache::lonxml::debug("line is $line"); + $Apache::lonxml::debug=1; + &Apache::lonxml::debug("line is $line"); my $i=0; foreach my $resource (@resources) { @@ -3722,31 +3371,31 @@ SCANTRONFORM '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); + 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;} } - $completedstudents{$uname}={'line'=>$line}; - } continue { &Apache::lonnet::delenv('form.counter'); &Apache::lonnet::delenv('scantron\.'); &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, - 'last student'); - #last; + 'last student Who got a '.$studentcorrect.' correct and '. + $studentincorrect.' incorrect. The class has gotten '. + $totalcorrect.' correct and '.$totalincorrect.' incorrect'); + last; #FIXME #get iterator for $sequence #foreach question 'submit' the students answer to the server @@ -3754,11 +3403,7 @@ SCANTRONFORM # 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

"); - - #$Apache::lonxml::debug=0; + $Apache::lonxml::debug=0; foreach my $delay (@delayqueue) { #FIXME #print out each delayed student with interface to select how @@ -4041,8 +3686,6 @@ sub handler { } } 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_process' && $perm{'mgr'}) { $request->print(&scantron_process_students($request)); } elsif ($command) {