--- loncom/homework/grades.pm 2005/04/07 07:03:23 1.258 +++ loncom/homework/grades.pm 2007/11/03 00:18:37 1.478 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.258 2005/04/07 07:03:23 albertel Exp $ +# $Id: grades.pm,v 1.478 2007/11/03 00:18:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,41 +35,115 @@ use Apache::loncommon; use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; +use Apache::lonpickcode; 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=(); +my %bubble_lines_per_response = (); # no. bubble lines for each response. + # index is "symb.part_id" + +my %first_bubble_line = (); # First bubble line no. for each bubble. + +# Save and restore the bubble lines array to the form env. + + +sub save_bubble_lines { + foreach my $line (keys(%bubble_lines_per_response)) { + $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; + $env{"form.scantron.first_bubble_line.$line"} = + $first_bubble_line{$line}; + } +} + + +sub restore_bubble_lines { + my $line = 0; + %bubble_lines_per_response = (); + while ($env{"form.scantron.bubblelines.$line"}) { + my $value = $env{"form.scantron.bubblelines.$line"}; + $bubble_lines_per_response{$line} = $value; + $first_bubble_line{$line} = + $env{"form.scantron.first_bubble_line.$line"}; + $line++; + } + +} + +# Given the parsed scanline, get the response for +# 'answer' number n: + +sub get_response_bubbles { + my ($parsed_line, $response) = @_; + + + my $bubble_line = $first_bubble_line{$response-1} +1; + my $bubble_lines= $bubble_lines_per_response{$response-1}; + + my $selected = ""; + + for (my $bline = 0; $bline < $bubble_lines; $bline++) { + $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; + $bubble_line++; + } + return $selected; +} + # ----- These first few routines are general use routines.---- + +# Return the number of occurences of a pattern in a string. + +sub occurence_count { + my ($string, $pattern) = @_; + + my @matches = ($string =~ /$pattern/g); + + return scalar(@matches); +} + + +# Take a string known to have digits and convert all the +# digits into letters in the range J,A..I. + +sub digits_to_letters { + my ($input) = @_; + + my @alphabet = ('J', 'A'..'I'); + + my @input = split(//, $input); + my $output =''; + for (my $i = 0; $i < scalar(@input); $i++) { + if ($input[$i] =~ /\d/) { + $output .= $alphabet[$input[$i]]; + } else { + $output .= $input[$i]; + } + } + return $output; +} + # # --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url,$symb) = @_; - my $partorder = &Apache::lonnet::metadata($url, 'partorder'); - my @parts; - if ($partorder) { - for my $part (split (/,/,$partorder)) { - if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { - push(@parts, $part); - } - } - } else { - my $metadata = &Apache::lonnet::metadata($url, 'packages'); - foreach (split(/\,/,$metadata)) { - if ($_ =~ /^part_(.*)$/) { - if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { - push(@parts, $1); - } - } - } - } + my ($symb) = @_; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my $url = $res->src(); + my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys')); + my @stores; - foreach my $part (@parts) { - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $part (@{ $partlist }) { foreach my $key (@metakeys) { if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } @@ -78,7 +152,7 @@ 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))); @@ -88,7 +162,8 @@ sub get_symb_and_url { return (); } } - return ($symb,$url); + &Apache::lonenc::check_decrypt(\$symb); + return ($symb); } #--- Format fullname, username:domain if different for display @@ -96,120 +171,154 @@ 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; } - -sub get_order { - my ($partid,$respid,$symb,$uname,$udom)=@_; - my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); - $url=&Apache::lonnet::clutter($url); - my $subresult=&Apache::lonnet::ssi($url, - ('grade_target' => 'analyze'), - ('grade_domain' => $udom), - ('grade_symb' => $symb), - ('grade_courseid' => - $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"}); +sub reset_caches { + &reset_analyze_cache(); + &reset_perm(); +} + +{ + my %analyze_cache; + + sub reset_analyze_cache { + undef(%analyze_cache); + } + + sub get_analyze { + my ($symb,$uname,$udom)=@_; + my $key = "$symb\0$uname\0$udom"; + return $analyze_cache{$key} if (exists($analyze_cache{$key})); + + my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); + $url=&Apache::lonnet::clutter($url); + my $subresult=&Apache::lonnet::ssi($url, + ('grade_target' => 'analyze'), + ('grade_domain' => $udom), + ('grade_symb' => $symb), + ('grade_courseid' => + $env{'request.course.id'}), + ('grade_username' => $uname)); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + return $analyze_cache{$key} = \%analyze; + } + + sub get_order { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my $analyze = &get_analyze($symb,$uname,$udom); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my $analyze = &get_analyze($symb,$uname,$udom); + foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) { + if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { + return $foil; + } + } + } } + #--- 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 +329,11 @@ sub cleanRecord { } else { $toprow.=''.$answer{$foil}.' '; } - $bottomrow.=''.$grayFont.$foil.' '; + $bottomrow.=''.$grayFont.$foil.' '; } return '
'. - ''.$toprow.''. - ''. + ''.$toprow.''. + ''. $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; } elsif ($response eq 'match') { my %answer=&Apache::lonnet::str2hash($answer); @@ -235,39 +344,39 @@ 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.''. - ''. + ''.$toprow.''. + ''. $middlerow.''. - ''. + ''. $bottomrow.''.'
Answer
'.$grayFont.'Item ID
'.&mt('Answer').'
'.$grayFont.&mt('Item ID').'
'.$grayFont.'Option ID
'.$grayFont.&mt('Option ID').'
'; } elsif ($response eq 'radiobutton') { my %answer=&Apache::lonnet::str2hash($answer); my ($toprow,$bottomrow); - my $correct=($order->[0])+1; - for (my $i=1;$i<=$#$order;$i++) { - my $foil=$order->[$i]; + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { if (exists($answer{$foil})) { - if ($i == $correct) { - $toprow.='true'; + if ($foil eq $correct) { + $toprow.=''.&mt('true').''; } else { - $toprow.='true'; + $toprow.=''.&mt('true').''; } } else { - $toprow.='false'; + $toprow.=''.&mt('false').''; } - $bottomrow.=''.$grayFont.$foil.' '; + $bottomrow.=''.$grayFont.$foil.' '; } return '
'. - ''.$toprow.''. - ''. + ''.$toprow.''. + ''. $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; } elsif ($response eq 'essay') { if (! exists ($env{'form.'.$symb})) { @@ -284,6 +393,45 @@ sub cleanRecord { } $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; + } + } elsif ( $response =~ m/(?:numerical|formula)/) { + $answer = + &Apache::loncommon::format_previous_attempt_value('submission', + $answer); } return $answer; } @@ -327,11 +475,31 @@ COMMONJSFUNCTIONS #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$filterlist) = @_; - $getsec = $getsec eq '' ? 'all' : $getsec; - my $classlist=&Apache::loncoursedata::get_classlist(); + my ($getsec,$filterlist,$getgroup) = @_; + my @getsec; + my @getgroup; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + if (!ref($getsec)) { + if ($getsec ne '' && $getsec ne 'all') { + @getsec=($getsec); + } + } else { + @getsec=@{$getsec}; + } + if (grep(/^all$/,@getsec)) { undef(@getsec); } + if (!ref($getgroup)) { + if ($getgroup ne '' && $getgroup ne 'all') { + @getgroup=($getgroup); + } + } else { + @getgroup=@{$getgroup}; + } + if (grep(/^all$/,@getgroup)) { undef(@getgroup); } + + my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); + &Apache::loncoursedata::get_group_memberships($classlist,$keylist); # my %sections; my %fullnames; @@ -348,18 +516,40 @@ sub getclasslist { $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; my $status = $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; + my $group = + $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; # filter students according to status selected - if ($filterlist && $env{'form.Status'} ne 'Any') { - if ($env{'form.Status'} ne $status) { - delete ($classlist->{$student}); + if ($filterlist && (!($stu_status =~ /Any/))) { + if (!($stu_status =~ $status)) { + delete($classlist->{$student}); next; } } + # filter students according to groups selected + my @stu_groups = split(/,/,$group); + if (@getgroup) { + my $exclude = 1; + foreach my $grp (@getgroup) { + foreach my $stu_group (@stu_groups) { + if ($stu_group eq $grp) { + $exclude = 0; + } + } + if (($grp eq 'none') && !$group) { + $exclude = 0; + } + } + if ($exclude) { + delete($classlist->{$student}); + } + } $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; + if ($classlist->{$student}) { + $fullnames{$student}=$fullname; + } } else { delete($classlist->{$student}); } @@ -414,7 +604,7 @@ sub canview { #--- Retrieve the grade status of a student for all the parts sub student_gradeStatus { - my ($url,$symb,$udom,$uname,$partlist) = @_; + my ($symb,$udom,$uname,$partlist) = @_; my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); my %partstatus = (); foreach (@$partlist) { @@ -431,7 +621,8 @@ 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 $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); my $jscript=''."\n"; $jscript.= '
'."\n". - ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -452,6 +642,35 @@ 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 +678,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 +695,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); @@ -509,30 +731,33 @@ sub verifyreceipt { my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $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 +772,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 +786,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 +796,20 @@ sub verifyreceipt { sub listStudents { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); + 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 $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; 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 +847,44 @@ 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"; + $gradeTable.=''."\n"; } - - my $saveStatus = $env{'form.Status'} eq '' ? 'Active' : $env{'form.Status'}; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status; $env{'form.Status'} = $saveStatus; - - $gradeTable.=' last submission only'."\n". - ' last submission & parts info'."\n". - ' by dates and submissions'."\n". - ' all details'."\n". - ''."\n". + $gradeTable.=''."\n". + ''."\n". + ''."\n". + '
'."\n". + ' Grading Increments: '. + &build_section_inputs(). ''."\n". '
'."\n". '
'."\n". ''."\n". ''."\n". - ''."\n". - ''."\n". + ''."\n". ''."\n"; if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { - $gradeTable.=''."\n"; + $gradeTable.=''."\n"; } else { $gradeTable.='Student Status: '. &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'
'; @@ -671,32 +900,55 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="Next->" />
'."\n"; $gradeTable.=&check_buttons(); - $gradeTable.='Check For Plagiarism'; - my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); - $gradeTable.='
'. - ''; + $gradeTable.=''; + my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); + $gradeTable.= &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(); my $loop = 0; while ($loop < 2) { - $gradeTable.=''. - ''; - if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + $gradeTable.=''. + ''; + 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); - $gradeTable.=''; + my $display_part=&get_display_part((split(/_/))[0],$symb); + $gradeTable.=''; } $loop++; # $gradeTable.='' if ($loop%2 ==1); } - $gradeTable.=''."\n"; + $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\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; @@ -724,56 +976,65 @@ LISTJAVASCRIPT $ctr++; my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; - + my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; if ( $perm{'vgr'} eq 'F' ) { - $gradeTable.='' if ($ctr%2 ==1); + if ($ctr%2 ==1) { + $gradeTable.= &Apache::loncommon::start_data_table_row(); + } $gradeTable.=''. ''."\n".''."\n"; + ' '.$section.($group ne '' ?'/'.$group:'').''."\n"; 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); - $gradeTable.=''."\n" if ($ctr%2 ==0); + if ($ctr%2 ==0) { + $gradeTable.=&Apache::loncommon::end_data_table_row()."\n"; + } } } 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.=''; + $gradeTable.=&Apache::loncommon::end_data_table_row(); } - $gradeTable.='
 No.  Select '.&nameUserString('header').' Section/GroupNo.Select'.&nameUserString('header').' '.'Section/Group Part: '.$display_part. - ' Status Part: '.$display_part. + ' Status'; } + } elsif ($submitonly eq 'queued') { + $gradeTable.=''.&mt('Queue Status').' 
'.$ctr.' '. &nameUserString(undef,$$fullname{$student},$uname,$udom). - ' '.$section.' '.$status{$_}.'  '.$status{$_}.' 
     
'."\n". + $gradeTable.=&Apache::loncommon::end_data_table()."\n". ''."\n"; 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 =~ s/type="checkbox"/type="checkbox" checked="checked"/; } - $gradeTable.=&show_grading_menu_form($symb,$url); + $gradeTable.=&show_grading_menu_form($symb); $request->print($gradeTable); return ''; } @@ -832,8 +1093,8 @@ sub processGroup { my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); my $total = scalar(@stuchecked)-1; - foreach (@stuchecked) { - my ($uname,$udom,$fullname) = split(/:/); + foreach my $student (@stuchecked) { + my ($uname,$udom,$fullname) = split(/:/,$student); $env{'form.student'} = $uname; $env{'form.userdom'} = $udom; $env{'form.fullname'} = $fullname; @@ -1029,6 +1290,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 + 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($url,$env{'form.probTitle'}); + my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); $result.=$table; - $result.='
' 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; @@ -2972,10 +3812,10 @@ sub csvuploadmap { } my @records=&Apache::loncommon::upfile_record_sep(); if ($env{'form.noFirstLine'}) { shift(@records); } - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); + &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') { &Apache::loncommon::csv_print_samples($request,\@records); @@ -2987,32 +3827,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 ($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

-
+


\n"); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print('
+
'."\n"); + $request->print(&show_grading_menu_form($symb)); return ''; } @@ -3058,8 +3905,9 @@ 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); } @@ -3112,12 +3960,21 @@ 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=($pcr == 0) ? 'incorrect_by_override' + : '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 +3984,36 @@ sub csvuploadassign { $grades{$store_key}=$entries{$fields{$dest}}; } } - if (! %grades) { push(@skipped,"$username:$domain no data to store"); } + 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 +4042,17 @@ function checkPickOne(formname) { LISTJAVASCRIPT &commonJSfunctions($request); - my ($symb,$url) = &get_symb_and_url($request); + 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 +4075,30 @@ 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"; - - $result.=''."\n". - ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + $result.=&build_section_inputs(); + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + $result.=''."\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 +4108,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 +4146,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,7 +4161,7 @@ sub getSymbMap { sub displayPage { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); + 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'}; @@ -3303,20 +4178,29 @@ sub displayPage { &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'}.'

'; + 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 $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()); @@ -3326,12 +4210,16 @@ sub displayPage { ''."\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. @@ -3341,6 +4229,7 @@ sub displayPage { ' Prob. '. ' '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade'; + &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 +4237,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.=''.$prob. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; + 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); 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}) { @@ -3410,11 +4300,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,63 +4313,91 @@ 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='
'. - ''. - ''. - ($isCODE?'':''). - ''. - ''; + my $studentTable=&Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''. + ($isCODE?'':''). + ''. + ''. + &Apache::loncommon::end_data_table_header_row(); my ($version); my %mark; my %orders; $mark{'correct_by_student'} = $checkIcon; if (!exists($$record{'1:timestamp'})) { - return '
 Nothing submitted - no attempts
'; + return '
 '.&mt('Nothing submitted - no attempts').'
'; } + + my $interaction; for ($version=1;$version<=$$record{'version'};$version++) { - my $timestamp = scalar(localtime($$record{$version.':timestamp'})); - $studentTable.=''; + my $timestamp = + &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'}); + if (exists($$record{$version.':resource.0.version'})) { + $interaction = $$record{$version.':resource.0.version'}; + } + + my $where = ($isTask ? "$version:resource.$interaction" + : "$version:resource"); + $studentTable.=&Apache::loncommon::start_data_table_row(). + ''; if ($isCODE) { $studentTable.=''; } 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$/); - $displaySub[0].='Part: '.$display_part.' '; - $displaySub[0].='(ID '. - $responseId.') '; - if ($$record{"$version:resource.$partid.tries"} eq '') { - $displaySub[0].='Trial not counted'; + + my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) + : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); + $displaySub[0].=''.&mt('Part:').' '.$display_part.' '; + $displaySub[0].='('.&mt('ID').' '. + $responseId.') '; + if ($$record{"$where.$partid.tries"} eq '') { + $displaySub[0].=&mt('Trial not counted'); } else { - $displaySub[0].='Trial '. - $$record{"$version:resource.$partid.tries"}; + $displaySub[0].=&mt('Trial [_1]', + $$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.')'; } } @@ -3489,12 +4407,12 @@ sub displaySubByDates { } $studentTable.='
'; - + $studentTable.=' '. + &Apache::loncommon::end_data_table_row(); } - $studentTable.='
Date/TimeCODESubmissionStatus 
'.&mt('Date/Time').''.&mt('CODE').''.&mt('Submission').''.&mt('Status').'
'.$timestamp.''.$timestamp.''.$record->{$version.':resource.CODE'}.''.$displaySub[0].' '.$displaySub[1]; if ($displaySub[2]) { - $studentTable.='Manually graded by '.$displaySub[2]; + $studentTable.=&mt('Manually graded by [_1]',$displaySub[2]); } - $studentTable.=' 
'; + $studentTable.=&Apache::loncommon::end_data_table(); return $studentTable; } @@ -3509,11 +4427,11 @@ sub updateGradeByPage { 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'}.'

'; + my $result='

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

'; $result.='

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

'."\n"; @@ -3522,7 +4440,12 @@ sub updateGradeByPage { my $navmap = Apache::lonnavmaps::navmap->new(); my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'}); my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps - + 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,16 +4463,18 @@ 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.=''.$prob. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=' '.$title.' '; 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}; @@ -3576,19 +4501,25 @@ sub updateGradeByPage { $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 $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 ''; @@ -3598,9 +4529,29 @@ sub updateGradeByPage { $changeflag++; } if (scalar(keys(%newrecord)) > 0) { + 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.=''.$displayPts[0].''. ''.$displayPts[1].''. @@ -3612,7 +4563,7 @@ sub updateGradeByPage { } $studentTable.=''; - $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 +4580,94 @@ 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 mis-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 are 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 + + + +=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)=@_; - return ' - '."\n". - ''."\n". + my ($symb)=@_; + return ''."\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 +4850,14 @@ sub scantron_selectphase { Options: - Do only previously skipped records
- Remove all exisiting corrections +
+
+ - + @@ -3785,6 +4871,8 @@ SCANTRONFORM 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,7 +4885,7 @@ SCANTRONFORM SCANTRONFORM - my $default_form_data=&defaultFormData(&get_symb_and_url($r,1)); + 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(< 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 +4939,7 @@ SCANTRONFORM
- +
@@ -3855,14 +4948,70 @@ SCANTRONFORM SCANTRONFORM - $r->print(< -$grading_menu_button -SCANTRONFORM - + $r->print(''); + &Apache::lonpickcode::code_list($r,2); + $r->print(''); + $r->print($grading_menu_button); 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 +5044,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 +5073,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 +5155,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,6 +5173,25 @@ 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'}; @@ -3965,13 +5202,74 @@ 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 bubble ranges that are considered to be answers + to a single question that don't have any bubbles filled in. + Of the form questionnumber:firstbubblenumber:count. + doubleerror - a list of bubble ranges that are considered to be answers + to a single question that have more than one bubble filled in. + Of the form questionnumber::firstbubblenumber:count + + In the above, count is the number of bubble responses in the + input line needed to represent the possible answers to the question. + e.g. a radioresponse with 15 choices in an answer sheet with 10 choices + per line would have count = 2. + + 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,56 +5294,168 @@ 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; - while ($questions) { + my $ansnum =1; # Multiple 'answer lines'/question. + + chomp($questions); # Get rid of any trailing \n. + $questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads). + while (length($questions)) { + my $answers_needed = $bubble_lines_per_response{$questnum}; + my $answer_length = $$scantron_config{'Qlength'} * $answers_needed; + + + $questnum++; - my $currentquest=substr($questions,0,$$scantron_config{'Qlength'}); - substr($questions,0,$$scantron_config{'Qlength'})=''; - if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } + my $currentquest = substr($questions,0,$answer_length); + $questions = substr($questions,0,$answer_length)=''; + if (length($currentquest) < $answer_length) { next; } + + # Qon letter implies for each slot in currentquest we have: + # ? or * for doubles a letter in A-Z for a bubble and + # about anything else (esp. a value of Qoff for missing + # bubbles. + + if ($$scantron_config{'Qon'} eq 'letter') { - if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || - $currentquest !~ /^[A-Z]$/) { - $record{"scantron.$questnum.answer"}=''; + + if ($currentquest =~ /\?/ + || $currentquest =~ /\*/ + || (&occurence_count($currentquest, "[A-Z]") > 1)) { + push(@{$record{'scantron.doubleerror'}},$questnum); + for (my $ans = 0; $ans < $answers_needed; $ans++) { + my $bubble = substr($currentquest, $ans, 1); + if ($bubble =~ /[A-Z]/ ) { + $record{"scantron.$ansnum.answer"} = $bubble; + } else { + $record{"scantron.$ansnum.answer"}=''; + } + $ansnum++; + } + + } elsif (!defined($currentquest) + || (&occurence_count($currentquest, $$scantron_config{'Qoff'}) == length($currentquest)) + || (&occurence_count($currentquest, "[A-Z]") == 0)) { + for (my $ans = 0; $ans < $answers_needed; $ans++ ) { + $record{"scantron.$ansnum.answer"}=''; + $ansnum++; + + } if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); + # $ansnum += $answers_needed; } } else { - $record{"scantron.$questnum.answer"}=$currentquest; + for (my $ans = 0; $ans < $answers_needed; $ans++) { + $record{"scantron.$ansnum.answer"} = substr($currentquest, $ans, 1); + $ansnum++; + } } + + # Qon 'number' implies each slot gives a digit that indexes the + # the bubbles filled or Qoff or a non number for unbubbled lines. + # and *? for double bubbles on a line. + # these answers are also stored as letters. + } elsif ($$scantron_config{'Qon'} eq 'number') { - if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} || - $currentquest !~ /^\d$/) { - $record{"scantron.$questnum.answer"}=''; + if ($currentquest =~ /\?/ + || $currentquest =~ /\*/ + || (&occurence_count($currentquest, '\d') > 1)) { + push(@{$record{'scantron.doubleerror'}},$questnum); + for (my $ans = 0; $ans < $answers_needed; $ans++) { + my $bubble = substr($currentquest, $ans, 1); + if ($bubble =~ /\d/) { + $record{"scantron.$ansnum.answer"} = $alphabet[$bubble]; + } else { + $record{"scantron.$ansnum.answer"}=' '; + } + $ansnum++; + } + + } elsif (!defined($currentquest) + || (&occurence_count($currentquest,$$scantron_config{'Qoff'}) == length($currentquest)) + || (&occurence_count($currentquest, '\d') == 0)) { + for (my $ans = 0; $ans < $answers_needed; $ans++ ) { + $record{"scantron.$ansnum.answer"}=''; + $ansnum++; + + } if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); + $ansnum += $answers_needed; } + } else { - $record{"scantron.$questnum.answer"}= - $alphabet[$currentquest-1]; + $currentquest = &digits_to_letters($currentquest); + for (my $ans =0; $ans < $answers_needed; $ans++) { + $record{"scantron.$ansnum.answer"} = substr($currentquest, $ans, 1); + $ansnum++; + } } } else { + + # Otherwise there's a positional notation; + # each bubble line requires Qlength items, and there are filled in + # bubbles for each case where there 'Qon' characters. + # + my @array=split($$scantron_config{'Qon'},$currentquest,-1); - if (length($array[0]) eq $$scantron_config{'Qlength'}) { - $record{"scantron.$questnum.answer"}=''; + + # If the split only giveas us one element.. the full length of the + # answser string, no bubbles are filled in: + + if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { + for (my $ans = 0; $ans < $answers_needed; $ans++ ) { + $record{"scantron.$ansnum.answer"}=''; + $ansnum++; + + } if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { push(@{$record{"scantron.missingerror"}},$questnum); } - } else { - $record{"scantron.$questnum.answer"}= - $alphabet[length($array[0])]; + } elsif (scalar(@array) lt 2) { + + my $location = length($array[0]); + my $line_num = $location / $$scantron_config{'Qlength'}; + my $bubble = $alphabet[$location % $$scantron_config{'Qlength'}]; + + for (my $ans = 0; $ans < $answers_needed; $ans++) { + if ($ans eq $line_num) { + $record{"scantron.$ansnum.answer"} = $bubble; + } else { + $record{"scantron.$ansnum.answer"} = ' '; + } + $ansnum++; + } } - if (scalar(@array) gt 2) { + # If there's more than one instance of a bubble character + # That's a double bubble; with positional notation we can + # record all the bubbles filled in as well as the + # fact this response consists of multiple bubbles. + # + else { push(@{$record{'scantron.doubleerror'}},$questnum); + + my $first_answer = $ansnum; + for (my $ans =0; $ans < $answers_needed; $ans++) { + my $item = $first_answer+$ans; + $record{"scantron.$item.answer"} = ''; + } + my @ans=@array; - my $i=length($ans[0]);shift(@ans); + my $i=0; + my $increment = 0; while ($#ans) { - $i+=length($ans[0])+1; - $record{"scantron.$questnum.answer"}.=$alphabet[$i]; + $i+=length($ans[0]) + $increment; + my $line = int($i/$$scantron_config{'Qlength'} + $first_answer); + my $bubble = $i%$$scantron_config{'Qlength'}; + $record{"scantron.$line.answer"}.=$alphabet[$bubble]; shift(@ans); + $increment = 1; } + $ansnum += $answers_needed; } } } @@ -4053,6 +5463,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 +5489,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,15 +5521,40 @@ 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'}); @@ -4134,37 +5605,80 @@ sub scantron_process_corrections { } } 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)=@_; + 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 +5687,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 %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
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,37 +5750,54 @@ 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 '' ) { $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

'); + $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.

'); + $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.

'); + $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 + + my $line = 0; + while (defined($env{"form.scantron.bubblelines.$line"})) { + my $chunk = + ''."\n"; + $chunk .= + ''."\n"; + $result .= $chunk; + $line++; + } 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 + # 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') { &remember_current_skipped(); - &scantron_remove_file('skipped'); $env{'form.scantron_options_redo'}='redo_skipped_ready'; } @@ -4280,14 +5863,15 @@ sub scantron_validate_file { 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'); @@ -4296,6 +5880,7 @@ sub scantron_validate_file { } my $currentphase=$env{'form.validatepass'}; + my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { $r->print("

Validating ".$validate_phases[$currentphase]."

"); @@ -4320,16 +5905,33 @@ 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'}; @@ -4344,6 +5946,18 @@ sub scantron_remove_file { 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'}; @@ -4366,6 +5980,51 @@ 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'}; @@ -4398,16 +6057,46 @@ 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); + &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 @@ -4428,14 +6117,53 @@ sub scantron_putfile { &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 +6175,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) = @_; @@ -4467,6 +6304,8 @@ sub scantron_validate_ID { #get scantron line setup my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + &scantron_get_maxbubble(); # parse needs the bubble_lines.. array. my %found=('ids'=>{},'usernames'=>{}); for (my $i=0;$i<=$scanlines->{'count'};$i++) { @@ -4519,15 +6358,45 @@ 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)=@_; -#FIXME in the case of a duplicated ID the previous line, probaly need +#FIXME in the case of a duplicated ID the previous line, probably need #to show both the current line and the previous one and allow skipping #the previous one or the current one $r->print("

An error was detected ($error)"); - if ( defined($$scan_record{'scantron.PaperID'}) ) { + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { $r->print(" for PaperID ". $$scan_record{'scantron.PaperID'}." \n"); } else { @@ -4572,19 +6441,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 +6472,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"); @@ -4614,8 +6490,10 @@ ENDSCRIPT $r->print($message); $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)); + my $selected = &get_response_bubbles($scan_record, $question); + my @select_array = split(/:/,$selected); + &scantron_bubble_selector($r,$scan_config,$question, + @select_array); } } elsif ($error eq 'missingbubble') { $r->print("

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

\n"); @@ -4625,8 +6503,9 @@ ENDSCRIPT $r->print(''); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; - &scantron_bubble_selector($r,$scan_config,$question); + my $selected = &get_response_bubbles($scan_record, $question); + my @select_array = split(/:/,$selected); # ought to be an array of empties. + &scantron_bubble_selector($r,$scan_config,$question, @select_array); } } else { $r->print("\n
    "); @@ -4635,27 +6514,98 @@ 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 + @lines - array of answer lines. + +=cut + sub scantron_bubble_selector { - my ($r,$scan_config,$quest,@selected)=@_; + my ($r,$scan_config,$quest,@lines)=@_; my $max=$$scan_config{'Qlength'}; + + + my $scmode=$$scan_config{'Qon'}; + + my $bubble_length = scalar(@lines); + + + if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } + + my $response = $quest-1; + my $lines = $bubble_lines_per_response{$response}; + + 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(''); + } + my @selected = split(//,$lines[$l]); + 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 +6617,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,15 +6647,55 @@ 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'}); @@ -4703,6 +6713,8 @@ sub scantron_validate_CODE { my %allcodes=&get_codes(); + &scantron_get_maxbubble(); # parse needs the lines per response array. + my ($scanlines,$scan_data)=&scantron_getfile(); for (my $i=0;$i<=$scanlines->{'count'};$i++) { my $line=&scantron_get_line($scanlines,$scan_data,$i); @@ -4737,6 +6749,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 @@ -4746,6 +6767,9 @@ sub scantron_validate_doublebubble { #get scantron line setup my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + &scantron_get_maxbubble(); # parse needs the bubble line array. + for (my $i=0;$i<=$scanlines->{'count'};$i++) { my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } @@ -4760,31 +6784,100 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } -sub scantron_get_maxbubble { - my ($r)=@_; +=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 results to $env{'form.scantron_maxbubble'}, + $env{'form.scantron.bubble_lines.n'} and + $env{'form.scantron.first_bubble_line.n'} + which are the total number of bubble, lines, the number of bubble + lines for reponse n and number of the first bubble line for response n. + +=cut + +sub scantron_get_maxbubble { if (defined($env{'form.scantron_maxbubble'}) && $env{'form.scantron_maxbubble'}) { + &restore_bubble_lines(); return $env{'form.scantron_maxbubble'}; } - my $navmap=Apache::lonnavmaps::navmap->new(); - my (undef,undef,$sequence)= + + my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); + + my $navmap=Apache::lonnavmaps::navmap->new(); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - &Apache::lonnet::delenv('form.counter'); + + &Apache::lonxml::clear_problem_counter(); + + my $uname = $env{'form.student'}; + my $udom = $env{'form.userdom'}; + my $cid = $env{'request.course.id'}; + my $total_lines = 0; + %bubble_lines_per_response = (); + %first_bubble_line = (); + + + my $response_number = 0; + my $bubble_line = 0; foreach my $resource (@resources) { - my $result=&Apache::lonnet::ssi($resource->src().'?symb='.&Apache::lonnet::escape($resource->symb())); + my $symb = $resource->symb(); + &Apache::lonxml::clear_bubble_lines_for_part(); + my $result=&Apache::lonnet::ssi($resource->src(), + ('symb' => $resource->symb()), + ('grade_target' => 'analyze'), + ('grade_courseid' => $cid), + ('grade_domain' => $udom), + ('grade_username' => $uname)); + my (undef, $an) = + split(/_HASH_REF__/,$result, 2); + + my %analysis = &Apache::lonnet::str2hash($an); + + + + foreach my $part_id (@{$analysis{'parts'}}) { + + + my $lines = $analysis{"$part_id.bubble_lines"};; + + # TODO - make this a persistent hash not an array. + + + $first_bubble_line{$response_number} = $bubble_line; + $bubble_lines_per_response{$response_number} = $lines; + $response_number++; + + $bubble_line += $lines; + $total_lines += $lines; + } + } &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; + + &save_bubble_lines(); + $env{'form.scantron_maxbubble'} = + $total_lines; return $env{'form.scantron_maxbubble'}; } +=pod + +=item scantron_validate_missingbubbles + + Validates all scanlines in the selected file to not have any + answers that don't have bubbles that have not been verified + to be bubble free. + +=cut + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -4803,6 +6896,9 @@ sub scantron_validate_missingbubbles { $scan_data); if (!defined($$scan_record{'scantron.missingerror'})) { next; } my @to_correct; + + # Probably here's where the error is... + foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { if ($missing > $max_bubble) { next; } push(@to_correct,$missing); @@ -4817,12 +6913,36 @@ 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 ($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 ($scanlines,$scan_data)=&scantron_getfile(); @@ -4851,6 +6971,9 @@ SCANTRONFORM my $start=&Time::HiRes::time(); my $i=-1; my ($uname,$udom,$started); + + &scantron_get_maxbubble(); # Need the bubble lines array to parse. + while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); $i++; @@ -4875,8 +6998,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) { @@ -4887,23 +7015,22 @@ SCANTRONFORM 'grade_domain' =>$udom, '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'}=''; } 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()); } 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,10 +7038,18 @@ 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'})); @@ -4923,7 +7058,7 @@ sub scantron_upload_scantron_data { 'coursename'); 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,9 +7086,18 @@ 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". @@ -4964,7 +7108,7 @@ sub scantron_upload_scantron_data_save { $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); } @@ -4972,8 +7116,6 @@ sub scantron_upload_scantron_data_save { } 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'}; #FIXME #copied from lonnet::userfileupload() @@ -4991,13 +7133,13 @@ sub scantron_upload_scantron_data_save { 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."); + $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,18 +7150,35 @@ 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 $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'}; @@ -5029,7 +7188,7 @@ sub scantron_download_scantron_data { 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 +7208,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,13 +7226,12 @@ 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"; return $result; } @@ -5084,10 +7248,129 @@ sub savedState { return \%savedState; } -#--- Displays the main menu page ------- -sub gradingmenu { +sub grading_menu { my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + my $probTitle = &Apache::lonnet::gettitle($symb); + my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); + + $request->print($table); + my %fields = ('symb'=>&Apache::lonenc::check_encrypt($symb), + 'handgrade'=>$hdgrade, + 'probTitle'=>$probTitle, + 'command'=>'submit_options', + 'saveState'=>"", + 'gradingMenu'=>1, + 'showgrading'=>"yes"); + my $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + my @menu = ({ url => $url, + name => &mt('Manual Grading/View Submissions'), + short_description => + &mt('Start the process of hand grading submissions.'), + }); + $fields{'command'} = 'csvform'; + $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + push (@menu, { url => $url, + name => &mt('Upload Scores'), + short_description => + &mt('Specify a file containing the class scores for current resource.')}); + $fields{'command'} = 'processclicker'; + $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + push (@menu, { url => $url, + name => &mt('Process Clicker'), + short_description => + &mt('Specify a file containing the clicker information for this resource.')}); + $fields{'command'} = 'scantron_selectphase'; + $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + push (@menu, { url => $url, + name => &mt('Grade/Manage Scantron Forms'), + short_description => + &mt('')}); + $fields{'command'} = 'verify'; + $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); + push (@menu, { url => "", + name => &mt('Verify Receipt'), + short_description => + &mt('')}); + # + # Create the menu + my $Str; + # $Str .= '

    '.&mt('Please select a grading task').'

    '; + $Str .= '
    '; + $Str .= ''. + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"; + + foreach my $menudata (@menu) { + if ($menudata->{'name'} ne &mt('Verify Receipt')) { + $Str .='

    {'jscript'}. + ' href="'. + $menudata->{'url'}.'" >'. + $menudata->{'name'}."

    \n"; + } else { + $Str .='

    {'jscript'}. + ' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '. + ' />

    '; + $Str .= (' 'x8). + ' receipt: '.&Apache::lonnet::recprefix($env{'request.course.id'}). + '-'; + } + $Str .= ' '.(' 'x8).$menudata->{'short_description'}. + "\n"; + } + $Str .="
    \n"; + $request->print(< + function checkChoice(formname,val,cmdx) { + if (val <= 2) { + var cmd = radioSelection(formname.radioChoice); + var cmdsave = cmd; + } else { + cmd = cmdx; + cmdsave = 'submission'; + } + formname.command.value = cmd; + if (val < 5) formname.submit(); + if (val == 5) { + if (!checkReceiptNo(formname,'notOK')) { + return false; + } else { + formname.submit(); + } + } + } + + function checkReceiptNo(formname,nospace) { + var receiptNo = formname.receipt.value; + var checkOpt = false; + if (nospace == "OK" && isNaN(receiptNo)) {checkOpt = true;} + if (nospace == "notOK" && (isNaN(receiptNo) || receiptNo == "")) {checkOpt = true;} + if (checkOpt) { + alert("Please enter a receipt number given by a student in the receipt box."); + formname.receipt.value = ""; + formname.receipt.focus(); + return false; + } + return true; + } + +GRADINGMENUJS + &commonJSfunctions($request); + return $Str; +} + + +#--- Displays the submissions first page ------- +sub submit_options { + my ($request) = @_; + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $probTitle = &Apache::lonnet::gettitle($symb); @@ -5128,9 +7411,8 @@ sub gradingmenu { GRADINGMENUJS &commonJSfunctions($request); - my $result='

     Manual Grading/View Submission

    '; - my ($table,undef,$hdgrade) = &showResourceInfo($url,$probTitle); - $result.=$table; + my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); + my $result; my (undef,$sections) = &getclasslist('all','0'); my $savedState = &savedState(); my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'}); @@ -5139,8 +7421,7 @@ GRADINGMENUJS my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); $result.='
    '."\n". - ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -5148,86 +7429,615 @@ GRADINGMENUJS ''."\n". ''."\n"; - $result.='
    '."\n". - ''."\n". - '
    '."\n". - ' Select a Grading/Viewing Option
    '."\n"; - - $result.=''; - $result.=''; - - $result.=''."\n"; - - $result.=''."\n"; - - $result.=''."\n"; - - $result.='
    '."\n". - ' '.&mt('Select Section').': '."\n"; if (ref($sections)) { - foreach (sort (@$sections)) { - $result.=''."\n"; - } - } - $result.= '   '; - - $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); - - $result.='
    '. - ' '.''.&mt('Current Resource').': '.&mt('For one or more students'). - '
    '. - ' '. - 'Current Resource: For all students in selected section or course
    '. - ' '. - 'The complete set/page/sequence: For one student

    '. - ''. - '
    '."\n"; - - $result.='
    '; - - $result.=''; - $result.=''."\n"; - - $result.=''."\n"; - - if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) { - $result.=''."\n"; - } - $result.=''."\n"; + foreach my $section (sort (@$sections)) { + $result.=''."\n"; + } + } + $result.= '   '; + $result.=' + + +
    +
    + '.&mt('Groups').' +
    +
    + '.&Apache::lonstatistics::GroupSelect('group','multiple',5).' +
    +
    +
    +
    + '.&mt('Access Status').' +
    +
    + '.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,5,undef,'mult').' +
    +
    +
    +
    + '.&mt('Submission Status').' +
    +
    + +
    +
    +
    +
    + +
    +
    + +
    +
    + +
    +
    + + +
    +

    + '.&mt('Grade Complete Folder for One Student').' +

    +
    +
    +
    + +
    +
    + +
    +
    +
    +
    + + '; + return $result; +} - $result.='
    '. - ''. - ' '.&mt('scores from file').'
    '. - ' scantron forms
    '. - ''. - ' '.&mt('receipt').': '. - &Apache::lonnet::recprefix($env{'request.course.id'}). - '-'. - '
    '. - ' access times.
    '."\n". - '
    '."\n". - '
    '."\n"; +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(); + my $status_idx = &Apache::loncoursedata::CL_STATUS(); + + foreach my $student (keys(%$classlist)) { + if ($classlist->{$student}->[$status_idx] ne 'Active') { next; } + 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 corrion(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}) { + if ($clicker_ids{$id}=~/\,/) { +# More than one user with the same clicker! + $result.="\n
    ".&mt('Clicker registered more than once').": ".$id."
    "; + $result.="\n".''. + "'; + $unknown_count++; + } else { +# Good: found one and only one user with the right clicker + $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 ($number<1) { + $errormsg.="Found no questions."; + } + 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}; + } elsif ($env{'form.multi'.$id}) { + $user=$env{'form.multi'.$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); + &reset_caches(); if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($request,'text/xml'); } else { @@ -5236,20 +8046,17 @@ 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 '') { + + + $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'})) { @@ -5276,20 +8083,7 @@ 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)); } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { @@ -5301,7 +8095,9 @@ sub handler { } elsif ($command eq 'processGroup' && $perm{'vgr'}) { &processGroup($request); } elsif ($command eq 'gradingmenu' && $perm{'vgr'}) { - $request->print(&gradingmenu($request)); + $request->print(&grading_menu($request)); + } elsif ($command eq 'submit_options' && $perm{'vgr'}) { + $request->print(&submit_options($request)); } elsif ($command eq 'viewgrades' && $perm{'vgr'}) { $request->print(&viewgrades($request)); } elsif ($command eq 'handgrade' && $perm{'mgr'}) { @@ -5310,6 +8106,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'}) { @@ -5352,27 +8154,11 @@ sub handler { $request->print("Access Denied ($command)"); } } - &send_footer($request); + $request->print(&Apache::loncommon::end_page()); + &reset_caches(); 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__; 500 Internal Server Error

    Internal Server Error

    The server encountered an internal error or misconfiguration and was unable to complete your request.

    Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

    More information about this error may be available in the server error log.