--- loncom/homework/grades.pm 2006/03/25 23:54:07 1.341 +++ loncom/homework/grades.pm 2007/10/26 20:18:43 1.469 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.341 2006/03/25 23:54:07 banghart Exp $ +# $Id: grades.pm,v 1.469 2007/10/26 20:18:43 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,43 +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 ($symb) = @_; - my (undef,undef,$url) = &Apache::lonnet::decode_symb($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 $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); } } @@ -90,6 +162,7 @@ sub get_symb { return (); } } + &Apache::lonenc::check_decrypt(\$symb); return ($symb); } @@ -98,10 +171,10 @@ sub get_symb { 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.')').')'; } } @@ -109,43 +182,45 @@ sub nameUserString { #--- Indicate if a response type is coded handgraded or not. --- sub response_type { my ($symb) = shift; - my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); - 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_.*/ || /^Task_/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - if ($responsetype eq 'Task') { $respid='0'; } - 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 $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,$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; } @@ -158,60 +233,92 @@ sub showResourceInfo { my ($symb,$probTitle,$checkboxes) = @_; my $col=3; if ($checkboxes) { $col=4; } - my $result =''. - ''."\n"; + 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,$symb); - $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 reset_caches { + &reset_analyze_cache(); + &reset_perm(); +} + +{ + my %analyze_cache; -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_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/Task # response types only. sub cleanRecord { my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, $uname,$udom) = @_; - my $grayFont = ''; + my $grayFont = ''; if ($response =~ /^(option|rank)$/) { my %answer=&Apache::lonnet::str2hash($answer); my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); @@ -222,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); @@ -237,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})) { @@ -321,7 +428,10 @@ sub cleanRecord { $result.=''; return $result; } - + } elsif ( $response =~ m/(?:numerical|formula)/) { + $answer = + &Apache::loncommon::format_previous_attempt_value('submission', + $answer); } return $answer; } @@ -365,8 +475,10 @@ COMMONJSFUNCTIONS #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$filterlist) = @_; + 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); @@ -375,10 +487,19 @@ sub getclasslist { @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=&Apache::loncoursedata::get_classlist(); + 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; @@ -395,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 || grep(/^\Q$section\E$/,@getsec)) { $sections{$section}++; - $fullnames{$student}=$fullname; + if ($classlist->{$student}) { + $fullnames{$student}=$fullname; + } } else { delete($classlist->{$student}); } @@ -479,6 +622,7 @@ sub student_gradeStatus { # Shows a student's view of problem and submission sub jscriptNform { 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". @@ -498,6 +642,8 @@ 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. @@ -532,7 +678,7 @@ sub compute_points { # sub most_similar { - my ($uname,$udom,$uessay)=@_; + my ($uname,$udom,$uessay,$old_essays)=@_; # ignore spaces and punctuation @@ -549,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); @@ -586,17 +731,18 @@ sub verifyreceipt { my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $symb = &Apache::lonnet::symbread(); + 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($symb); } foreach (sort @@ -611,7 +757,7 @@ sub verifyreceipt { if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { $contents.=' '."\n". ''.$$fullname{$_}.' '."\n". + '\');" target="_self">'.$$fullname{$_}.' '."\n". ' '.$uname.' '. ' '.$udom.' '; if ($receiptparts) { @@ -654,14 +800,14 @@ sub listStudents { 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($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); @@ -701,39 +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: '."\n". + ' View Problem Text: '."\n". ''."\n". '
'."\n". ' View Answer: '."\n". ''."\n". - '
'."\n". + '
'."\n". ' Submissions: '."\n"; if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { $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.=''."\n". ''."\n". ''."\n". - ''."\n". - ''."\n". + '
'."\n". + ' Grading Increments: '. + &build_section_inputs(). ''."\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);').'
'; @@ -749,8 +900,8 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="Next->" />
'."\n"; $gradeTable.=&check_buttons(); - $gradeTable.=''; - my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); + $gradeTable.=''; + my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); $gradeTable.=''); + + # 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('
'. ''; my $loop = 0; @@ -825,7 +976,7 @@ 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); $gradeTable.=''. @@ -833,7 +984,7 @@ LISTJAVASCRIPT $student.':'.$$fullname{$student}.':::SECTION'.$section. ') " />  '."\n".''."\n"; + ' '.$section.'/'.$group.''."\n"; if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { @@ -866,15 +1017,15 @@ LISTJAVASCRIPT if ($ctr == 0) { my $num_students=(scalar(keys(%$fullname))); if ($num_students eq 0) { - $gradeTable='
 There are no students currently enrolled.'; + $gradeTable='
 There are no students currently enrolled.'; } else { my $submissions='submissions'; if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } - $gradeTable='
 '. + $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/; @@ -938,8 +1089,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; @@ -1135,6 +1286,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(" 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'}); + "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
"); @@ -5219,8 +6466,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"); @@ -5230,7 +6479,7 @@ ENDSCRIPT $r->print(''); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; + my $selected = &get_response_bubbles($scan_record, $question); &scantron_bubble_selector($r,$scan_config,$question); } } else { @@ -5240,32 +6489,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("
'.$ctr.' '. &nameUserString(undef,$$fullname{$student},$uname,$udom). - ' '.$section.'
"); - for (my $i=0;$i<$max+1;$i++) { - $r->print("\n".''); - } - $r->print(''); - for (my $i=0;$i<$max;$i++) { - $r->print("\n". - '"); - } - $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('
$quest'); - if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } - else { $r->print(' '); } - $r->print('
$quest
'); + if ($selected[0] eq $alphabet[$i]) { + $r->print('X'); + shift(@selected) ; + } else { + $r->print(' '); + } + $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); @@ -5277,6 +6592,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; @@ -5287,6 +6622,23 @@ 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, $cdom, $cnum) = @_; if (!$old_name) { @@ -5309,6 +6661,16 @@ sub get_codes { 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'}); @@ -5326,6 +6688,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); @@ -5360,6 +6724,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 @@ -5369,6 +6742,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; } @@ -5383,32 +6759,100 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } +=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::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 $symb = $resource->symb(); + &Apache::lonxml::clear_bubble_lines_for_part(); my $result=&Apache::lonnet::ssi($resource->src(), - ('symb' => $resource->symb())); + ('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\.'); - $env{'form.scantron_maxbubble'} = - &Apache::lonxml::get_problem_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 @@ -5441,6 +6885,30 @@ 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'}); @@ -5475,6 +6943,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++; @@ -5502,6 +6973,10 @@ SCANTRONFORM &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) { @@ -5512,16 +6987,15 @@ 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; } } @@ -5540,6 +7014,14 @@ SCANTRONFORM 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'})); @@ -5576,6 +7058,15 @@ 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)=&get_symb($r,1); @@ -5614,13 +7105,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'},'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) { @@ -5631,6 +7122,14 @@ 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())) { @@ -5639,6 +7138,16 @@ sub valid_file { 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($r,1)); @@ -5675,6 +7184,12 @@ DOWNLOAD return ''; } +=pod + +=back + +=cut + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- @@ -5685,7 +7200,7 @@ DOWNLOAD sub show_grading_menu_form { my ($symb)=@_; my $result.='
'."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -5705,8 +7220,128 @@ sub savedState { return \%savedState; } -#--- Displays the main menu page ------- -sub gradingmenu { +sub grading_menu { + my ($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"; + $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 '';} @@ -5749,7 +7384,7 @@ sub gradingmenu { GRADINGMENUJS &commonJSfunctions($request); - my $result='

 Manual Grading/View Submission

'; + my $result='

 Manual Grading/View Submission

'; my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); $result.=$table; my (undef,$sections) = &getclasslist('all','0'); @@ -5760,7 +7395,7 @@ GRADINGMENUJS my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); $result.='
'."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -5768,84 +7403,102 @@ GRADINGMENUJS ''."\n". ''."\n"; - $result.='
'."\n". - ''; #'; + $result.= '
'."\n". + $result.='
'."\n". + ''."\n". ''."\n"; - $result.='
'."\n". ' Select a Grading/Viewing Option
'."\n"; $result.=''; + $result.=''."\n"; + $result.=''; + $result.=''; + $result.=''."\n"; + $result.=''."\n"; + $result.=''; $result.=''; - - $result.=''; + $result.=''."\n"; + ($saveSub eq 'all' ? 'selected="selected"' : '').'>'.&mt('with any status').''; + + $result.=''."\n"; - $result.=''."\n"; - $result.=''."\n"; - - $result.='
'.&mt('Sections').''.&mt('Groups').''.&mt('Access Status').''.&mt('Submission Status').'
'."\n". - ' '.&mt('Select Section').': '."\n"; if (ref($sections)) { foreach (sort (@$sections)) { $result.=''."\n"; + ($saveSec eq $_ ? 'selected="selected"':'').'>'.$_.''."\n"; } } - $result.= '   '; - - $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); + $result.= '   '; + $result.= ''."\n"; + $result.= &Apache::lonstatistics::GroupSelect('group','multiple',3); + $result.=''."\n"; + $result.=&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,3,undef,'mult'); - $result.='
'. + $result.='
'. '
'. - '

'. + $result.='

'. ''. - '
'."\n"; + '
'; - $result.=''; - $result.=''."\n"; - - $result.=''."\n"; - - if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) { - $result.=''."\n"; - } - $result.=''."\n"; - $result.=''."\n"; + $result.=''."\n"; - $result.='
'. - ''. - ' '.&mt('scores from file').'
'. - ' scantron forms
'. - ''. - ' '.&mt('receipt').': '. - &Apache::lonnet::recprefix($env{'request.course.id'}). - '-'. - '
'. - ' access times.
'. - ' saved CODEs.
'. + '
'."\n". - '
'."\n". + $result.='

'. + ''. '
'."\n"; + + $result.='		'; + +# $result.=''; +# $result.=''."\n"; +# +# $result.=''."\n"; +# +# $result.=''."\n"; +# +# if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) { +# $result.=''."\n"; +# } +# $result.=''."\n"; +# $result.=''."\n"; +# +# $result.='
'. +# ''. +# ' '.&mt('scores from file').'
'. +# ''. +# ' '.&mt('clicker file').'
'. +# ' scantron forms
'. +# ''. +# ' '.&mt('receipt').': '. +# &Apache::lonnet::recprefix($env{'request.course.id'}). +# '-'. +# '
'. +# ' access times.
'. +# ' saved CODEs.
'."\n".'
'."\n". + '
'."\n"; return $result; } @@ -5871,10 +7524,492 @@ sub init_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]; - - &reset_perm(); + &reset_caches(); if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($request,'text/xml'); } else { @@ -5886,10 +8021,13 @@ sub handler { 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)); } - &send_header($request); + + + $request->print(&Apache::loncommon::start_page('Grading')); if ($symb eq '' && $command eq '') { if ($env{'user.adv'}) { if (($env{'form.codeone'}) && ($env{'form.codetwo'}) && @@ -5929,7 +8067,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'}) { @@ -5938,6 +8078,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'}) { @@ -5980,20 +8126,9 @@ sub handler { $request->print("Access Denied ($command)"); } } - &send_footer($request); - return ''; -} - -sub send_header { - my ($request)= @_; - &Apache::lontexconvert::init_tth(); - $request->print(&Apache::loncommon::start_page('Grading')); - $request->rflush(); -} - -sub send_footer { - my ($request)= @_; $request->print(&Apache::loncommon::end_page()); + &reset_caches(); + return ''; } 1; 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.