--- loncom/homework/grades.pm 2005/04/04 23:56:44 1.256 +++ loncom/homework/grades.pm 2007/08/10 20:09:30 1.426 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.256 2005/04/04 23:56:44 banghart Exp $ +# $Id: grades.pm,v 1.426 2007/08/10 20:09:30 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,19 +36,23 @@ use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; use Apache::loncoursedata; -use Apache::lonmsg qw(:user_normal_msg); +use Apache::lonmsg(); use Apache::Constants qw(:common); use Apache::lonlocal; +use Apache::lonenc; use String::Similarity; +use LONCAPA; + +use POSIX qw(floor); -my %oldessays=(); my %perm=(); # ----- These first few routines are general use routines.---- # # --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url,$symb) = @_; + my ($symb) = @_; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); my $partorder = &Apache::lonnet::metadata($url, 'partorder'); my @parts; if ($partorder) { @@ -78,17 +82,18 @@ sub getpartlist { } # --- Get the symbolic name of a problem and the url -sub get_symb_and_url { +sub get_symb { 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))); + (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 '') { if (!$silent) { $request->print("Unable to handle ambiguous references:$url:."); return (); } } - return ($symb,$url); + &Apache::lonenc::check_decrypt(\$symb); + return ($symb); } #--- Format fullname, username:domain if different for display @@ -96,94 +101,94 @@ sub get_symb_and_url { sub nameUserString { my ($type,$fullname,$uname,$udom) = @_; if ($type eq 'header') { - return ' Fullname (Username)'; + return ' Fullname (Username)'; } else { - return ' '.$fullname.' ('.$uname. - ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; + return ' '.$fullname.' ('.$uname. + ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; } } #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { - my ($url,$symb) = shift; - $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq ''); - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my %vPart; - foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { - $vPart{$partid}=1; - } - my %seen = (); - my (@partlist,%handgrade,%responseType); - foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_.*/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { - next; - } - if (%vPart && !exists($vPart{$partid})) { - next; - } - $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! - my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); - $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); - if (!exists($responseType{$partid})) { $responseType{$partid}={}; } - $responseType{$partid}->{$respid}=$responsetype; - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; - } - } - return \@partlist,\%handgrade,\%responseType; + my ($symb) = shift; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my %vPart = + map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + next if (%vPart && !exists($vPart{$part})); + + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $response_types{$part}{$ids[$i]} = $types[$i]; + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types); +} + +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; } sub get_display_part { - my ($partID,$url,$symb)=@_; - if (!defined($symb) || $symb eq '') { - $symb=$ENV{'form.symb'}; - if ($symb eq '') { $symb=&Apache::lonnet::symbread($url) } - } + my ($partID,$symb)=@_; my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); if (defined($display) and $display ne '') { - $display.= " (id $partID)"; + $display.= " (id $partID)"; } else { $display=$partID; } return $display; } + #--- Show resource title #--- and parts and response type sub showResourceInfo { - my ($url,$probTitle,$checkboxes) = @_; + my ($symb,$probTitle,$checkboxes) = @_; my $col=3; if ($checkboxes) { $col=4; } - my $result =''. - ''."\n"; - my ($partlist,$handgrade,$responseType) = &response_type($url); + my $result = '

'.&mt('Current Resource').': '.$probTitle.'

'."\n"; + $result .='
'.&mt('Current Resource').': '. - $probTitle.'
'; + my ($partlist,$handgrade,$responseType) = &response_type($symb); my %resptype = (); my $hdgrade='no'; my %partsseen; - for my $part_resID (sort keys(%$handgrade)) { - my $handgrade=$$handgrade{$part_resID}; - my ($partID,$resID) = split(/_/,$part_resID); - my $responsetype = $responseType->{$partID}->{$resID}; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''; - if ($checkboxes) { - if (exists($partsseen{$partID})) { - $result.=""; - } else { - $result.=""; + foreach my $partID (sort keys(%$responseType)) { + foreach my $resID (sort keys(%{ $responseType->{$partID} })) { + my $handgrade=$$handgrade{$partID.'_'.$resID}; + my $responsetype = $responseType->{$partID}->{$resID}; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=""; + } + $partsseen{$partID}=1; } - $partsseen{$partID}=1; - } - my $display_part=&get_display_part($partID,$url); - $result.=''. - ''; + my $display_part=&get_display_part($partID,$symb); + $result.=''. + ''; # ''; + } } $result.='
 
 Part: '.$display_part.' '. - $resID.'Type: '.$responsetype.'
Part: '.$display_part.' '. + $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'."\n"; return $result,$responseType,$hdgrade,$partlist,$handgrade; @@ -199,17 +204,19 @@ sub get_order { ('grade_domain' => $udom), ('grade_symb' => $symb), ('grade_courseid' => - $ENV{'request.course.id'}), + $env{'request.course.id'}), ('grade_username' => $uname)); (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); my %analyze=&Apache::lonnet::str2hash($subresult); return ($analyze{"$partid.$respid.shown"}); } #--- Clean response type for display -#--- Currently filters option/rank/radiobutton/match/essay response types only. +#--- Currently filters option/rank/radiobutton/match/essay/Task +# response types only. sub cleanRecord { - my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_; - my $grayFont = ''; + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, + $uname,$udom) = @_; + my $grayFont = ''; if ($response =~ /^(option|rank)$/) { my %answer=&Apache::lonnet::str2hash($answer); my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); @@ -220,11 +227,11 @@ sub cleanRecord { } else { $toprow.=''.$answer{$foil}.' '; } - $bottomrow.=''.$grayFont.$foil.' '; + $bottomrow.=''.$grayFont.$foil.' '; } return '
'. ''.$toprow.''. - ''. + ''. $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'.$grayFont.'Option ID
'; } elsif ($response eq 'match') { my %answer=&Apache::lonnet::str2hash($answer); @@ -235,18 +242,18 @@ sub cleanRecord { my $item=shift(@items); if ($grading{$foil} == 1) { $toprow.=''.$item.' '; - $middlerow.=''.$grayFont.$answer{$foil}.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; } else { $toprow.=''.$item.' '; - $middlerow.=''.$grayFont.$answer{$foil}.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; } - $bottomrow.=''.$grayFont.$foil.' '; + $bottomrow.=''.$grayFont.$foil.' '; } return '
'. ''.$toprow.''. - ''. + ''. $middlerow.''. - ''. + ''. $bottomrow.''.'
Answer
'.$grayFont.'Item ID
'.$grayFont.'Item ID
'.$grayFont.'Option ID
'.$grayFont.'Option ID
'; } elsif ($response eq 'radiobutton') { my %answer=&Apache::lonnet::str2hash($answer); @@ -263,27 +270,63 @@ sub cleanRecord { } else { $toprow.='false'; } - $bottomrow.=''.$grayFont.$foil.' '; + $bottomrow.=''.$grayFont.$foil.' '; } return '
'. ''.$toprow.''. - ''. + ''. $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'.$grayFont.'Option ID
'; } elsif ($response eq 'essay') { - if (! exists ($ENV{'form.'.$symb})) { + if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; - $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; - $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; - $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. + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $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. } $answer =~ s-\n-
-g; return '

'.&keywords_highlight($answer).'
'; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
',($version,@matches)); + + + } else { + my $result = + '

' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'

'; + + $result .= ''; + return $result; + } + } return $answer; } @@ -328,7 +371,16 @@ COMMONJSFUNCTIONS #--- section, ids and fullnames for each user. sub getclasslist { my ($getsec,$filterlist) = @_; - $getsec = $getsec eq '' ? 'all' : $getsec; + my @getsec; + if (!ref($getsec)) { + if ($getsec ne '' && $getsec ne 'all') { + @getsec=($getsec); + } + } else { + @getsec=@{$getsec}; + } + if (grep(/^all$/,@getsec)) { undef(@getsec); } + my $classlist=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); @@ -349,15 +401,15 @@ sub getclasslist { my $status = $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; # filter students according to status selected - if ($filterlist && $ENV{'form.Status'} ne 'Any') { - if ($ENV{'form.Status'} ne $status) { + if ($filterlist && $env{'form.Status'} ne 'Any') { + if ($env{'form.Status'} ne $status) { delete ($classlist->{$student}); next; } } $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { - if ($getsec eq 'all' || $getsec eq $section) { + if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { $sections{$section}++; $fullnames{$student}=$fullname; } else { @@ -414,8 +466,8 @@ sub canview { #--- Retrieve the grade status of a student for all the parts sub student_gradeStatus { - my ($url,$symb,$udom,$uname,$partlist) = @_; - my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my ($symb,$udom,$uname,$partlist) = @_; + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); my %partstatus = (); foreach (@$partlist) { my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); @@ -431,7 +483,7 @@ sub student_gradeStatus { # Use by verifyscript and viewgrades # Shows a student's view of problem and submission sub jscriptNform { - my ($url,$symb) = @_; + my ($symb) = @_; my $jscript=''."\n"; $jscript.= '
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -452,6 +503,33 @@ sub jscriptNform { return $jscript; } +# Given the score (as a number [0-1] and the weight) what is the final +# point value? This function will round to the nearest tenth, third, +# or quarter if one of those is within the tolerance of .00001. +sub compute_points { + my ($score, $weight) = @_; + + my $tolerance = .00001; + my $points = $score * $weight; + + # Check for nearness to 1/x. + my $check_for_nearness = sub { + my ($factor) = @_; + my $num = ($points * $factor) + $tolerance; + my $floored_num = floor($num); + if ($num - $floored_num < 2 * $tolerance * $factor) { + return $floored_num / $factor; + } + return $points; + }; + + $points = $check_for_nearness->(10); + $points = $check_for_nearness->(3); + $points = $check_for_nearness->(4); + + return $points; +} + #------------------ End of general use routines -------------------- # @@ -459,12 +537,16 @@ sub jscriptNform { # sub most_similar { - my ($uname,$udom,$uessay)=@_; + my ($uname,$udom,$uessay,$old_essays)=@_; # ignore spaces and punctuation $uessay=~s/\W+/ /gs; +# ignore empty submissions (occuring when only files are sent) + + unless ($uessay=~/\w+/) { return ''; } + # these will be returned. Do not care if not at least 50 percent similar my $limit=0.6; my $sname=''; @@ -472,23 +554,22 @@ sub most_similar { my $scrsid=''; my $sessay=''; # go through all essays ... - foreach my $tkey (keys %oldessays) { - my ($tname,$tdom,$tcrsid)=split(/\./,$tkey); + foreach my $tkey (keys(%$old_essays)) { + my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); # ... except the same student - if (($tname ne $uname) || ($tdom ne $udom)) { - my $tessay=$oldessays{$tkey}; - $tessay=~s/\W+/ /gs; + next if (($tname eq $uname) && ($tdom eq $udom)); + my $tessay=$old_essays->{$tkey}; + $tessay=~s/\W+/ /gs; # String similarity gives up if not even limit - my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); + my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); # Found one - if ($tsimilar>$limit) { - $limit=$tsimilar; - $sname=$tname; - $sdom=$tdom; - $scrsid=$tcrsid; - $sessay=$oldessays{$tkey}; - } - } + if ($tsimilar>$limit) { + $limit=$tsimilar; + $sname=$tname; + $sdom=$tdom; + $scrsid=$tcrsid; + $sessay=$old_essays->{$tkey}; + } } if ($limit>0.6) { return ($sname,$sdom,$scrsid,$sessay,$limit); @@ -505,34 +586,37 @@ sub most_similar { sub verifyreceipt { my $request = shift; - my $courseid = $ENV{'request.course.id'}; + my $courseid = $env{'request.course.id'}; my $receipt = &Apache::lonnet::recprefix($courseid).'-'. - $ENV{'form.receipt'}; + $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $url = $ENV{'form.url'}; - my $symb = $ENV{'form.symb'}; - unless ($symb) { - $symb = &Apache::lonnet::symbread($url); - } + my ($symb) = &get_symb($request); - my $title.='

Verifying Submission Receipt '. - $receipt.'

'."\n". - 'Resource: '.$ENV{'form.probTitle'}.'

'."\n"; + my $title.='

Verifying Submission Receipt '. + $receipt.'

'."\n". + '

Resource: '.$env{'form.probTitle'}.'



'."\n"; my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); my $receiptparts=0; - if ($ENV{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } + if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || + $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } my $parts=['0']; - if ($receiptparts) { ($parts)=&response_type($url,$symb); } - foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + if ($receiptparts) { ($parts)=&response_type($symb); } + foreach (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } (keys(%$fullname))) { my ($uname,$udom)=split(/\:/); foreach my $part (@$parts) { if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { $contents.=' '."\n". ''.$$fullname{$_}.' '."\n". + '\');" target="_self">'.$$fullname{$_}.' '."\n". ' '.$uname.' '. ' '.$udom.' '; if ($receiptparts) { @@ -547,7 +631,7 @@ sub verifyreceipt { if ($matches == 0) { $string = $title.'No match found for the above receipt.'; } else { - $string = &jscriptNform($url,$symb).$title. + $string = &jscriptNform($symb).$title. 'The above receipt matches the following student'. ($matches <= 1 ? '.' : 's.')."\n". ''."\n".$contents. '
'."\n". @@ -561,7 +645,7 @@ sub verifyreceipt { $string.='
'."\n"; } - return $string.&show_grading_menu_form($symb,$url); + return $string.&show_grading_menu_form($symb); } #--- This is called by a number of programs. @@ -571,20 +655,20 @@ sub verifyreceipt { sub listStudents { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; - my $submitonly= $ENV{'form.submitonly'} eq '' ? 'all' : $ENV{'form.submitonly'}; - - my $viewgrade = $ENV{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; - $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? - &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + + my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; + $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; - my $result='

 '.$viewgrade. - ' Submissions for a Student or a Group of Students

'; + my $result='

 '.$viewgrade. + ' Submissions for a Student or a Group of Students

'; - my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'},($ENV{'form.showgrading'} eq 'yes')); + my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); $request->print(< @@ -622,40 +706,46 @@ LISTJAVASCRIPT &commonJSfunctions($request); $request->print($result); - my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; - my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; + my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked="checked"' : ''; + my $checklastsub = $checkhdgrade eq '' ? 'checked="checked"' : ''; my $gradeTable=''. "\n".$table. - ' View Problem Text: no '."\n". - ' one student '."\n". - ' all students
'."\n". - ' View Answer: no '."\n". - ' one student '."\n". - ' all students
'."\n". + ' View Problem Text: '."\n". + ''."\n". + '
'."\n". + ' View Answer: '."\n". + ''."\n". + '
'."\n". ' Submissions: '."\n"; - if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { - $gradeTable.=' essay part only'."\n"; + if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { + $gradeTable.=''."\n"; } - my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'}; - $ENV{'form.Status'} = $saveStatus; + my $saveStatus = $env{'form.Status'} eq '' ? 'Active' : $env{'form.Status'}; + $env{'form.Status'} = $saveStatus; + + $gradeTable.=''."\n". + ''."\n". + ''."\n". + '
'."\n". + ' Grading Increments: '. - $gradeTable.=' last submission only'."\n". - ' last submission & parts info'."\n". - ' by dates and submissions'."\n". - ' all details'."\n". ''."\n". ''."\n". - '
'."\n". - '
'."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". + '
'."\n". + '
'."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n"; - if (exists($ENV{'form.gradingMenu'}) && exists($ENV{'form.Status'})) { - $gradeTable.=''."\n"; + if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { + $gradeTable.=''."\n"; } else { $gradeTable.='Student Status: '. &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'
'; @@ -671,7 +761,7 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="Next->" />
'."\n"; $gradeTable.=&check_buttons(); - $gradeTable.='Check For Plagiarism'; + $gradeTable.=''; my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; @@ -679,12 +769,16 @@ LISTJAVASCRIPT while ($loop < 2) { $gradeTable.=''. ''; - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { foreach (sort(@$partlist)) { - my $display_part=&get_display_part((split(/_/))[0],$url,$symb); + my $display_part=&get_display_part((split(/_/))[0],$symb); $gradeTable.=''; } + } elsif ($submitonly eq 'queued') { + $gradeTable.=''; } $loop++; # $gradeTable.='' if ($loop%2 ==1); @@ -692,11 +786,30 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; my $ctr = 0; - foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + foreach my $student (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } + (keys(%$fullname))) { my ($uname,$udom) = split(/:/,$student); + my %status = (); - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { - (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + next if (!defined($queue_status{'gradingqueue'})); + $status{'gradingqueue'} = $queue_status{'gradingqueue'}; + } + + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { + (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); my $submitted = 0; my $graded = 0; my $incorrect = 0; @@ -734,10 +847,10 @@ LISTJAVASCRIPT &nameUserString(undef,$$fullname{$student},$uname,$udom). ' '.$section.''."\n"; - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { next if (/^resource.*?submitted_by$/); - $gradeTable.=''."\n"; + $gradeTable.=''."\n"; } } # $gradeTable.='' if ($ctr%2 ==1); @@ -746,10 +859,14 @@ LISTJAVASCRIPT } if ($ctr%2 ==1) { $gradeTable.=''; - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { foreach (@$partlist) { $gradeTable.=''; } + } elsif ($submitonly eq 'queued') { + $gradeTable.=''; } $gradeTable.=''; } @@ -761,19 +878,20 @@ LISTJAVASCRIPT if ($ctr == 0) { my $num_students=(scalar(keys(%$fullname))); if ($num_students eq 0) { - $gradeTable='
 There are no students currently enrolled.'; + $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='
 '. + if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } + $gradeTable='
 '. 'No '.$submissions.' found for this resource for any students. ('.$num_students. - ' students checked for '.$submissions.')
'; + ' students checked for '.$submissions.')
'; } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; } - $gradeTable.=&show_grading_menu_form($symb,$url); + $gradeTable.=&show_grading_menu_form($symb); $request->print($gradeTable); return ''; } @@ -832,11 +950,11 @@ sub processGroup { my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); my $total = scalar(@stuchecked)-1; - foreach (@stuchecked) { - my ($uname,$udom,$fullname) = split(/:/); - $ENV{'form.student'} = $uname; - $ENV{'form.userdom'} = $udom; - $ENV{'form.fullname'} = $fullname; + foreach my $student (@stuchecked) { + my ($uname,$udom,$fullname) = split(/:/,$student); + $env{'form.student'} = $uname; + $env{'form.userdom'} = $udom; + $env{'form.fullname'} = $fullname; &submission($request,$ctr,$total); $ctr++; } @@ -1029,6 +1147,81 @@ sub sub_page_kw_js { my $request = shift; my $iconpath = $request->dir_config('lonIconsURL'); &commonJSfunctions($request); + + my $inner_js_msg_central=< + function checkInput() { + opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); + var nmsg = opener.document.SCORE.savemsgN.value; + var usrctr = document.msgcenter.usrctr.value; + var newval = opener.document.SCORE["newmsg"+usrctr]; + newval.value = opener.checkEntities(document.msgcenter.newmsg.value); + + var msgchk = ""; + if (document.msgcenter.subchk.checked) { + msgchk = "msgsub,"; + } + var includemsg = 0; + for (var i=1; i<=nmsg; i++) { + var opnmsg = opener.document.SCORE["savemsg"+i]; + var frmmsg = document.msgcenter["msg"+i]; + opnmsg.value = opener.checkEntities(frmmsg.value); + var showflg = opener.document.SCORE["shownOnce"+i]; + showflg.value = "1"; + var chkbox = document.msgcenter["msgn"+i]; + if (chkbox.checked) { + msgchk += "savemsg"+i+","; + includemsg = 1; + } + } + if (document.msgcenter.newmsgchk.checked) { + msgchk += "newmsg"+usrctr; + includemsg = 1; + } + imgformname = opener.document.SCORE["mailicon"+usrctr]; + imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); + var includemsg = opener.document.SCORE["includemsg"+usrctr]; + includemsg.value = msgchk; + + self.close() + + } + +INNERJS + + my $inner_js_highlight_central=< + function updateChoice(flag) { + opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr); + opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize); + opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle); + opener.document.SCORE.refresh.value = "on"; + if (opener.document.SCORE.keywords.value!=""){ + opener.document.SCORE.submit(); + } + self.close() + } + +INNERJS + + my $start_page_msg_central = + &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, + {'js_ready' => 1, + 'only_body' => 1, + 'bgcolor' =>'#FFFFFF',}); + my $end_page_msg_central = + &Apache::loncommon::end_page({'js_ready' => 1}); + + + my $start_page_highlight_central = + &Apache::loncommon::start_page('Highlight Central', + $inner_js_highlight_central, + {'js_ready' => 1, + 'only_body' => 1, + 'bgcolor' =>'#FFFFFF',}); + my $end_page_highlight_central = + &Apache::loncommon::end_page({'js_ready' => 1}); + my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); $docopen=~s/^document\.//; $request->print(<"); - pDoc.write("Message Central"); - - pDoc.write(" CSVFORMJS - $ENV{'form.probTitle'} = &Apache::lonnet::gettitle($symb); - my ($table) = &showResourceInfo($url,$ENV{'form.probTitle'}); + return $result; +} + +sub upcsvScores_form { + my ($request) = shift; + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + my $result=&checkforfile_js(); + $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); + my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); $result.=$table; - $result.='
 No.  Select '.&nameUserString('header').' Section/Group Part: '.$display_part. ' Status  '.&mt('Queue Status').' 
 '.$status{$_}.'  '.$status{$_}.'      
' if ($ptr%2 == 0); + $studentTable.='
'."\n"; - $result.='
'."\n"; - $result.=' Specify a file containing the class scores for current resource'. + $result.='
'."\n"; + $result.=''."\n"; $result.='
'."\n"; + $result.=' '.&mt('Specify a file containing the class scores for current resource'). '.
'."\n"; + my $upload=&mt("Upload Scores"); my $upfile_select=&Apache::loncommon::upfile_select_html(); my $ignore=&mt('Ignore First Line'); + $symb = &Apache::lonenc::check_encrypt($symb); $result.=< - - - + + $upfile_select -
-
'."\n"; + $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", + &mt("How do I create a CSV file from a spreadsheet")) + .'
'."\n"; $result.='


'."\n"; - $result.=&show_grading_menu_form($symb,$url); + $result.=&show_grading_menu_form($symb); return $result; } sub csvuploadmap { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $datatoken; - if (!$ENV{'form.datatoken'}) { + if (!$env{'form.datatoken'}) { $datatoken=&Apache::loncommon::upfile_store($request); } else { - $datatoken=$ENV{'form.datatoken'}; + $datatoken=$env{'form.datatoken'}; &Apache::loncommon::load_tmp_file($request); } my @records=&Apache::loncommon::upfile_record_sep(); - if ($ENV{'form.noFirstLine'}) { shift(@records); } - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); + if ($env{'form.noFirstLine'}) { shift(@records); } + &csvuploadmap_header($request,$symb,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url,$symb); + my @fields=&csvupload_fields($symb); - if ($ENV{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); $i=&Apache::loncommon::csv_print_select_table($request,\@records, \@fields); @@ -2987,32 +3608,38 @@ sub csvuploadmap { unshift(@fields,['none','']); $i=&Apache::loncommon::csv_samples_select_table($request,\@records, \@fields); - my %sone=&Apache::loncommon::record_sep($records[0]); - $keyfields=join(',',sort(keys(%sone))); + foreach my $rec (@records) { + my %temp = &Apache::loncommon::record_sep($rec); + if (%temp) { + $keyfields=join(',',sort(keys(%temp))); + last; + } + } } } &csvuploadmap_footer($request,$i,$keyfields); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(&show_grading_menu_form($symb)); return ''; } sub csvuploadoptions { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - my $checked=(($ENV{'form.noFirstLine'})?'1':'0'); + my ($symb)=&get_symb($request); + my $checked=(($env{'form.noFirstLine'})?'1':'0'); my $ignore=&mt('Ignore First Line'); $request->print(< -

Uploading Class Grade Options

+

Uploading Class Grade Options

-
+

Users are in domain: ".$domform."

\n"); } - foreach my $key (sort(keys(%ENV))) { + foreach my $key (sort(keys(%env))) { if ($key !~ /^form\.(.*)$/) { next; } my $cleankey=$1; if ($cleankey eq 'command') { next; } $request->print(''."\n"); + '" value="'.$env{$key}.'" />'."\n"); } # FIXME do a check for any duplicated user ids... # FIXME do a check for any invalid user ids?... - $request->print("
\n"); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print('
+
'."\n"); + $request->print(&show_grading_menu_form($symb)); return ''; } sub get_fields { my %fields; - my @keyfields = split(/\,/,$ENV{'form.keyfields'}); - for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) { - if ($ENV{'form.upfile_associate'} eq 'reverse') { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$keyfields[$i]}=$ENV{'form.f'.$i}; + my @keyfields = split(/\,/,$env{'form.keyfields'}); + for (my $i=0; $i<=$env{'form.nfields'}; $i++) { + if ($env{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.f'.$i} ne 'none') { + $fields{$keyfields[$i]}=$env{'form.f'.$i}; } } else { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; + if ($env{'form.f'.$i} ne 'none') { + $fields{$env{'form.f'.$i}}=$keyfields[$i]; } } } @@ -3058,14 +3686,15 @@ sub get_fields { sub csvuploadassign { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} + my $error_msg = ''; &Apache::loncommon::load_tmp_file($request); my @gradedata = &Apache::loncommon::upfile_record_sep(); - if ($ENV{'form.noFirstLine'}) { shift(@gradedata); } + if ($env{'form.noFirstLine'}) { shift(@gradedata); } my %fields=&get_fields(); $request->print('

Assigning Grades

'); - my $courseid=$ENV{'request.course.id'}; + my $courseid=$env{'request.course.id'}; my ($classlist) = &getclasslist('all',0); my @notallowed; my @skipped; @@ -3076,7 +3705,7 @@ sub csvuploadassign { if ($entries{$fields{'domain'}}) { $domain=$entries{$fields{'domain'}}; } else { - $domain=$ENV{'form.default_domain'}; + $domain=$env{'form.default_domain'}; } $domain=~s/\s//g; my $username=$entries{$fields{'username'}}; @@ -3112,12 +3741,20 @@ sub csvuploadassign { my $part=$1; my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', $symb,$domain,$username); - $entries{$fields{$dest}}=~s/\s//g; - my $pcr=$entries{$fields{$dest}} / $wgt; - my $award='correct_by_override'; - $grades{"resource.$part.awarded"}=$pcr; - $grades{"resource.$part.solved"}=$award; - $points{$part}=1; + if ($wgt) { + $entries{$fields{$dest}}=~s/\s//g; + my $pcr=$entries{$fields{$dest}} / $wgt; + my $award='correct_by_override'; + $grades{"resource.$part.awarded"}=$pcr; + $grades{"resource.$part.solved"}=$award; + $points{$part}=1; + } else { + $error_msg = "
" . + &mt("Some point values were assigned" + ." for problems with a weight " + ."of zero. These values were " + ."ignored."); + } } else { if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } @@ -3127,27 +3764,37 @@ sub csvuploadassign { $grades{$store_key}=$entries{$fields{$dest}}; } } - if (! %grades) { push(@skipped,"$username:$domain no data to store"); } - $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; + if (! %grades) { push(@skipped,"$username:$domain no data to save"); } + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; # &Apache::lonnet::logthis(" storing ".(join('-',%grades))); - &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'}, - $domain,$username); - $request->print('.'); + my $result=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print("

+ + Failed to save student $username:$domain. + Message when trying to save was ($result) + +

" ); + } $request->rflush(); $countdone++; } - $request->print("
Stored $countdone students\n"); + $request->print("
Saved $countdone students\n"); if (@skipped) { - $request->print('Skipped Students

'); + $request->print('

Skipped Students

'); foreach my $student (@skipped) { $request->print("$student
\n"); } } if (@notallowed) { - $request->print('

Students Not Allowed to Modify

'); + $request->print('

Students Not Allowed to Modify

'); foreach my $student (@notallowed) { $request->print("$student
\n"); } } $request->print("
\n"); - $request->print(&show_grading_menu_form($symb,$url)); - return ''; + $request->print(&show_grading_menu_form($symb)); + return $error_msg; } #------------- end of section for handling csv file upload --------- # @@ -3176,17 +3823,17 @@ function checkPickOne(formname) { LISTJAVASCRIPT &commonJSfunctions($request); - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; - my $result='

 '. - 'Manual Grading by Page or Sequence

'; + my $result='

 '. + 'Manual Grading by Page or Sequence

'; $result.='
'."\n"; $result.=' Problems from: '."
\n"; + $result.= ''."
\n"; $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -3209,27 +3856,29 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n"; - $result.=' View Problems Text: no '."\n". - ' yes '."
\n"; + $result.=' View Problems Text: '."\n". + ''."
\n"; $result.=' Submission Details: '. - ' none'."\n". - ' by dates and submissions'."\n". - ' all details'."\n"; + ''."\n". + ''."\n". + ''."\n"; $result.=''."\n". - ''."\n". + ''."\n". ''."\n". - ''."\n". - ''."\n". - ''."
\n"; + ''."\n". + ''."
\n"; + + $result.=' '.&mt('Use CODE:').' '. + '
'."\n"; $result.=' 
'."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. + my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. '
'. ''. ''. @@ -3239,28 +3888,33 @@ LISTJAVASCRIPT my (undef,undef,$fullname) = &getclasslist($getsec,'1'); my $ptr = 1; - foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + foreach my $student (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } (keys(%$fullname))) { my ($uname,$udom) = split(/:/,$student); $studentTable.=($ptr%2 == 1 ? '' : ''); $studentTable.=''; - $studentTable.='' : ''); $ptr++; } - $studentTable.='
 No.
'.$ptr.'   ' - .&nameUserString(undef,$$fullname{$student},$uname,$udom)."\n"; + $studentTable.=' \n"; $studentTable.=($ptr%2 == 0 ? '
  ' if ($ptr%2 == 0); - $studentTable.='
'."\n"; + $studentTable.='
  
'."\n"; $studentTable.=''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; } sub getSymbMap { - my ($request) = @_; my $navmap = Apache::lonnavmaps::navmap->new(); my %symbx = (); @@ -3272,9 +3926,10 @@ sub getSymbMap { 1,0,1); for my $sequence ($navmap->getById('0.0'), @sequences) { if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { - my $title = $minder.'.'.$sequence->compTitle(); - push @titles, $title; # minder in case two titles are identical - $symbx{$title} = $sequence->symb(); + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); $minder++; } } @@ -3286,52 +3941,65 @@ sub getSymbMap { sub displayPage { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; - my $pageTitle = $ENV{'form.page'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $pageTitle = $env{'form.page'}; my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); - my ($uname,$udom) = split(/:/,$ENV{'form.student'}); - my $usec=$classlist->{$ENV{'form.student'}}[5]; + 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'}); + $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)); + $request->print('Unable to view requested student.('.$env{'form.student'}.')'); + $request->print(&show_grading_menu_form($symb)); return; } - my $result='

 '.$ENV{'form.title'}.'

'; - $result.='

 Student: '.&nameUserString(undef,$$fullname{$ENV{'form.student'}},$uname,$udom). + my $result='

 '.$env{'form.title'}.'

'; + $result.='

 Student: '.&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom). '

'."\n"; + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $result.='

 CODE: '.$env{'form.CODE'}.'

'."\n"; + } else { + delete($env{'form.CODE'}); + } &sub_page_js($request); $request->print($result); my $navmap = Apache::lonnavmaps::navmap->new(); - my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($ENV{'form.page'}); + my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps - + if (!$map) { + $request->print('Unable to view requested sequence. ('.$resUrl.')'); + $request->print(&show_grading_menu_form($symb)); + return; + } my $iterator = $navmap->getIterator($map->map_start(), $map->map_finish()); my $studentTable='
'."\n". ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". ''."\n". - ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". ''."\n". - ''."\n"; + ''."\n"; - my $checkIcon = ''."\n"; + } + my $checkIcon = ''.&mt('Check Mark'). + ''; $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. @@ -3339,8 +4007,9 @@ sub displayPage { '
'. ''. ''. - ''; + ''; + &Apache::lonxml::clear_problem_counter(); my ($depth,$question,$prob) = (1,1,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" @@ -3348,33 +4017,34 @@ sub displayPage { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.='
 Prob.  '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade
 '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade
'.$prob. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'		'; - if ($ENV{'form.vProb'} eq 'yes' ) { + my %form = ('CODE' => $env{'form.CODE'},); + if ($env{'form.vProb'} eq 'yes' ) { $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, - undef,'both'); + undef,'both',\%form); } else { - my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'}); + my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form); $companswer =~ s|||g; $companswer =~ s|||g; # while ($companswer =~ /()/s) { #\n"); +# $request->print('match='.$1."
\n"); # } # $companswer =~ s||
|g; - $studentTable.=' '.$title.' 
 Correct answer:
'.$companswer; + $studentTable.=' '.$title.' 
 Correct answer:
'.$companswer; } - my %record = &Apache::lonnet::restore($symbx,$ENV{'request.course.id'},$udom,$uname); + my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); - if ($ENV{'form.lastSub'} eq 'datesub') { + if ($env{'form.lastSub'} eq 'datesub') { if ($record{'version'} eq '') { - $studentTable.='
 No recorded submission for this problem
'; + $studentTable.='
 No recorded submission for this problem
'; } else { my %responseType = (); foreach my $partid (@{$parts}) { @@ -3389,10 +4059,10 @@ sub displayPage { $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom); } - } elsif ($ENV{'form.lastSub'} eq 'all') { - my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); + } elsif ($env{'form.lastSub'} eq 'all') { + my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); $studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom, - $ENV{'request.course.id'}, + $env{'request.course.id'}, '','.submission'); } @@ -3410,11 +4080,11 @@ sub displayPage { $curRes = $iterator->next(); } - $studentTable.='
'."\n". + $studentTable.='
'."\n". ''. + 'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'. ''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; @@ -3423,6 +4093,7 @@ sub displayPage { sub displaySubByDates { my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $isCODE=0; + my $isTask = ($symb =~/\.task$/); if (exists($record->{'resource.CODE'})) { $isCODE=1; } my $studentTable='
'. ''. @@ -3435,10 +4106,19 @@ sub displaySubByDates { my %orders; $mark{'correct_by_student'} = $checkIcon; if (!exists($$record{'1:timestamp'})) { - return '
 Nothing submitted - no attempts
'; + return '
 Nothing submitted - no attempts
'; } + + my $interaction; for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = scalar(localtime($$record{$version.':timestamp'})); + if (exists($$record{$version.':resource.0.version'})) { + $interaction = $$record{$version.':resource.0.version'}; + } + + my $where = ($isTask ? "$version:resource.$interaction" + : "$version:resource"); + #&Apache::lonnet::logthis(" got $where"); $studentTable.=''; if ($isCODE) { $studentTable.=''; @@ -3446,40 +4126,57 @@ sub displaySubByDates { my @versionKeys = split(/\:/,$$record{$version.':keys'}); my @displaySub = (); foreach my $partid (@{$parts}) { - my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); + my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) + : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); + + # next if ($$record{"$version:resource.$partid.solved"} eq ''); - my $display_part=&get_display_part($partid,undef,$symb); + my $display_part=&get_display_part($partid,$symb); foreach my $matchKey (@matchKey) { if (exists($$record{$version.':'.$matchKey}) && $$record{$version.':'.$matchKey} ne '') { - my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/); + + my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) + : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); + #&Apache::lonnet::logthis("match $matchKey $responseId (".$$record{$version.':'.$matchKey}); $displaySub[0].='Part: '.$display_part.' '; - $displaySub[0].='(ID '. - $responseId.') '; - if ($$record{"$version:resource.$partid.tries"} eq '') { + $displaySub[0].='(ID '. + $responseId.') '; + if ($$record{"$where.$partid.tries"} eq '') { $displaySub[0].='Trial not counted'; } else { $displaySub[0].='Trial '. - $$record{"$version:resource.$partid.tries"}; + $$record{"$where.$partid.tries"}; } - my $responseType=$responseType->{$partid}->{$responseId}; + my $responseType=($isTask ? 'Task' + : $responseType->{$partid}->{$responseId}); if (!exists($orders{$partid})) { $orders{$partid}={}; } if (!exists($orders{$partid}->{$responseId})) { $orders{$partid}->{$responseId}= &get_order($partid,$responseId,$symb,$uname,$udom); } $displaySub[0].='  '. - &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'
'; + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'
'; } } - if (exists $$record{"$version:resource.$partid.award"}) { + if (exists($$record{"$where.$partid.checkedin"})) { + $displaySub[1].='Checked in by '. + $$record{"$where.$partid.checkedin"}.' into slot '. + $$record{"$where.$partid.checkedin.slot"}. + '
'; + } + if (exists $$record{"$where.$partid.award"}) { $displaySub[1].='Part: '.$display_part.'  '. - lc($$record{"$version:resource.$partid.award"}).' '. - $mark{$$record{"$version:resource.$partid.solved"}}. + lc($$record{"$where.$partid.award"}).' '. + $mark{$$record{"$where.$partid.solved"}}. '
'; } - if (exists $$record{"$version:resource.$partid.regrader"}) { - $displaySub[2].=$$record{"$version:resource.$partid.regrader"}. + if (exists $$record{"$where.$partid.regrader"}) { + $displaySub[2].=$$record{"$where.$partid.regrader"}. + ' ('.&mt('Part').': '.$display_part.')'; + } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { + $displaySub[2].= + $$record{"$version:resource.$partid.regrader"}. ' ('.&mt('Part').': '.$display_part.')'; } } @@ -3501,28 +4198,33 @@ sub displaySubByDates { sub updateGradeByPage { my ($request) = shift; - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; - my $pageTitle = $ENV{'form.page'}; + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $pageTitle = $env{'form.page'}; my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); - my ($uname,$udom) = split(/:/,$ENV{'form.student'}); - my $usec=$classlist->{$ENV{'form.student'}}[5]; + my ($uname,$udom) = split(/:/,$env{'form.student'}); + my $usec=$classlist->{$env{'form.student'}}[5]; if (!&canmodify($usec)) { - $request->print('Unable to modify requested student.('.$ENV{'form.student'}.''); - $request->print(&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'})); + $request->print('Unable to modify requested student.('.$env{'form.student'}.''); + $request->print(&show_grading_menu_form($env{'form.symb'})); return; } - my $result='

 '.$ENV{'form.title'}.'

'; - $result.='

 Student: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom). + my $result='

 '.$env{'form.title'}.'

'; + $result.='

 Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom). '

'."\n"; $request->print($result); my $navmap = Apache::lonnavmaps::navmap->new(); - my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $ENV{'form.page'}); + my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps - + if (!$map) { + $request->print('Unable to grade requested sequence. ('.$resUrl.')'); + my ($symb)=&get_symb($request); + $request->print(&show_grading_menu_form($symb)); + return; + } my $iterator = $navmap->getIterator($map->map_start(), $map->map_finish()); @@ -3540,22 +4242,24 @@ sub updateGradeByPage { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; my %newrecord=(); my @displayPts=(); + my %aggregate = (); + my $aggregateflag = 0; foreach my $partid (@{$parts}) { - my $newpts = $ENV{'form.GD_BOX'.$question.'_'.$partid}; - my $oldpts = $ENV{'form.oldpts'.$question.'_'.$partid}; + my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid}; + my $oldpts = $env{'form.oldpts'.$question.'_'.$partid}; - my $wgt = $ENV{'form.WGT'.$question.'_'.$partid} != 0 ? - $ENV{'form.WGT'.$question.'_'.$partid} : 1; + my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? + $env{'form.WGT'.$question.'_'.$partid} : 1; my $partial = $newpts/$wgt; my $score; if ($partial > 0) { @@ -3563,44 +4267,70 @@ sub updateGradeByPage { } elsif ($newpts ne '') { #empty is taken as 0 $score = 'incorrect_by_override'; } - my $dropMenu = $ENV{'form.GD_SEL'.$question.'_'.$partid}; + my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid}; if ($dropMenu eq 'excused') { $partial = ''; $score = 'excused'; } elsif ($dropMenu eq 'reset status' - && $ENV{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists + && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists $newrecord{'resource.'.$partid.'.tries'} = 0; $newrecord{'resource.'.$partid.'.solved'} = ''; $newrecord{'resource.'.$partid.'.award'} = ''; $newrecord{'resource.'.$partid.'.awarded'} = 0; - $newrecord{'resource.'.$partid.'.regrader'} = "$ENV{'user.name'}:$ENV{'user.domain'}"; + $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"; $changeflag++; $newpts = ''; + + my $aggtries = $env{'form.aggtries'.$question.'_'.$partid}; + my $totaltries = $env{'form.totaltries'.$question.'_'.$partid}; + my $solvedstatus = $env{'form.solved'.$question.'_'.$partid}; + if ($aggtries > 0) { + &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus); + $aggregateflag = 1; + } } - my $display_part=&get_display_part($partid,undef, - $curRes->symb()); - my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid}; + my $display_part=&get_display_part($partid,$curRes->symb()); + my $oldstatus = $env{'form.solved'.$question.'_'.$partid}; $displayPts[0].=' Part: '.$display_part.' = '. (($oldstatus eq 'excused') ? 'excused' : $oldpts). - ' 
'; + ' 
'; $displayPts[1].=' Part: '.$display_part.' = '. (($score eq 'excused') ? 'excused' : $newpts). - ' 
'; - + ' 
'; $question++; - next if ($dropMenu eq 'reset status' || ($newpts == $oldpts && $score ne 'excused')); + next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; - $newrecord{'resource.'.$partid.'.regrader'} = "$ENV{'user.name'}:$ENV{'user.domain'}" + $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}" if (scalar(keys(%newrecord)) > 0); $changeflag++; } if (scalar(keys(%newrecord)) > 0) { - &Apache::lonnet::cstore(\%newrecord,$symbx,$ENV{'request.course.id'}, + my %record = + &Apache::lonnet::restore($symbx,$env{'request.course.id'}, + $udom,$uname); + + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $newrecord{'resource.CODE'} = $env{'form.CODE'}; + } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { + $newrecord{'resource.CODE'} = ''; + } + &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, $udom,$uname); + %record = &Apache::lonnet::restore($symbx, + $env{'request.course.id'}, + $udom,$uname); + &check_and_remove_from_queue($parts,\%record,undef,$symbx, + $cdom,$cnum,$udom,$uname); } + + if ($aggregateflag) { + &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + } $studentTable.=''. ''. @@ -3612,7 +4342,7 @@ sub updateGradeByPage { } $studentTable.='
'.$timestamp.''.$record->{$version.':resource.CODE'}.'
'.$prob. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'		 '.$title.' '.$displayPts[0].''.$displayPts[1].'
'; - $studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'}); + $studentTable.=&show_grading_menu_form($env{'form.symb'}); my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' : 'The scores were changed for '. $changeflag.' problem'.($changeflag == 1 ? '.' : 's.')); @@ -3629,25 +4359,97 @@ sub updateGradeByPage { # #------ start of section for handling grading by page/sequence --------- +=pod + +=head1 Bubble sheet grading routines + + For this documentation: + + 'scanline' refers to the full line of characters + from the file that we are parsing that represents one entire sheet + + 'bubble line' refers to the data + representing the line of bubbles that are on the physical bubble sheet + + +The overall process is that a scanned in bubble sheet data is uploaded +into a course. When a user wants to grade, they select a +sequence/folder of resources, a file of bubble sheet info, and pick +one of the predefined configurations for what each scanline looks +like. + +Next each scanline is checked for any errors of either 'missing +bubbles' (it's an error because it may have been missed scanned +because too light bubbling), 'double bubble' (each bubble line should +have no more that one letter picked), invalid or duplicated CODE, +invalid student ID + +If the CODE option is used that determines the randomization of the +homework problems, either way the student ID is looked up into a +username:domain. + +During the validation phase the instructor can choose to skip scanlines. + +After the validation phase, there is now 3 bubble sheet files + + scantron_original_filename (unmodified original file) + scantron_corrected_filename (file where the corrected information has replaced the original information) + scantron_skipped_filename (contains the exact text of scanlines that where skipped) + +Also there is a separate hash nohist_scantrondata that contains extra +correction information that isn't representable in the bubble sheet +file (see &scantron_getfile() for more information) + +After all scanlines are either valid, marked as valid or skipped, then +foreach line foreach problem in the picked sequence, an ssi request is +made that simulates a user submitting their selected letter(s) against +the homework problem. + +=over 4 + +=cut + + +=pod + +=item defaultFormData + + Returns html hidden inputs used to hold context/default values. + + Arguments: + $symb - $symb of the current resource + +=cut + sub defaultFormData { - my ($symb,$url)=@_; + my ($symb)=@_; return ' - '."\n". - ''."\n". - ''."\n". - ''."\n"; + '."\n". + ''."\n". + ''."\n"; } +=pod + +=item getSequenceDropDown + + Return html dropdown of possible sequences to grade + + Arguments: + $symb - $symb of the current resource + +=cut + sub getSequenceDropDown { - my ($request,$symb)=@_; + my ($symb)=@_; my $result=''; $result.=""; foreach my $filename (sort(&scantron_filenames())) { - $result.="$filename\n"; + $result.="$filename\n"; } $result.=""; return $result; } +=pod + +=item scantron_scantab + + Returns html drop down of the scantron formats in the scantronformat.tab + file. + +=cut + sub scantron_scantab { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result=''.$namechoice.''; return $namechoice; } +=pod + +=item scantron_CODEunique + + Returns the html for "Each CODE to be used once" radio. + +=cut + sub scantron_CODEunique { - my $result=' - Yes - - - No - '; + my $result=' + + + + + '; return $result; } +=pod + +=item scantron_selectphase + + Generates the initial screen to start the bubble sheet process. + Allows for - starting a grading run. + - downloading existing scan data (original, corrected + or skipped info) + + - uploading new scan data + + Arguments: + $r - The Apache request object + $file2grade - name of the file that contain the scanned data to score + +=cut + sub scantron_selectphase { my ($r,$file2grade) = @_; - my ($symb,$url)=&get_symb_and_url($r); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $sequence_selector=&getSequenceDropDown($r,$symb); - my $default_form_data=&defaultFormData($symb,$url); - my $grading_menu_button=&show_grading_menu_form($symb,$url); + my $sequence_selector=&getSequenceDropDown($symb); + my $default_form_data=&defaultFormData($symb); + my $grading_menu_button=&show_grading_menu_form($symb); my $file_selector=&scantron_uploads($file2grade); 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, + + # Chunk of form to prompt for a file to grade and how: + $result.= < @@ -3765,13 +4632,14 @@ sub scantron_selectphase { Options: - Do only previously skipped records
- Remove all exisiting corrections +
+
+ - + @@ -3782,8 +4650,10 @@ SCANTRONFORM $r->print($result); - if (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'}) || - &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) || + &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { + + # Chunk of form to prompt for a scantron file upload. $r->print(< @@ -3797,9 +4667,9 @@ SCANTRONFORM 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'}; + my $default_form_data=&defaultFormData(&get_symb($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) { @@ -3830,10 +4700,15 @@ UPLOAD SCANTRONFORM } + + # Chunk of the form that prompts to view a scoring office file, + # corrected file, skipped records in a file. + $r->print(<
+ $default_form_data @@ -3846,7 +4721,7 @@ SCANTRONFORM
- +
@@ -3863,6 +4738,63 @@ SCANTRONFORM return } +=pod + +=item get_scantron_config + + Parse and return the scantron configuration line selected as a + hash of configuration file fields. + + Arguments: + which - the name of the configuration to parse from the file. + + + Returns: + If the named configuration is not in the file, an empty + hash is returned. + a hash with the fields + name - internal name for the this configuration setup + description - text to display to operator that describes this config + CODElocation - if 0 or the string 'none' + - no CODE exists for this config + if -1 || the string 'letter' + - a CODE exists for this config and is + a string of letters + Unsupported value (but planned for future support) + if a positive integer + - The CODE exists as the first n items from + the question section of the form + if the string 'number' + - The CODE exists for this config and is + a string of numbers + CODEstart - (only matter if a CODE exists) column in the line where + the CODE starts + CODElength - length of the CODE + IDstart - column where the student ID number starts + IDlength - length of the student ID info + Qstart - column where the information from the bubbled + 'questions' start + Qlength - number of columns comprising a single bubble line from + the sheet. (usually either 1 or 10) + Qon - either a single character representing the character used + to signal a bubble was chosen in the positional setup, or + the string 'letter' if the letter of the chosen bubble is + in the final, or 'number' if a number representing the + chosen bubble is in the file (1->A 0->J) + Qoff - the character used to represent that a bubble was + left blank + PaperID - if the scanning process generates a unique number for each + sheet scanned the column that this ID number starts in + PaperIDlength - number of columns that comprise the unique ID number + for the sheet of paper + FirstName - column that the first name starts in + FirstNameLength - number of columns that the first name spans + + LastName - column that the last name starts in + LastNameLength - number of columns that the last name spans + +=cut + sub get_scantron_config { my ($which) = @_; my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); @@ -3895,6 +4827,25 @@ sub get_scantron_config { return %config; } +=pod + +=item username_to_idmap + + creates a hash keyed by student id with values of the corresponding + student username:domain. + + Arguments: + + $classlist - reference to the class list hash. This is a hash + keyed by student name:domain whose elements are references + to arrays containing various chunks of information + about the student. (See loncoursedata for more info). + + Returns + %idmap - the constructed hash + +=cut + sub username_to_idmap { my ($classlist)= @_; my %idmap; @@ -3905,8 +4856,50 @@ sub username_to_idmap { return %idmap; } +=pod + +=item scantron_fixup_scanline + + Process a requested correction to a scanline. + + Arguments: + $scantron_config - hash from &get_scantron_config() + $scan_data - hash of correction information + (see &scantron_getfile()) + $line - existing scanline + $whichline - line number of the passed in scanline + $field - type of change to process + (either + 'ID' -> correct the student ID number + 'CODE' -> correct the CODE + 'answer' -> fixup the submitted answers) + + $args - hash of additional info, + - 'ID' + 'newid' -> studentID to use in replacement + of existing one + - 'CODE' + 'CODE_ignore_dup' - set to true if duplicates + should be ignored. + 'CODE' - is new code or 'use_unfound' + if the existing unfound code should + be used as is + - 'answer' + 'response' - new answer or 'none' if blank + 'question' - the bubble line to change + + Returns: + $line - the modified scanline + + Side effects: + $scan_data - may be updated + +=cut + + 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 too large'); @@ -3945,7 +4938,15 @@ sub scantron_fixup_scanline { &scan_data($scan_data, "$whichline.no_bubble.".$args->{'question'},'1'); } else { - substr($answer,$args->{'response'},1)=$on; + if ($on eq 'letter') { + my @alphabet=('A'..'Z'); + $answer=$alphabet[$args->{'response'}]; + } elsif ($on eq 'number') { + $answer=$args->{'response'}+1; + if ($answer == 10) { $answer = '0'; } + } else { + substr($answer,$args->{'response'},1)=$on; + } &scan_data($scan_data, "$whichline.no_bubble.".$args->{'question'},undef,'1'); } @@ -3955,9 +4956,28 @@ sub scantron_fixup_scanline { return $line; } +=pod + +=item scan_data + + Edit or look up an item in the scan_data hash. + + Arguments: + $scan_data - The hash (see scantron_getfile) + $key - shorthand of the key to edit (actual key is + scantronfilename_key). + $data - New value of the hash entry. + $delete - If true, the entry is removed from the hash. + + Returns: + The new value of the hash table field (undefined if deleted). + +=cut + + sub scan_data { my ($scan_data,$key,$value,$delete)=@_; - my $filename=$ENV{'form.scantron_selectfile'}; + my $filename=$env{'form.scantron_selectfile'}; if (defined($value)) { $scan_data->{$filename.'_'.$key} = $value; } @@ -3965,13 +4985,68 @@ sub scan_data { return $scan_data->{$filename.'_'.$key}; } +=pod + +=item scantron_parse_scanline + + Decodes a scanline from the selected scantron file + + Arguments: + line - The text of the scantron file line to process + whichline - Line number + scantron_config - Hash describing the format of the scantron lines. + scan_data - Hash of extra information about the scanline + (see scantron_getfile for more information) + just_header - True if should not process question answers but only + the stuff to the left of the answers. + Returns: + Hash containing the result of parsing the scanline + + Keys are all proceeded by the string 'scantron.' + + CODE - the CODE in use for this scanline + useCODE - 1 if the CODE is invalid but it usage has been forced + by the operator + CODE_ignore_dup - 1 if the CODE is a duplicated use when unique + CODEs were selected, but the usage has been + forced by the operator + ID - student ID + PaperID - if used, the ID number printed on the sheet when the + paper was scanned + FirstName - first name from the sheet + LastName - last name from the sheet + + if just_header was not true these key may also exist + + missingerror - a list of bubbled line numbers that had a blank bubble + that is considered an error (if the operator had already + okayed a blank bubble line as really being blank then + that bubble line number won't appear here. + doubleerror - a list of bubbled line numbers that had more than one + bubble filled in and has not been corrected by the + operator + maxquest - the number of the last bubble line that was parsed + + ( starts at 1) + .answer - zero or more letters representing the selected + letters from the scanline for the bubble line + . + if blank there was either no bubble or there where + multiple bubbles, (consult the keys missingerror and + doubleerror if this is an error condition) + +=cut + sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_; + my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_; my %record; - my $questions=substr($line,$$scantron_config{'Qstart'}-1); - my $data=substr($line,0,$$scantron_config{'Qstart'}-1); - if ($$scantron_config{'CODElocation'} ne 0) { - if ($$scantron_config{'CODElocation'} < 0) { + my $questions=substr($line,$$scantron_config{'Qstart'}-1); # Answers + my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff + if (!($$scantron_config{'CODElocation'} eq 0 || + $$scantron_config{'CODElocation'} eq 'none')) { + if ($$scantron_config{'CODElocation'} < 0 || + $$scantron_config{'CODElocation'} eq 'letter' || + $$scantron_config{'CODElocation'} eq 'number') { $record{'scantron.CODE'}=substr($data, $$scantron_config{'CODEstart'}-1, $$scantron_config{'CODElength'}); @@ -3996,7 +5071,7 @@ sub scantron_parse_scanline { $record{'scantron.LastName'}= substr($data,$$scantron_config{'LastName'}-1, $$scantron_config{'LastNamelength'}); - if ($justHeader) { return \%record; } + if ($just_header) { return \%record; } my @alphabet=('A'..'Z'); my $questnum=0; @@ -4006,8 +5081,13 @@ sub scantron_parse_scanline { substr($questions,0,$$scantron_config{'Qlength'})=''; if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } if ($$scantron_config{'Qon'} eq 'letter') { - if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || - $currentquest !~ /^[A-Z]$/) { + if ($currentquest eq '?' + || $currentquest eq '*') { + push(@{$record{'scantron.doubleerror'}},$questnum); + $record{"scantron.$questnum.answer"}=''; + } elsif (!defined($currentquest) + || $currentquest eq $$scantron_config{'Qoff'} + || $currentquest !~ /^[A-Z]$/) { $record{"scantron.$questnum.answer"}=''; if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); @@ -4016,15 +5096,26 @@ sub scantron_parse_scanline { $record{"scantron.$questnum.answer"}=$currentquest; } } elsif ($$scantron_config{'Qon'} eq 'number') { - if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || - $currentquest !~ /^\d$/) { + if ($currentquest eq '?' + || $currentquest eq '*') { + push(@{$record{'scantron.doubleerror'}},$questnum); + $record{"scantron.$questnum.answer"}=''; + } elsif (!defined($currentquest) + || $currentquest eq $$scantron_config{'Qoff'} + || $currentquest !~ /^\d$/) { $record{"scantron.$questnum.answer"}=''; if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); } } else { - $record{"scantron.$questnum.answer"}= - $alphabet[$currentquest-1]; + # wrap zero back to J + if ($currentquest eq '0') { + $record{"scantron.$questnum.answer"}= + $alphabet[9]; + } else { + $record{"scantron.$questnum.answer"}= + $alphabet[$currentquest-1]; + } } } else { my @array=split($$scantron_config{'Qon'},$currentquest,-1); @@ -4053,6 +5144,24 @@ sub scantron_parse_scanline { return \%record; } +=pod + +=item scantron_add_delay + + Adds an error message that occurred during the grading phase to a + queue of messages to be shown after grading pass is complete + + Arguments: + $delayqueue - arrary ref of hash ref of error messages + $scanline - the scanline that caused the error + $errormesage - the error message + $errorcode - a numeric code for the error + + Side Effects: + updates the $delayqueue to have a new hash ref of the error + +=cut + sub scantron_add_delay { my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; push(@$delayqueue, @@ -4061,6 +5170,24 @@ sub scantron_add_delay { ); } +=pod + +=item scantron_find_student + + Finds the username for the current scanline + + Arguments: + $scantron_record - hash result from scantron_parse_scanline + $scan_data - hash of correction information + (see &scantron_getfile() form more information) + $idmap - hash from &username_to_idmap() + $line - number of current scanline + + Returns: + Either 'username:domain' or undef if unknown + +=cut + sub scantron_find_student { my ($scantron_record,$scan_data,$idmap,$line)=@_; my $scanID=$$scantron_record{'scantron.ID'}; @@ -4075,96 +5202,164 @@ sub scantron_find_student { return undef; } +=pod + +=item scantron_filter + + Filter sub for lonnavmaps, filters out hidden resources if ignore + hidden resources was selected + +=cut + sub scantron_filter { my ($curres)=@_; - # randomout is dysfunctional at best for this purpose - if (ref($curres) && $curres->is_problem()) { #&& !$curres->randomout) { + + if (ref($curres) && $curres->is_problem()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } return 1; } return 0; } +=pod + +=item scantron_process_corrections + + Gets correction information out of submitted form data and corrects + the scanline + +=cut + sub scantron_process_corrections { my ($r) = @_; - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + 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 $which=$env{'form.scantron_line'}; my $line=&scantron_get_line($scanlines,$scan_data,$which); my ($skip,$err,$errmsg); - if ($ENV{'form.scantron_skip_record'}) { + 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'}; + } 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'} =~ /^(duplicate|incorrect)CODE$/) { - my $resolution=$ENV{'form.scantron_CODE_resolution'}; + 'username'=>$env{'form.scantron_username'}, + 'domain'=>$env{'form.scantron_domain'}}); + } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { + my $resolution=$env{'form.scantron_CODE_resolution'}; my $newCODE; my %args; if ($resolution eq 'use_unfound') { $newCODE='use_unfound'; } elsif ($resolution eq 'use_found') { - $newCODE=$ENV{'form.scantron_CODE_selectedvalue'}; + $newCODE=$env{'form.scantron_CODE_selectedvalue'}; } elsif ($resolution eq 'use_typed') { - $newCODE=$ENV{'form.scantron_CODE_newvalue'}; + $newCODE=$env{'form.scantron_CODE_newvalue'}; } elsif ($resolution =~ /^use_closest_(\d+)/) { - $newCODE=$ENV{"form.scantron_CODE_closest_$1"}; + $newCODE=$env{"form.scantron_CODE_closest_$1"}; } - if ($ENV{'form.scantron_corrections'} eq 'duplicateCODE') { + if ($env{'form.scantron_corrections'} eq 'duplicateCODE') { $args{'CODE_ignore_dup'}=1; } $args{'CODE'}=$newCODE; ($line,$err,$errmsg)= &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, 'CODE',\%args); - } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { - foreach my $question (split(',',$ENV{'form.scantron_questions'})) { + } 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"}}); + 'response'=>$env{"form.scantron_correct_Q_$question"}}); if ($err) { last; } } } if ($err) { - $r->print("Unable to accept last correction, an error occurred :$errmsg:"); + $r->print("Unable to accept last correction, an error occurred :$errmsg:"); } else { &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); &scantron_putfile($scanlines,$scan_data); } } +=pod + +=item reset_skipping_status + + Forgets the current set of remember skipped scanlines (and thus + reverts back to considering all lines in the + scantron_skipped_ file) + +=cut + sub reset_skipping_status { my ($scanlines,$scan_data)=&scantron_getfile(); &scan_data($scan_data,'remember_skipping',undef,1); &scantron_putfile(undef,$scan_data); } -sub allow_skipping { +=pod + +=item start_skipping + + Marks a scanline to be skipped. + +=cut + +sub start_skipping { my ($scan_data,$i)=@_; my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - delete($remembered{$i}); + if ($env{'form.scantron_options_redo'} =~ /^redo_/) { + $remembered{$i}=2; + } else { + $remembered{$i}=1; + } &scan_data($scan_data,'remember_skipping',join(':',%remembered)); } +=pod + +=item should_be_skipped + + Checks whether a scanline should be skipped. + +=cut + sub should_be_skipped { - my ($scan_data,$i)=@_; - if ($ENV{'form.scantron_options_redo'} !~ /^redo_/) { + my ($scanlines,$scan_data,$i)=@_; + if ($env{'form.scantron_options_redo'} !~ /^redo_/) { # not redoing old skips + if ($scanlines->{'skipped'}[$i]) { return 1; } return 0; } my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - if (exists($remembered{$i})) { return 0; } + + if (exists($remembered{$i}) && $remembered{$i} != 2 ) { + return 0; + } return 1; } +=pod + +=item remember_current_skipped + + Discovers what scanlines are in the scantron_skipped_ + file and remembers them into scan_data for later use. + +=cut + sub remember_current_skipped { my ($scanlines,$scan_data)=&scantron_getfile(); my %to_remember; @@ -4173,31 +5368,61 @@ sub remember_current_skipped { $to_remember{$i}=1; } } - &Apache::lonnet::logthis('remembering '.join(':',%to_remember)); + &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); &scantron_putfile(undef,$scan_data); } +=pod + +=item check_for_error + + Checks if there was an error when attempting to remove a specific + scantron_.. bubble sheet data file. Prints out an error if + something went wrong. + +=cut + sub check_for_error { my ($r,$result)=@_; if ($result ne 'ok' && $result ne 'not_found' ) { - $r->print("An error occured ($result) when trying to Remove the existing corrections."); + $r->print("An error occurred ($result) when trying to Remove the existing corrections."); } } +=pod + +=item scantron_warning_screen + + Interstitial screen to make sure the operator has selected the + correct options before we start the validation phase. + +=cut + sub scantron_warning_screen { my ($button_text)=@_; - my $title=&Apache::lonnet::gettitle($ENV{'form.selectpage'}); + my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my $CODElist; + if ($scantron_config{'CODElocation'} && + $scantron_config{'CODEstart'} && + $scantron_config{'CODElength'}) { + $CODElist=$env{'form.scantron_CODElist'}; + if ($env{'form.scantron_CODElist'} eq '') { $CODElist='None'; } + $CODElist= + 'List of CODES to validate against:'. + $env{'form.scantron_CODElist'}.''; + } return (< -Please double check the information - below before clicking on '$button_text' +Please double check the information + below before clicking on '$button_text'

- - + + +$CODElist
Sequence To be Graded:$title
Data File that will be used:$ENV{'form.scantron_selectfile'}
Sequence to be Graded:$title
Data File that will be used:$env{'form.scantron_selectfile'}
-

If this information is correct, please click on '$button_text'.

If something is incorrect, please click the 'Grading Menu' button to start over.

@@ -4206,95 +5431,125 @@ sub scantron_warning_screen { STUFF } +=pod + +=item scantron_do_warning + + Check if the operator has picked something for all required + fields. Error out if something is missing. + +=cut + sub scantron_do_warning { my ($r)=@_; - my ($symb,$url)=&get_symb_and_url($r); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); $r->print(&scantron_form_start().$default_form_data); - if ( $ENV{'form.selectpage'} eq '' || - $ENV{'form.scantron_selectfile'} eq '' || - $ENV{'form.scantron_format'} eq '' ) { + if ( $env{'form.selectpage'} eq '' || + $env{'form.scantron_selectfile'} eq '' || + $env{'form.scantron_format'} eq '' ) { $r->print("

You have forgetten to specify some information. Please go Back and try again.

"); - if ( $ENV{'form.selectpage'} eq '') { - $r->print('

You have not selected a Sequence to grade

'); + if ( $env{'form.selectpage'} eq '') { + $r->print('

You have not selected a Sequence to grade

'); } - if ( $ENV{'form.scantron_selectfile'} eq '') { - $r->print('

You have not selected a file that contains the student\'s response data.

'); + if ( $env{'form.scantron_selectfile'} eq '') { + $r->print('

You have not selected a file that contains the student\'s response data.

'); } - if ( $ENV{'form.scantron_format'} eq '') { - $r->print('

You have not selected a the format of the student\'s response data.

'); + if ( $env{'form.scantron_format'} eq '') { + $r->print('

You have not selected a the format of the student\'s response data.

'); } } else { - my $warning=&scantron_warning_screen('Validate Records'); + my $warning=&scantron_warning_screen('Grading: Validate Records'); $r->print(< + STUFF } - $r->print("
".&show_grading_menu_form($symb,$url).""); + $r->print("
".&show_grading_menu_form($symb)); return ''; } +=pod + +=item scantron_form_start + + html hidden input for remembering all selected grading options + +=cut + sub scantron_form_start { my ($max_bubble)=@_; my $result= < - - - + + + - - - - + + + + + SCANTRONFORM return $result; } +=pod + +=item scantron_validate_file + + Dispatch routine for doing validation of a bubble sheet data file. + + Also processes any necessary information resets that need to + occur before validation begins (ignore previous corrections, + restarting the skipped records processing) + +=cut + sub scantron_validate_file { my ($r) = @_; - my ($symb,$url)=&get_symb_and_url($r); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); # do the detection of only doing skipped records first befroe we delete - # them when doing the corrections reset - if ($ENV{'form.scantron_options_redo'} ne 'redo_skipped_ready') { + # them when doing the corrections reset + if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') { &reset_skipping_status(); } - if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped') { + if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { &remember_current_skipped(); - &scantron_remove_file('skipped'); - $ENV{'form.scantron_options_redo'}='redo_skipped_ready'; + $env{'form.scantron_options_redo'}='redo_skipped_ready'; } - if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') { + if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') { &check_for_error($r,&scantron_remove_file('corrected')); &check_for_error($r,&scantron_remove_file('skipped')); &check_for_error($r,&scantron_remove_scan_data()); - $ENV{'form.scantron_options_ignore'}='done'; + $env{'form.scantron_options_ignore'}='done'; } - if ($ENV{'form.scantron_corrections'}) { + if ($env{'form.scantron_corrections'}) { &scantron_process_corrections($r); } - $r->print("

Gathering neccessary info.

");$r->rflush(); + $r->print("

Gathering necessary info.

");$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $max_bubble=&scantron_get_maxbubble($r); + my $max_bubble=&scantron_get_maxbubble(); my $result=&scantron_form_start($max_bubble).$default_form_data; $r->print($result); - my @validate_phases=( 'ID', + my @validate_phases=( 'sequence', + 'ID', 'CODE', 'doublebubble', 'missingbubbles'); - if (!$ENV{'form.validatepass'}) { - $ENV{'form.validatepass'} = 0; + if (!$env{'form.validatepass'}) { + $env{'form.validatepass'} = 0; } - my $currentphase=$ENV{'form.validatepass'}; + my $currentphase=$env{'form.validatepass'}; my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { @@ -4320,39 +5575,68 @@ STUFF $r->print(""); } if ($stop) { - $r->print(''); - $r->print(' using corrected info
'); - $r->print(""); - $r->print(" this scanline saving it for later."); + if ($validate_phases[$currentphase] eq 'sequence') { + $r->print(''); + $r->print(' this error
'); + + $r->print("

Or click the 'Grading Menu' button to start over.

"); + } else { + $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). - ""); + $r->print("
".&show_grading_menu_form($symb)); return ''; } + +=pod + +=item scantron_remove_file + + Removes the requested bubble sheet data file, makes sure that + scantron_original_ is never removed + + +=cut + sub scantron_remove_file { my ($which)=@_; - my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $file='scantron_'; if ($which eq 'corrected' || $which eq 'skipped') { $file.=$which.'_'; } else { return 'refused'; } - $file.=$ENV{'form.scantron_selectfile'}; + $file.=$env{'form.scantron_selectfile'}; return &Apache::lonnet::removeuserfile($cname,$cdom,$file); } + +=pod + +=item scantron_remove_scan_data + + Removes all scan_data correction for the requested bubble sheet + data file. (In the case that both the are doing skipped records we need + to remember the old skipped lines for the time being so that element + persists for a while.) + +=cut + sub scantron_remove_scan_data { - my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); my @todelete; - my $filename=$ENV{'form.scantron_selectfile'}; + my $filename=$env{'form.scantron_selectfile'}; foreach my $key (@keys) { if ($key=~/^\Q$filename\E_/) { - if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped_ready' && + if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' && $key=~/remember_skipping/) { next; } @@ -4366,27 +5650,72 @@ sub scantron_remove_scan_data { return $result; } + +=pod + +=item scantron_getfile + + Fetches the requested bubble sheet data file (all 3 versions), and + the scan_data hash + + Arguments: + None + + Returns: + 2 hash references + + - first one has + orig - + corrected - + skipped - each of which points to an array ref of the specified + file broken up into individual lines + count - number of scanlines + + - second is the scan_data hash possible keys are + ($number refers to scanline numbered $number and thus the key affects + only that scanline + $bubline refers to the specific bubble line element and the aspects + refers to that specific bubble line element) + + $number.user - username:domain to use + $number.CODE_ignore_dup + - ignore the duplicate CODE error + $number.useCODE + - use the CODE in the scanline as is + $number.no_bubble.$bubline + - it is valid that there is no bubbled in bubble + at $number $bubline + remember_skipping + - a frozen hash containing keys of $number and values + of either + 1 - we are on a 'do skipped records pass' and plan + on processing this line + 2 - we are on a 'do skipped records pass' and this + scanline has been marked to skip yet again + +=cut + sub scantron_getfile { #FIXME really would prefer a scantron directory - my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + 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'}); + 'scantron_orig_'.$env{'form.scantron_selectfile'}); 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'}); + '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'}); + 'scantron_skipped_'.$env{'form.scantron_selectfile'}); if ($lines eq '-1') { $scanlines{'skipped'}=[]; } else { @@ -4398,44 +5727,113 @@ sub scantron_getfile { return (\%scanlines,\%scan_data); } +=pod + +=item lonnet_putfile + + Wrapper routine to call &Apache::lonnet::finishuserfileupload + + Arguments: + $contents - data to store + $filename - filename to store $contents into + + Returns: + result value from &Apache::lonnet::finishuserfileupload + +=cut + 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); + my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; + $env{'form.sillywaytopassafilearound'}=$contents; + &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename); } +=pod + +=item scantron_putfile + + Stores the current version of the bubble sheet data files, and the + scan_data hash. (Does not modify the original version only the + corrected and skipped versions. + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + +=cut + sub scantron_putfile { my ($scanlines,$scan_data) = @_; #FIXME really would prefer a scantron directory - my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; if ($scanlines) { my $prefix='scantron_'; # no need to update orig, shouldn't change # &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'. -# $ENV{'form.scantron_selectfile'}); +# $env{'form.scantron_selectfile'}); &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}), $prefix.'corrected_'. - $ENV{'form.scantron_selectfile'}); + $env{'form.scantron_selectfile'}); &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}), $prefix.'skipped_'. - $ENV{'form.scantron_selectfile'}); + $env{'form.scantron_selectfile'}); } &Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname); } +=pod + +=item scantron_get_line + + Returns the correct version of the scanline + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + $i - number of the requested line (starts at 0) + + Returns: + A scanline, (either the original or the corrected one if it + exists), or undef if the requested scanline should be + skipped. (Either because it's an skipped scanline, or it's an + unskipped scanline and we are not doing a 'do skipped scanlines' + pass. + +=cut + sub scantron_get_line { my ($scanlines,$scan_data,$i)=@_; - if (&should_be_skipped($scan_data,$i)) { return undef; } - if ($scanlines->{'skipped'}[$i]) { return undef; } + if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } + #if ($scanlines->{'skipped'}[$i]) { return undef; } if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} return $scanlines->{'orig'}[$i]; } +=pod + +=item scantron_todo_count + + Counts the number of scanlines that need processing. + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + + Returns: + $count - number of scanlines to process + +=cut + sub get_todo_count { my ($scanlines,$scan_data)=@_; my $count=0; @@ -4447,16 +5845,125 @@ sub get_todo_count { return $count; } +=pod + +=item scantron_put_line + + Updates the 'corrected' or 'skipped' versions of the bubble sheet + data file. + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + $i - line number to update + $newline - contents of the updated scanline + $skip - if true make the line for skipping and update the + 'skipped' file + +=cut + sub scantron_put_line { my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { $scanlines->{'skipped'}[$i]=$newline; - &allow_skipping($scan_data,$i); + &start_skipping($scan_data,$i); return; } $scanlines->{'corrected'}[$i]=$newline; } +=pod + +=item scantron_clear_skip + + Remove a line from the 'skipped' file + + Arguments: + $scanlines - hash ref that looks like the first return value from + &scantron_getfile() + $scan_data - hash ref that looks like the second return value from + &scantron_getfile() + $i - line number to update + +=cut + +sub scantron_clear_skip { + my ($scanlines,$scan_data,$i)=@_; + if (exists($scanlines->{'skipped'}[$i])) { + undef($scanlines->{'skipped'}[$i]); + return 1; + } + return 0; +} + +=pod + +=item scantron_filter_not_exam + + Filter routine used by &Apache::lonnavmaps::retrieveResources(), to + filter out resources that are not marked as 'exam' mode + +=cut + +sub scantron_filter_not_exam { + my ($curres)=@_; + + if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } + return 1; + } + return 0; +} + +=pod + +=item scantron_validate_sequence + + Validates the selected sequence, checking for resource that are + not set to exam mode. + +=cut + +sub scantron_validate_sequence { + my ($r,$currentphase) = @_; + + my $navmap=Apache::lonnavmaps::navmap->new(); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($env{'form.selectpage'}); + + my $map=$navmap->getResourceByUrl($sequence); + + $r->print(''); + if ($env{'form.validate_sequence_exam'} ne 'ignore') { + my @resources= + $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); + if (@resources) { + $r->print("

".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."

"); + return (1,$currentphase); + } + } + + return (0,$currentphase+1); +} + +=pod + +=item scantron_validate_ID + + Validates all scanlines in the selected file to not have any + invalid or underspecified student IDs + +=cut + sub scantron_validate_ID { my ($r,$currentphase) = @_; @@ -4465,7 +5972,7 @@ sub scantron_validate_ID { my %idmap=&username_to_idmap($classlist); #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my %found=('ids'=>{},'usernames'=>{}); @@ -4519,6 +6026,36 @@ sub scantron_validate_ID { return (0,$currentphase+1); } +=pod + +=item scantron_get_correction + + Builds the interface screen to interact with the operator to fix a + specific error condition in a specific scanline + + Arguments: + $r - Apache request object + $i - number of the current scanline + $scan_record - hash ref as returned from &scantron_parse_scanline() + $scan_config - hash ref as returned from &get_scantron_config() + $line - full contents of the current scanline + $error - error condition, valid values are + 'incorrectCODE', 'duplicateCODE', + 'doublebubble', 'missingbubble', + 'duplicateID', 'incorrectID' + $arg - extra information needed + For errors: + - duplicateID - paper number that this studentID was seen before on + - duplicateCODE - array ref of the paper numbers this CODE was + seen on before + - incorrectCODE - current incorrect CODE + - doublebubble - array ref of the bubble lines that have double + bubble errors + - missingbubble - array ref of the bubble lines that have missing + bubble errors + +=cut + sub scantron_get_correction { my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; @@ -4527,7 +6064,7 @@ sub scantron_get_correction { #the previous one or the current one $r->print("

An error was detected ($error)"); - if ( defined($$scan_record{'scantron.PaperID'}) ) { + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { $r->print(" for PaperID ". $$scan_record{'scantron.PaperID'}." \n"); } else { @@ -4557,7 +6094,7 @@ 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$/) { @@ -4572,19 +6109,24 @@ sub scantron_get_correction { $r->print("

How should I handle this?
\n"); $r->print("\n
"); my $i=0; - if ($error eq 'incorrectCODE') { + if ($error eq 'incorrectCODE' + && $$scan_record{'scantron.CODE'}=~/\S/ ) { my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); - foreach my $testcode (@{$closest}) { - my $checked=''; - if (!$i) { $checked=' checked="on" '; } - $r->print(" Use the similar CODE ".$testcode." instead."); - $r->print("\n
"); - $i++; + if ($closest > 0) { + foreach my $testcode (@{$closest}) { + my $checked=''; + if (!$i) { $checked=' checked="checked" '; } + $r->print(""); + $r->print("\n
"); + $i++; + } } } - my $checked; if (!$i) { $checked=' checked="on" '; } - $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error."); - $r->print("\n
"); + if ($$scan_record{'scantron.CODE'}=~/\S/ ) { + my $checked; if (!$i) { $checked=' checked="checked" '; } + $r->print(""); + $r->print("\n
"); + } $r->print(< @@ -4598,14 +6140,16 @@ function change_radio(field) { 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."); + "form=".&escape("scantronupload"). + "&scantron_format=".&escape($env{'form.scantron_format'}). + "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). + "&curCODE=".&escape($$scan_record{'scantron.CODE'}). + "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); + if ($env{'form.scantron_CODElist'} =~ /\S/) { + $r->print(" Selected CODE is "); + $r->print("\n
"); + } + $r->print(" as the CODE."); $r->print("\n

"); } elsif ($error eq 'doublebubble') { $r->print("

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

\n"); @@ -4615,7 +6159,8 @@ ENDSCRIPT $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)); + &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"); @@ -4635,27 +6180,99 @@ ENDSCRIPT } +=pod + +=item scantron_bubble_selector + + Generates the html radiobuttons to correct a single bubble line + possibly showing the existing the selected bubbles if known + + Arguments: + $r - Apache request object + $scan_config - hash from &get_scantron_config() + $quest - number of the bubble line to make a corrector for + $selected - array of letters of previously selected bubbles + $lines - if present, number of bubble lines to show + +=cut + sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected)=@_; + my ($r,$scan_config,$quest,@selected, $lines)=@_; my $max=$$scan_config{'Qlength'}; + + my $scmode=$$scan_config{'Qon'}; + if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } + + + if (!defined($lines)) { + $lines = 1; + } + my $total_lines = $lines*2; my @alphabet=('A'..'Z'); - $r->print(""); - 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
'); + $r->print(""); + + for (my $l = 0; $l < $lines; $l++) { + if ($l != 0) { + $r->print(''); + } + + # FIXME: This loop probably has to be considerably more clever for + # multiline bubbles: User can multibubble by having bubbles in + # several lines. User can skip lines legitimately etc. etc. + + for (my $i=0;$i<$max;$i++) { + $r->print("\n".''); + + } + + if ($l == 0) { + my $lspan = $total_lines * 2; # 2 table rows per bubble line. + + $r->print(''); + + } + + $r->print(''); + + # FIXME: This may have to be a bit more clever for + # multiline questions (different values e.g..). + + for (my $i=0;$i<$max;$i++) { + $r->print("\n". + '"); + } + $r->print(''); + + + } + $r->print('
$quest
'); + if ($selected[0] eq $alphabet[$i]) { + $r->print('X'); + shift(@selected) ; + } else { + $r->print(' '); + } + $r->print('
'); } +=pod + +=item num_matches + + Counts the number of characters that are the same between the two arguments. + + Arguments: + $orig - CODE from the scanline + $code - CODE to match against + + Returns: + $count - integer count of the number of same characters between the + two arguments + +=cut + sub num_matches { my ($orig,$code) = @_; my @code=split(//,$code); @@ -4667,6 +6284,26 @@ sub num_matches { return $same; } +=pod + +=item scantron_get_closely_matching_CODEs + + Cycles through all CODEs and finds the set that has the greatest + number of same characters as the provided CODE + + Arguments: + $allcodes - hash ref returned by &get_codes() + $CODE - CODE from the current scanline + + Returns: + 2 element list + - first elements is number of how closely matching the best fit is + (5 means best set has 5 matching characters) + - second element is an arrary ref containing the set of valid CODEs + that best fit the passed in CODE + +=cut + sub scantron_get_closely_matching_CODEs { my ($allcodes,$CODE)=@_; my @CODEs; @@ -4677,22 +6314,62 @@ sub scantron_get_closely_matching_CODEs return ($#CODEs,$CODEs[-1]); } +=pod + +=item get_codes + + Builds a hash which has keys of all of the valid CODEs from the selected + set of remembered CODEs. + + Arguments: + $old_name - name of the set of remembered CODEs + $cdom - domain of the course + $cnum - internal course name + + Returns: + %allcodes - keys are the valid CODEs, values are all 1 + +=cut + sub get_codes { - 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 {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); + my ($old_name, $cdom, $cnum) = @_; + if (!$old_name) { + $old_name=$env{'form.scantron_CODElist'}; + } + if (!$cdom) { + $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'}; + } + if (!$cnum) { + $cnum =$env{'course.'.$env{'request.course.id'}.'.num'}; + } + my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"], + $cdom,$cnum); + my %allcodes; + if ($result{"type\0$old_name"} eq 'number') { + %allcodes=map {($_,1)} split(',',$result{$old_name}); + } else { + %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name}); + } return %allcodes; } +=pod + +=item scantron_validate_CODE + + Validates all scanlines in the selected file to not have any + invalid or underspecified CODEs and that none of the codes are + duplicated if this was requested. + +=cut + sub scantron_validate_CODE { my ($r,$currentphase) = @_; - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); if ($scantron_config{'CODElocation'} && $scantron_config{'CODEstart'} && $scantron_config{'CODElength'}) { - if (!defined($ENV{'form.scantron_CODElist'})) { + if (!defined($env{'form.scantron_CODElist'})) { &FIXME_blow_up() } } else { @@ -4725,7 +6402,7 @@ sub scantron_validate_CODE { return(1,$currentphase); } if (exists($usedCODEs{$CODE}) - && $ENV{'form.scantron_CODEunique'} eq 'yes' + && $env{'form.scantron_CODEunique'} eq 'yes' && !$$scan_record{'scantron.CODE_ignore_dup'}) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, @@ -4737,6 +6414,15 @@ sub scantron_validate_CODE { return (0,$currentphase+1); } +=pod + +=item scantron_validate_doublebubble + + Validates all scanlines in the selected file to not have any + bubble lines with multiple bubbles marked. + +=cut + sub scantron_validate_doublebubble { my ($r,$currentphase) = @_; #get student info @@ -4744,7 +6430,7 @@ sub scantron_validate_doublebubble { my %idmap=&username_to_idmap($classlist); #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + 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,$scan_data,$i); @@ -4760,31 +6446,54 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } -sub scantron_get_maxbubble { - my ($r)=@_; - if (defined($ENV{'form.scantron_maxbubble'}) && - $ENV{'form.scantron_maxbubble'}) { - return $ENV{'form.scantron_maxbubble'}; +=pod + +=item scantron_get_maxbubble + + Returns the maximum number of bubble lines that are expected to + occur. Does this by walking the selected sequence rendering the + resource and then checking &Apache::lonxml::get_problem_counter() + for what the current value of the problem counter is. + + Caches the result to $env{'form.scantron_maxbubble'} + +=cut + +sub scantron_get_maxbubble { + if (defined($env{'form.scantron_maxbubble'}) && + $env{'form.scantron_maxbubble'}) { + return $env{'form.scantron_maxbubble'}; } + my $navmap=Apache::lonnavmaps::navmap->new(); my (undef,undef,$sequence)= - &Apache::lonnet::decode_symb($ENV{'form.selectpage'}); + &Apache::lonnet::decode_symb($env{'form.selectpage'}); + my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - &Apache::lonnet::delenv('form.counter'); + + &Apache::lonxml::clear_problem_counter(); + foreach my $resource (@resources) { - my $result=&Apache::lonnet::ssi($resource->src().'?symb='.&Apache::lonnet::escape($resource->symb())); + my $result=&Apache::lonnet::ssi($resource->src(), + ('symb' => $resource->symb())); } &Apache::lonnet::delenv('scantron\.'); - my $envfile=$ENV{'user.environment'}; - $envfile=~/\/([^\/]+)\.id$/; - $envfile=$1; - &Apache::lonnet::transfer_profile_to_env($r->dir_config('lonIDsDir'), - $envfile); - $ENV{'form.scantron_maxbubble'}=$ENV{'form.counter'}-1; - return $ENV{'form.scantron_maxbubble'}; + $env{'form.scantron_maxbubble'} = + &Apache::lonxml::get_problem_counter()-1; + + return $env{'form.scantron_maxbubble'}; } +=pod + +=item scantron_validate_missingbubbles + + Validates all scanlines in the selected file to not have any + bubble lines with missing bubbles that haven't been verified as missing. + +=cut + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -4792,7 +6501,7 @@ sub scantron_validate_missingbubbles { my %idmap=&username_to_idmap($classlist); #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $max_bubble=&scantron_get_maxbubble(); if (!$max_bubble) { $max_bubble=2**31; } @@ -4817,14 +6526,38 @@ sub scantron_validate_missingbubbles { return (0,$currentphase+1); } +=pod + +=item scantron_process_students + + Routine that does the actual grading of the bubble sheet information. + + The parsed scanline hash is added to %env + + Then foreach unskipped scanline it does an &Apache::lonnet::ssi() + foreach resource , with the form data of + + 'submitted' =>'scantron' + 'grade_target' =>'grade', + 'grade_username'=> username of student + 'grade_domain' => domain of student + 'grade_courseid'=> of course + 'grade_symb' => symb of resource to grade + + This triggers a grading pass. The problem grading code takes care + of converting the bubbled letter information (now in %env) into a + valid submission. + +=cut + sub scantron_process_students { my ($r) = @_; - my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'}); - my ($symb,$url)=&get_symb_and_url($r); + my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); @@ -4875,8 +6608,13 @@ SCANTRONFORM next; } ($uname,$udom)=split(/:/,$uname); - &Apache::lonnet::delenv('form.counter'); + + &Apache::lonxml::clear_problem_counter(); &Apache::lonnet::appenv(%$scan_record); + + if (&scantron_clear_skip($scanlines,$scan_data,$i)) { + &scantron_putfile($scanlines,$scan_data); + } my $i=0; foreach my $resource (@resources) { @@ -4885,10 +6623,11 @@ SCANTRONFORM 'grade_target' =>'grade', 'grade_username'=>$uname, 'grade_domain' =>$udom, - 'grade_courseid'=>$ENV{'request.course.id'}, + 'grade_courseid'=>$env{'request.course.id'}, 'grade_symb' =>$resource->symb()); - if (exists($scan_record->{'scantron.CODE'}) && - $scan_record->{'scantron.CODE'}) { + if (exists($scan_record->{'scantron.CODE'}) + && + &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) { $form{'CODE'}=$scan_record->{'scantron.CODE'}; } else { $form{'CODE'}=''; @@ -4896,14 +6635,14 @@ SCANTRONFORM my $result=&Apache::lonnet::ssi($resource->src(),%form); if ($result ne '') { &Apache::lonnet::logthis("scantron grading error -> $result"); - &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $ENV{'request.course.id'} url ".$resource->src()); + &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $env{'request.course.id'} url ".$resource->src()); } if (&Apache::loncommon::connection_aborted($r)) { last; } } $completedstudents{$uname}={'line'=>$line}; if (&Apache::loncommon::connection_aborted($r)) { last; } } continue { - &Apache::lonnet::delenv('form.counter'); + &Apache::lonxml::clear_problem_counter(); &Apache::lonnet::delenv('scantron\.'); } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); @@ -4911,19 +6650,27 @@ SCANTRONFORM # $r->print("

took $lasttime

"); $r->print(""); - $r->print(&show_grading_menu_form($symb,$url)); + $r->print(&show_grading_menu_form($symb)); return ''; } +=pod + +=item scantron_upload_scantron_data + + Creates the screen for adding a new bubble sheet data file to a course. + +=cut + sub scantron_upload_scantron_data { my ($r)=@_; - $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'})); + $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'})); my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', 'domainid', 'coursename'); - my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, + my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, 'domainid'); - my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + my $default_form_data=&defaultFormData(&get_symb($r,1)); $r->print(< function checkUpload(formname) { @@ -4951,30 +6698,37 @@ UPLOAD return ''; } +=pod + +=item scantron_upload_scantron_data_save + + Adds a provided bubble information data file to the course if user + has the correct privileges to do so. + +=cut + sub scantron_upload_scantron_data_save { my($r)=@_; - my ($symb,$url)=&get_symb_and_url($r,1); + my ($symb)=&get_symb($r,1); my $doanotherupload= '
'."\n". ''."\n". ''."\n". '
'."\n"; - if (!&Apache::lonnet::allowed('usc',$ENV{'form.domainid'}) && + if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && !&Apache::lonnet::allowed('usc', - $ENV{'form.domainid'}.'_'.$ENV{'form.courseid'})) { + $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)); + $r->print(&show_grading_menu_form($symb)); } else { $r->print($doanotherupload); } return ''; } - my %coursedata=&Apache::lonnet::coursedescription($ENV{'form.domainid'}.'_'.$ENV{'form.courseid'}); + my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); $r->print("Doing upload to ".$coursedata{'description'}."
"); - my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'}, - $ENV{'form.domainid'}); - my $fname=$ENV{'form.upfile.filename'}; + my $fname=$env{'form.upfile.filename'}; #FIXME #copied from lonnet::userfileupload() #make that function able to target a specified course @@ -4990,14 +6744,14 @@ sub scantron_upload_scantron_data_save { unless ($fname) { return 'error: no uploaded file'; } my $uploadedfile=$fname; $fname='scantron_orig_'.$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."); + 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); + my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname); if ($result =~ m|^/uploaded/|) { - $r->print("Success: Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location ".$result.""); + $r->print("Success: Successfully uploaded ".(length($env{'form.upfile'})-1)." bytes of data into location ".$result.""); } else { - $r->print("Error: An error (".$result.") occurred when attempting to upload the file, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"').""); + $r->print("Error: An error (".$result.") occurred when attempting to upload the file, ".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').""); } } if ($symb) { @@ -5008,28 +6762,45 @@ sub scantron_upload_scantron_data_save { return ''; } +=pod + +=item valid_file + + Validates that the requested bubble data file exists in the course. + +=cut + sub valid_file { my ($requested_file)=@_; foreach my $filename (sort(&scantron_filenames())) { - &Apache::lonnet::logthis("$requested_file $filename"); if ($requested_file eq $filename) { return 1; } } return 0; } +=pod + +=item scantron_download_scantron_data + + Shows a list of the three internal files (original, corrected, + skipped) for a specific bubble sheet data file that exists in the + course. + +=cut + sub scantron_download_scantron_data { my ($r)=@_; - my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); - my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; - my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $file=$ENV{'form.scantron_selectfile'}; + my $default_form_data=&defaultFormData(&get_symb($r,1)); + my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; + my $file=$env{'form.scantron_selectfile'}; if (! &valid_file($file)) { $r->print(< The requested file name was invalid.

ERROR - $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + $r->print(&show_grading_menu_form(&get_symb($r,1))); return; } my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; @@ -5049,10 +6820,16 @@ ERROR Skipped, a file of records that were skipped.

DOWNLOAD - $r->print(&show_grading_menu_form(&get_symb_and_url($r,1))); + $r->print(&show_grading_menu_form(&get_symb($r,1))); return ''; } +=pod + +=back + +=cut + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -5061,11 +6838,10 @@ DOWNLOAD # #--- Show a Grading Menu button - Calls the next routine --- sub show_grading_menu_form { - my ($symb,$url)=@_; + my ($symb)=@_; my $result.='
'."\n". - ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". '
'."\n"; @@ -5075,8 +6851,8 @@ sub show_grading_menu_form { # -- Retrieve choices for grading form sub savedState { my %savedState = (); - if ($ENV{'form.saveState'}) { - foreach (split(/:/,$ENV{'form.saveState'})) { + if ($env{'form.saveState'}) { + foreach (split(/:/,$env{'form.saveState'})) { my ($key,$value) = split(/=/,$_,2); $savedState{$key} = $value; } @@ -5087,7 +6863,7 @@ sub savedState { #--- Displays the main menu page ------- sub gradingmenu { my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $probTitle = &Apache::lonnet::gettitle($symb); @@ -5128,8 +6904,8 @@ sub gradingmenu { GRADINGMENUJS &commonJSfunctions($request); - my $result='

 Manual Grading/View Submission

'; - my ($table,undef,$hdgrade) = &showResourceInfo($url,$probTitle); + my $result='

 Manual Grading/View Submission

'; + my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); $result.=$table; my (undef,$sections) = &getclasslist('all','0'); my $savedState = &savedState(); @@ -5139,8 +6915,7 @@ GRADINGMENUJS my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); $result.='
'."\n". - ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -5148,48 +6923,50 @@ GRADINGMENUJS ''."\n". ''."\n"; - $result.='
'."\n". - '
'."\n". + $result.='
'."\n". + ''."\n". '
'."\n". ' Select a Grading/Viewing Option
'."\n"; - $result.=''; + $result.='
'; $result.=''; - $result.=''."\n"; + ($saveSub eq 'all' ? 'selected="selected"' : '').'>'.&mt('with any status').''."\n"; $result.=''."\n"; + ''."\n"; $result.=''."\n"; + ''."\n"; $result.='
'."\n". ' '.&mt('Select Section').':   '; + $result.= '   '; - $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); + $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); $result.='
'. + $result.='
'. - ' '. - 'Current Resource: For all students in selected section or course
'. - ' '. - 'The complete set/page/sequence: For one student

'. ''. @@ -5197,38 +6974,529 @@ GRADINGMENUJS $result.='		'; - $result.=''; + $result.='
'; $result.=''."\n"; + $result.=''."\n"; + $result.=''."\n"; - if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) { + if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) { $result.=''."\n"; } $result.=''."\n"; + $result.=''."\n"; - $result.='
'. ''. ' '.&mt('scores from file').'
'. + ''. + ' '.&mt('clicker file').'
'. ' scantron forms
'. ''. ' '.&mt('receipt').': '. - &Apache::lonnet::recprefix($ENV{'request.course.id'}). - '-'. + &Apache::lonnet::recprefix($env{'request.course.id'}). + '-'. '
'. ' access times.
'. + ' saved CODEs.
'."\n". + $result.='
'."\n". '
'."\n". - '
'."\n"; + '
'."\n"; return $result; } +sub reset_perm { + undef(%perm); +} + +sub init_perm { + &reset_perm(); + foreach my $test_perm ('vgr','mgr','opa') { + + my $scope = $env{'request.course.id'}; + if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) { + + $scope .= '/'.$env{'request.course.sec'}; + if ( $perm{$test_perm}= + &Apache::lonnet::allowed($test_perm,$scope)) { + $perm{$test_perm.'_section'}=$env{'request.course.sec'}; + } else { + delete($perm{$test_perm}); + } + } + } +} + +sub gather_clicker_ids { + my %clicker_ids; + + my $classlist = &Apache::loncoursedata::get_classlist(); + + # Set up a couple variables. + my $username_idx = &Apache::loncoursedata::CL_SNAME(); + my $domain_idx = &Apache::loncoursedata::CL_SDOM(); + + foreach my $student (keys(%$classlist)) { + + my $username = $classlist->{$student}->[$username_idx]; + my $domain = $classlist->{$student}->[$domain_idx]; + my $clickers = + (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; + foreach my $id (split(/\,/,$clickers)) { + $id=~s/^[\#0]+//; + $id=~s/[\-\:]//g; + if (exists($clicker_ids{$id})) { + $clicker_ids{$id}.=','.$username.':'.$domain; + } else { + $clicker_ids{$id}=$username.':'.$domain; + } + } + } + return %clicker_ids; +} + +sub gather_adv_clicker_ids { + my %clicker_ids; + my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; + my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); + foreach my $element (sort(keys(%coursepersonnel))) { + foreach my $person (split(/\,/,$coursepersonnel{$element})) { + my ($puname,$pudom)=split(/\:/,$person); + my $clickers = + (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; + foreach my $id (split(/\,/,$clickers)) { + $id=~s/^[\#0]+//; + $id=~s/[\-\:]//g; + if (exists($clicker_ids{$id})) { + $clicker_ids{$id}.=','.$puname.':'.$pudom; + } else { + $clicker_ids{$id}=$puname.':'.$pudom; + } + } + } + } + return %clicker_ids; +} + +sub clicker_grading_parameters { + return ('gradingmechanism' => 'scalar', + 'upfiletype' => 'scalar', + 'specificid' => 'scalar', + 'pcorrect' => 'scalar', + 'pincorrect' => 'scalar'); +} + +sub process_clicker { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my $result=&checkforfile_js(); + $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); + my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); + $result.=$table; + $result.='
'."\n"; + $result.=''."\n"; + $result.='
'."\n"; + $result.=' '.&mt('Specify a file containing the clicker information for this resource'). + '.
'."\n"; +# Attempt to restore parameters from last session, set defaults if not present + my %Saveable_Parameters=&clicker_grading_parameters(); + &Apache::loncommon::restore_course_settings('grades_clicker', + \%Saveable_Parameters); + if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; } + if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; } + if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; } + if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; } + + my %checked; + foreach my $gradingmechanism ('attendance','personnel','specific') { + if ($env{'form.gradingmechanism'} eq $gradingmechanism) { + $checked{$gradingmechanism}="checked='checked'"; + } + } + + my $upload=&mt("Upload File"); + my $type=&mt("Type"); + my $attendance=&mt("Award points just for participation"); + my $personnel=&mt("Correctness determined from response by course personnel"); + my $specific=&mt("Correctness determined from response with clicker ID(s)"); + my $pcorrect=&mt("Percentage points for correct solution"); + my $pincorrect=&mt("Percentage points for incorrect solution"); + my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', + ('iclicker' => 'i>clicker', + 'interwrite' => 'interwrite PRS')); + $symb = &Apache::lonenc::check_encrypt($symb); + $result.=< +function sanitycheck() { +// Accept only integer percentages + document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value); + document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value); +// Find out grading choice + for (i=0; i +
+ + + + + +
+
+
+
+ + +
+
+
+
+ENDUPFORM + $result.='
'."\n". + '


'."\n"; + $result.=&show_grading_menu_form($symb); + return $result; +} + +sub process_clicker_file { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + + my %Saveable_Parameters=&clicker_grading_parameters(); + &Apache::loncommon::store_course_settings('grades_clicker', + \%Saveable_Parameters); + + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { + $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; + return $result.&show_grading_menu_form($symb); + } + my %clicker_ids=&gather_clicker_ids(); + my %correct_ids; + if ($env{'form.gradingmechanism'} eq 'personnel') { + %correct_ids=&gather_adv_clicker_ids(); + } + if ($env{'form.gradingmechanism'} eq 'specific') { + foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; + $correct_id=~tr/a-z/A-Z/; + $correct_id=~s/\s//gs; + $correct_id=~s/^[\#0]+//; + $correct_id=~s/[\-\:]//g; + if ($correct_id) { + $correct_ids{$correct_id}='specified'; + } + } + } + if ($env{'form.gradingmechanism'} eq 'attendance') { + $result.=&mt('Score based on attendance only'); + } else { + my $number=0; + $result.='

'.&mt('Correctness determined by the following IDs').''; + foreach my $id (sort(keys(%correct_ids))) { + $result.='
'.$id.' - '; + if ($correct_ids{$id} eq 'specified') { + $result.=&mt('specified'); + } else { + my ($uname,$udom)=split(/\:/,$correct_ids{$id}); + $result.=&Apache::loncommon::plainname($uname,$udom); + } + $number++; + } + $result.="

\n"; + if ($number==0) { + $result.=''.&mt('No IDs found to determine correct answer').''; + return $result.&show_grading_menu_form($symb); + } + } + if (length($env{'form.upfile'}) < 2) { + $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.', + '', + '', + ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''); + return $result.&show_grading_menu_form($symb); + } + +# Were able to get all the info needed, now analyze the file + + $result.=&Apache::loncommon::studentbrowser_javascript(); + $symb = &Apache::lonenc::check_encrypt($symb); + my $heading=&mt('Scanning clicker file'); + $result.=(<
+
+$heading
+
+ + + + + + + +ENDHEADER + my %responses; + my @questiontitles; + my $errormsg=''; + my $number=0; + if ($env{'form.upfiletype'} eq 'iclicker') { + ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); + } + if ($env{'form.upfiletype'} eq 'interwrite') { + ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); + } + $result.='
'.&mt('Found [_1] question(s)',$number).'
'. + ''. + &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses', + $env{'form.pcorrect'},$env{'form.pincorrect'}). + '
'; +# Remember Question Titles +# FIXME: Possibly need delimiter other than ":" + for (my $i=0;$i<$number;$i++) { + $result.='').'" />'; + } + my $correct_count=0; + my $student_count=0; + my $unknown_count=0; +# Match answers with usernames +# FIXME: Possibly need delimiter other than ":" + foreach my $id (keys(%responses)) { + if ($correct_ids{$id}) { + $result.="\n".''; + $correct_count++; + } elsif ($clicker_ids{$id}) { + $result.="\n".''; + $student_count++; + } else { + $result.="\n
".&mt('Unregistered Clicker')." ".$id."
"; + $result.="\n".''. + "\n".&mt("Username").":  ". + "\n".&mt("Domain").": ". + &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '. + &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id); + $unknown_count++; + } + } + $result.='
'. + &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); + if ($env{'form.gradingmechanism'} ne 'attendance') { + if ($correct_count==0) { + $errormsg.="Found no correct answers answers for grading!"; + } elsif ($correct_count>1) { + $result.='
'.&mt("Found [_1] entries for grading!",$correct_count).''; + } + } + if ($errormsg) { + $result.='
'.&mt($errormsg).''; + } else { + $result.='
'; + } + $result.='
'."\n". + '


'."\n"; + return $result.&show_grading_menu_form($symb); +} + +sub iclicker_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[0] eq 'Question') { + for (my $i=3;$i<$#entries;$i+=6) { + $$questiontitles[$number]=$entries[$i]; + $number++; + } + } + if ($entries[0]=~/^\#/) { + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + for (my $i=0;$i<$number;$i++) { + my $idx=3+$i*6; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + } + return ($errormsg,$number); +} + +sub interwrite_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + my $skipline=1; + my $questionnumber=0; + my %idresponses=(); + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[1] eq 'Time') { $skipline=0; next; } + if ($entries[1] eq 'Response') { $skipline=1; } + next if $skipline; + if ($entries[0]!=$questionnumber) { + $questionnumber=$entries[0]; + $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); + $number++; + } + my $id=$entries[4]; + $id=~s/^[\#0]+//; + $id=~s/^v\d*\://i; + $id=~s/[\-\:]//g; + $idresponses{$id}[$number]=$entries[6]; + } + foreach my $id (keys %idresponses) { + $$responses{$id}=join(',',@{$idresponses{$id}}); + $$responses{$id}=~s/^\s*\,//; + } + return ($errormsg,$number); +} + +sub assign_clicker_grades { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} +# See which part we are saving to + my ($partlist,$handgrade,$responseType) = &response_type($symb); +# FIXME: This should probably look for the first handgradeable part + my $part=$$partlist[0]; +# Start screen output + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + + my $heading=&mt('Assigning grades based on clicker file'); + $result.=(<
+
+$heading
+ENDHEADER +# Get correct result +# FIXME: Possibly need delimiter other than ":" + my @correct=(); + my $gradingmechanism=$env{'form.gradingmechanism'}; + my $number=$env{'form.number'}; + if ($gradingmechanism ne 'attendance') { + foreach my $key (keys(%env)) { + if ($key=~/^form\.correct\:/) { + my @input=split(/\,/,$env{$key}); + for (my $i=0;$i<=$#input;$i++) { + if (($correct[$i]) && ($input[$i]) && + ($correct[$i] ne $input[$i])) { + $result.='
'. + &mt('More than one correct result given for question "[_1]": [_2] versus [_3].', + $env{'form.question:'.$i},$correct[$i],$input[$i]).''; + } elsif ($input[$i]) { + $correct[$i]=$input[$i]; + } + } + } + } + for (my $i=0;$i<$number;$i++) { + if (!$correct[$i]) { + $result.='
'. + &mt('No correct result given for question "[_1]"!', + $env{'form.question:'.$i}).''; + } + } + $result.='
'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct)); + } +# Start grading + my $pcorrect=$env{'form.pcorrect'}; + my $pincorrect=$env{'form.pincorrect'}; + my $storecount=0; + foreach my $key (keys(%env)) { + my $user=''; + if ($key=~/^form\.student\:(.*)$/) { + $user=$1; + } + if ($key=~/^form\.unknown\:(.*)$/) { + my $id=$1; + if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) { + $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id}; + } + } + if ($user) { + my @answer=split(/\,/,$env{$key}); + my $sum=0; + for (my $i=0;$i<$number;$i++) { + if ($answer[$i]) { + if ($gradingmechanism eq 'attendance') { + $sum+=$pcorrect; + } else { + if ($answer[$i] eq $correct[$i]) { + $sum+=$pcorrect; + } else { + $sum+=$pincorrect; + } + } + } + } + my $ave=$sum/(100*$number); +# Store + my ($username,$domain)=split(/\:/,$user); + my %grades=(); + $grades{"resource.$part.solved"}='correct_by_override'; + $grades{"resource.$part.awarded"}=$ave; + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $returncode=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($returncode ne 'ok') { + $result.="
Failed to save student $username:$domain. Message when trying to save was ($returncode)"; + } else { + $storecount++; + } + } + } +# We are done + $result.='
'.&mt('Successfully stored grades for [_1] student(s).',$storecount). + '
'."\n". + '


'."\n"; + return $result.&show_grading_menu_form($symb); +} + sub handler { my $request=$_[0]; - undef(%perm); - if ($ENV{'browser.mathml'}) { + &reset_perm(); + if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($request,'text/xml'); } else { &Apache::loncommon::content_type($request,'text/html'); @@ -5236,25 +7504,19 @@ sub handler { $request->send_http_header; return '' if $request->header_only; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); - my $url=$ENV{'form.url'}; - my $symb=$ENV{'form.symb'}; + my $symb=&get_symb($request,1); my @commands=&Apache::loncommon::get_env_multiple('form.command'); my $command=$commands[0]; if ($#commands > 0) { &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); } - if (!$url) { - my ($temp1,$temp2); - ($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 ($ENV{'user.adv'}) { - if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && - ($ENV{'form.codethree'})) { - my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'. - $ENV{'form.codethree'}; + $request->print(&Apache::loncommon::start_page('Grading')); + if ($symb eq '' && $command eq '') { + if ($env{'user.adv'}) { + if (($env{'form.codeone'}) && ($env{'form.codetwo'}) && + ($env{'form.codethree'})) { + my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'. + $env{'form.codethree'}; my ($tsymb,$tuname,$tudom,$tcrsid)= &Apache::lonnet::checkin($token); if ($tsymb) { @@ -5276,22 +7538,9 @@ sub handler { } } } else { - if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}))) { - if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) { - $perm{'vgr_section'}=$ENV{'request.course.sec'}; - } else { - delete($perm{'vgr'}); - } - } - if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}))) { - if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) { - $perm{'mgr_section'}=$ENV{'request.course.sec'}; - } else { - delete($perm{'mgr'}); - } - } + &init_perm(); if ($command eq 'submission' && $perm{'vgr'}) { - ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); + ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0)); } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { &pickStudentPage($request); } elsif ($command eq 'displayPage' && $perm{'vgr'}) { @@ -5310,6 +7559,12 @@ sub handler { $request->print(&editgrades($request)); } elsif ($command eq 'verify' && $perm{'vgr'}) { $request->print(&verifyreceipt($request)); + } elsif ($command eq 'processclicker' && $perm{'mgr'}) { + $request->print(&process_clicker($request)); + } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { + $request->print(&process_clicker_file($request)); + } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) { + $request->print(&assign_clicker_grades($request)); } elsif ($command eq 'csvform' && $perm{'mgr'}) { $request->print(&upcsvScores_form($request)); } elsif ($command eq 'csvupload' && $perm{'mgr'}) { @@ -5317,13 +7572,13 @@ sub handler { } elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) { $request->print(&csvuploadmap($request)); } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) { - if ($ENV{'form.associate'} ne 'Reverse Association') { + if ($env{'form.associate'} ne 'Reverse Association') { $request->print(&csvuploadoptions($request)); } else { - if ( $ENV{'form.upfile_associate'} ne 'reverse' ) { - $ENV{'form.upfile_associate'} = 'reverse'; + if ( $env{'form.upfile_associate'} ne 'reverse' ) { + $env{'form.upfile_associate'} = 'reverse'; } else { - $ENV{'form.upfile_associate'} = 'forward'; + $env{'form.upfile_associate'} = 'forward'; } $request->print(&csvuploadmap($request)); } @@ -5338,41 +7593,24 @@ 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'})|| - &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) { + (&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.course.id'}))) { + (&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 'scantron_download' && - &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) { + &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { $request->print(&scantron_download_scantron_data($request)); } elsif ($command) { $request->print("Access Denied ($command)"); } } - &send_footer($request); + $request->print(&Apache::loncommon::end_page()); return ''; } -sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); -# $request->print(" -#"); - $request->print(&Apache::loncommon::bodytag('Grading')); - $request->rflush(); -} - -sub send_footer { - my ($request)= @_; - $request->print(''); -} - 1; __END__;