--- loncom/homework/grades.pm 2002/07/26 20:28:42 1.42 +++ loncom/homework/grades.pm 2013/08/28 04:25:14 1.704 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.42 2002/07/26 20:28:42 ng Exp $ +# $Id: grades.pm,v 1.704 2013/08/28 04:25:14 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,13 +25,8 @@ # # http://www.lon-capa.org/ # -# 2/9,2/13 Guy Albertelli -# 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng -# 8/20 Gerd Kortemeyer -# Year 2002 -# June, July 2002 H.K. Ng -# + + package Apache::grades; use strict; @@ -39,1002 +34,3338 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; +use Apache::lonnavmaps; use Apache::lonhomework; -use Apache::lonmsg qw(:user_normal_msg); -use Apache::Constants qw(:common); -#use Time::HiRes qw( gettimeofday tv_interval ); - -sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'); +use Apache::lonpickcode; +use Apache::loncoursedata; +use Apache::lonmsg(); +use Apache::Constants qw(:common :http); +use Apache::lonlocal; +use Apache::lonenc; +use Apache::lonstathelpers; +use Apache::lonquickgrades; +use Apache::bridgetask(); +use String::Similarity; +use LONCAPA; + +use POSIX qw(floor); + + + +my %perm=(); +my %old_essays=(); + +# These variables are used to recover from ssi errors + +my $ssi_retries = 5; +my $ssi_error; +my $ssi_error_resource; +my $ssi_error_message; + + +sub ssi_with_retries { + my ($resource, $retries, %form) = @_; + my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form); + if ($response->is_error) { + $ssi_error = 1; + $ssi_error_resource = $resource; + $ssi_error_message = $response->code . " " . $response->message; } - return ''; + + return $content; + +} +# +# Prodcuces an ssi retry failure error message to the user: +# + +sub ssi_print_error { + my ($r) = @_; + my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk'); + $r->print(' +
+'.&mt('Unable to retrieve a resource from a server:').'
+'.&mt('Resource:').' '.$ssi_error_resource.'
+'.&mt('Error:').' '.$ssi_error_message.'
+
'.
+&mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'
'.
+&mt('If the error persists, please contact the [_1] for assistance.',$helpurl).
+'
'.$matches." match%s
",$matches <= 1 ? '' : 'es'); -# needs to print who is matched + return; } - return ''; + my $res = $navmap->getBySymb($symb); + unless (ref($res)) { + $$response_error = 1; + return; + } + 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.= ' (' + .&mt('Part ID: [_1]',$partID).')'; + } else { + $display=$partID; + } + return $display; } -sub student_gradeStatus { - my ($url,$udom,$uname,$partlist) = @_; - my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))); - my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my %partstatus = (); - foreach (@$partlist) { - my ($status,$foo)=split(/_/,$record{"resource.$_.solved"},2); - $status = 'nothing' if ($status eq ''); - $partstatus{$_} = $status; - $partstatus{"resource.$_.submitted_by"} = $record{"resource.$_.submitted_by"} - if ($record{"resource.$_.submitted_by"} ne ''); +sub reset_caches { + &reset_analyze_cache(); + &reset_perm(); + &reset_old_essays(); +} + +{ + my %analyze_cache; + my %analyze_cache_formkeys; + + sub reset_analyze_cache { + undef(%analyze_cache); + undef(%analyze_cache_formkeys); } - return %partstatus; + + sub get_analyze { + my ($symb,$uname,$udom,$no_increment,$add_to_hash,$type,$trial,$rndseed,$bubbles_per_row)=@_; + my $key = "$symb\0$uname\0$udom"; + if ($type eq 'randomizetry') { + if ($trial ne '') { + $key .= "\0".$trial; + } + } + if (exists($analyze_cache{$key})) { + my $getupdate = 0; + if (ref($add_to_hash) eq 'HASH') { + foreach my $item (keys(%{$add_to_hash})) { + if (ref($analyze_cache_formkeys{$key}) eq 'HASH') { + if (!exists($analyze_cache_formkeys{$key}{$item})) { + $getupdate = 1; + last; + } + } else { + $getupdate = 1; + } + } + } + if (!$getupdate) { + return $analyze_cache{$key}; + } + } + + my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); + $url=&Apache::lonnet::clutter($url); + my %form = ('grade_target' => 'analyze', + 'grade_domain' => $udom, + 'grade_symb' => $symb, + 'grade_courseid' => $env{'request.course.id'}, + 'grade_username' => $uname, + 'grade_noincrement' => $no_increment); + if ($bubbles_per_row ne '') { + $form{'bubbles_per_row'} = $bubbles_per_row; + } + if ($type eq 'randomizetry') { + $form{'grade_questiontype'} = $type; + if ($rndseed ne '') { + $form{'grade_rndseed'} = $rndseed; + } + } + if (ref($add_to_hash)) { + %form = (%form,%{$add_to_hash}); + } + my $subresult=&ssi_with_retries($url, $ssi_retries,%form); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + if (ref($add_to_hash) eq 'HASH') { + $analyze_cache_formkeys{$key} = $add_to_hash; + } else { + $analyze_cache_formkeys{$key} = {}; + } + return $analyze_cache{$key} = \%analyze; + } + + sub get_order { + my ($partid,$respid,$symb,$uname,$udom,$no_increment,$type,$trial,$rndseed)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,$no_increment,undef,$type,$trial,$rndseed); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,undef,undef,$type,$trial,$rndseed); + my $foils = &get_order($partid,$respid,$symb,$uname,$udom,undef,$type,$trial,$rndseed); + if (ref($foils) eq 'ARRAY') { + foreach my $foil (@{$foils}) { + if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { + return $foil; + } + } + } + } + + sub scantron_partids_tograde { + my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row) = @_; + my (%analysis,@parts); + if (ref($resource)) { + my $symb = $resource->symb(); + my $add_to_form; + if ($check_for_randomlist) { + $add_to_form = { 'check_parts_withrandomlist' => 1,}; + } + my $analyze = + &get_analyze($symb,$uname,$udom,undef,$add_to_form, + undef,undef,undef,$bubbles_per_row); + if (ref($analyze) eq 'HASH') { + %analysis = %{$analyze}; + } + if (ref($analysis{'parts'}) eq 'ARRAY') { + foreach my $part (@{$analysis{'parts'}}) { + my ($id,$respid) = split(/\./,$part); + if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { + push(@parts,$part); + } + } + } + } + return (\%analysis,\@parts); + } + } -sub get_fullname { - my ($uname,$udom) = @_; - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'],$udom,$uname); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname=$name{'lastname'}.$name{'generation'}; - if ($fullname =~ /[^\s]+/) { $fullname.=', '; } - $fullname.=$name{'firstname'}.' '.$name{'middlename'}; +#--- 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,$type,$trial,$rndseed) = @_; + my $grayFont = ''; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my ($toprow,$bottomrow); + foreach my $foil (@$order) { + if ($grading{$foil} == 1) { + $toprow.=''; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''. + ' '.$grayFont.&mt('Item ID').' '. + $middlerow.''.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { + my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + } + $answer =~ s-\n-'. + '
'. + ' '.&mt('Answer').' '.$toprow.''.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'.&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('
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'; + + $result .= 'Resource: '.$ENV{'form.url'}.' | ||
Part id: '.$_.' | '. - 'Type: '.$responsetype.' | '. - 'Handgrade: '.$handgrade.' |
'.
- '
|
+ +
+ENDPICK + my %fields=&get_fields(); + if (!defined($fields{'domain'})) { + my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); + $request->print("\n".&mt('Users are in domain: [_1]',$domform)."
\n"); + } + foreach my $key (sort(keys(%env))) { + if ($key !~ /^form\.(.*)$/) { next; } + my $cleankey=$1; + if ($cleankey eq 'command') { next; } + $request->print(''."\n"); + } + # FIXME do a check for any duplicated user ids... + # FIXME do a check for any invalid user ids?... + $request->print('". + &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", + "$username:$domain",$result)."
"); + } + $request->rflush(); + } + } + $request->print('' + .&mt('Unable to accept last correction, an error occurred: [_1]', + $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_+ +'.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).' +
+'.&mt('Sequence to be Graded:').' | '.$title.' |
'.&mt('Data File that will be used:').' | '.$env{'form.scantron_selectfile'}.' |
'.&mt("If this information is correct, please click on '[_1]'.",&mt($button_text)).'
+'.&mt('If something is incorrect, please return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','','').'
".&mt('You have forgotten to specify some information. Please go Back and try again.')."
"); + if ( $env{'form.selectpage'} eq '') { + $r->print(''.&mt('You have not selected a Sequence to grade').'
'); + } + if ( $env{'form.scantron_selectfile'} eq '') { + $r->print(''.&mt("You have not selected a file that contains the student's response data.").'
'); + } + if ( $env{'form.scantron_format'} eq '') { + $r->print(''.&mt("You have not selected the format of the student's response data.").'
'); + } + } else { + my $warning=&scantron_warning_screen('Grading: Validate Records',$symb); + my $bubbledbyhand=&hand_bubble_option(); + $r->print(' +'.$warning.$bubbledbyhand.' + + +'); + } + $r->print("'.&mt('Gathering necessary information.').'
');$r->rflush(); + #get the student pick code ready + $r->print(&Apache::loncommon::studentbrowser_javascript()); + my $nav_error; + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return ''; + } + my $result=&scantron_form_start($max_bubble).$default_form_data; + if ($env{'form.scantron_lastbubblepoints'} ne '') { + $result .= ''; + } + $r->print($result); + + my @validate_phases=( 'sequence', + 'ID', + 'CODE', + 'doublebubble', + 'missingbubbles'); + if (!$env{'form.validatepass'}) { + $env{'form.validatepass'} = 0; + } + my $currentphase=$env{'form.validatepass'}; + + + my $stop=0; + while (!$stop && $currentphase < scalar(@validate_phases)) { + $r->print(&mt('Validating '.$validate_phases[$currentphase]).''.&mt('Or return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','','').'
'); + } else { + if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { + $r->print(''); + } else { + $r->print(''); + } + $r->print(' '.&mt('using corrected info').'' + .&mt('Some resources in the sequence currently are not set to' + .' bubblesheet exam mode. Grading these resources currently may not' + .' work correctly.') + .'
' + ); + return (1,$currentphase); + } + } + + return (0,$currentphase+1); +} + + + +sub scantron_validate_ID { + my ($r,$currentphase) = @_; + + #get student info + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&username_to_idmap($classlist); + + #get scantron line setup + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my ($scanlines,$scan_data)=&scantron_getfile(); + + my $nav_error; + &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble_lines.. array. + if ($nav_error) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + + my %found=('ids'=>{},'usernames'=>{}); + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $id=$$scan_record{'scantron.ID'}; + my $found; + foreach my $checkid (keys(%idmap)) { + if (lc($checkid) eq lc($id)) { $found=$checkid;last; } + } + if ($found) { + my $username=$idmap{$found}; + if ($found{'ids'}{$found}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$found); + return(1,$currentphase); + } elsif ($found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$username); + return(1,$currentphase); + } + #FIXME store away line we previously saw the ID on to use above + $found{'ids'}{$found}++; + $found{'usernames'}{$username}++; + } else { + if ($id =~ /^\s*$/) { + my $username=&scan_data($scan_data,"$i.user"); + if (defined($username) && $found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateID',$username); + return(1,$currentphase); + } elsif (!defined($username)) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); + } + $found{'usernames'}{$username}++; + } else { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); + } + } + } + + return (0,$currentphase+1); +} + + +sub scantron_get_correction { + my ($r,$i,$scan_record,$scan_config,$line,$error,$arg, + $randomorder,$randompick,$respnumlookup,$startline)=@_; +#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 + + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { + $r->print( + '' + .&mt('An error was detected ([_1]) for PaperID [_2]', + "$error", + ''.$$scan_record{'scantron.PaperID'}.'') + ."
\n"); + } else { + $r->print( + '' + .&mt('An error was detected ([_1]) in scanline [_2] [_3]', + "$error", $i, "
$line") + ." \n"); + } + my $message = + '
'
+ .&mt('The ID on the form is [_1]',
+ "$$scan_record{'scantron.ID'}")
+ .'
'
+ .&mt('The name on the paper is [_1], [_2]',
+ $$scan_record{'scantron.LastName'},
+ $$scan_record{'scantron.FirstName'})
+ .'
'.&mt("The encoded ID is not in the classlist"). + "
\n"); + } elsif ($error eq 'duplicateID') { + $r->print(''.&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."
\n"); + } + $r->print($message); + $r->print("".&mt("How should I handle this?")."
\n");
+ $r->print("\n
'.&mt("The encoded CODE is not in the list of possible CODEs.")."
\n"); + } elsif ($error eq 'duplicateCODE') { + $r->print(''.&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."
\n"); + } + $r->print("".&mt('The CODE on the form is [_1]', + "'$$scan_record{'scantron.CODE'}'") + ."
\n"); + $r->print($message); + $r->print("".&mt("How should I handle this?")."
\n"); + $r->print("\n'.&mt("There have been multiple bubbles scanned for some question(s)")."
\n"); + + # The form field scantron_questions is acutally a list of line numbers. + # represented by this form so: + + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, + $respnumlookup,$startline); + + $r->print(''); + $r->print($message); + $r->print("".&mt("Please indicate which bubble should be used for grading")."
"); + foreach my $question (@{$arg}) { + my @linenums = &prompt_for_corrections($r,$question,$scan_config, + $scan_record, $error, + $randomorder,$randompick, + $respnumlookup,$startline); + push(@lines_to_correct,@linenums); + } + $r->print(&verify_bubbles_checked(@lines_to_correct)); + } elsif ($error eq 'missingbubble') { + $r->print(''.&mt("There have been [_1]no[_2] bubbles scanned for some question(s)",'','')."
\n"); + $r->print($message); + $r->print("".&mt("Please indicate which bubble should be used for grading.")."
"); + $r->print(&mt("Some questions have no scanned bubbles.")."\n"); + + # The form field scantron_questions is actually a list of line numbers not + # a list of question numbers. Therefore: + # + + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, + $respnumlookup,$startline); + + $r->print(''); + foreach my $question (@{$arg}) { + my @linenums = &prompt_for_corrections($r,$question,$scan_config, + $scan_record, $error, + $randomorder,$randompick, + $respnumlookup,$startline); + push(@lines_to_correct,@linenums); + } + $r->print(&verify_bubbles_checked(@lines_to_correct)); + } else { + $r->print("\n'.
+ &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','
').
+ ' '.&mt('or').' '.
+ '
');
+ if ($scancode eq '') {
+ $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'}));
+ } else {
+ $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2] and CODE: [_3].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
+ }
+ $r->print('
'.&Apache::loncommon::start_data_table()."\n".
+ &Apache::loncommon::start_data_table_header_row()."\n".
+ '
took $lasttime
"); + + $r->print(""); + return ''; +} + +sub graders_resources_pass { + my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb, + $bubbles_per_row) = @_; + if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && + (ref($grader_randomlists_by_symb) eq 'HASH')) { + foreach my $resource (@{$resources}) { + my $ressymb = $resource->symb(); + my ($analysis,$parts) = + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $env{'user.name'},$env{'user.domain'}, + 1,$bubbles_per_row); + $grader_partids_by_symb->{$ressymb} = $parts; + if (ref($analysis) eq 'HASH') { + if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { + $grader_randomlists_by_symb->{$ressymb} = + $analysis->{'parts_withrandomlist'}; + } + } + } + } + return; +} + +=pod + +=item users_order + + Returns array of resources in current map, ordered based on either CODE, + if this is a CODEd exam, or based on student's identity if this is a + "NAMEd" exam. + + Should be used when randomorder and/or randompick applied when the + corresponding exam was printed, prior to students completing bubblesheets + for the version of the exam the student received. + +=cut + +sub users_order { + my ($user,$scancode,$mapurl,$master_seq,$symb_to_resource,$orderedforcode) = @_; + my @mapresources; + unless ((ref($master_seq) eq 'ARRAY') && (ref($symb_to_resource) eq 'HASH')) { + return @mapresources; + } + if ($scancode) { + if ((ref($orderedforcode) eq 'HASH') && (ref($orderedforcode->{$scancode}) eq 'ARRAY')) { + @mapresources = @{$orderedforcode->{$scancode}}; + } else { + $env{'form.CODE'} = $scancode; + my $actual_seq = + &Apache::lonprintout::master_seq_to_person_seq($mapurl, + $master_seq, + $user,$scancode,1); + if (ref($actual_seq) eq 'ARRAY') { + @mapresources = map { $symb_to_resource->{$_}; } @{$actual_seq}; + if (ref($orderedforcode) eq 'HASH') { + if (@mapresources > 0) { + $orderedforcode->{$scancode} = \@mapresources; + } + } + } + delete($env{'form.CODE'}); + } + } else { + my $actual_seq = + &Apache::lonprintout::master_seq_to_person_seq($mapurl, + $master_seq, + $user,undef,1); + if (ref($actual_seq) eq 'ARRAY') { + @mapresources = + map { $symb_to_resource->{$_}; } @{$actual_seq}; + } + } + return @mapresources; +} + +sub grade_student_bubbles { + my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row, + $randomorder,$randompick,$respnumlookup,$startline) = @_; + my $uselookup = 0; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH') && + (ref($startline) eq 'HASH')) { + $uselookup = 1; + } + + if (ref($resources) eq 'ARRAY') { + my $count = 0; + foreach my $resource (@{$resources}) { + my $ressymb = $resource->symb(); + my %form = ('submitted' => 'scantron', + 'grade_target' => 'grade', + 'grade_username' => $uname, + 'grade_domain' => $udom, + 'grade_courseid' => $env{'request.course.id'}, + 'grade_symb' => $ressymb, + 'CODE' => $scancode + ); + if ($bubbles_per_row ne '') { + $form{'bubbles_per_row'} = $bubbles_per_row; + } + if ($env{'form.scantron_lastbubblepoints'} ne '') { + $form{'scantron_lastbubblepoints'} = $env{'form.scantron_lastbubblepoints'}; + } + if (ref($parts) eq 'HASH') { + if (ref($parts->{$ressymb}) eq 'ARRAY') { + foreach my $part (@{$parts->{$ressymb}}) { + if ($uselookup) { + $form{'scantron_questnum_start.'.$part} = $startline->{$count} + 1; + } else { + $form{'scantron_questnum_start.'.$part} = + 1+$env{'form.scantron.first_bubble_line.'.$count}; + } + $count++; + } + } + } + my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form); + return 'ssi_error' if ($ssi_error); + last if (&Apache::loncommon::connection_aborted($r)); + } + } + return; +} + +sub scantron_upload_scantron_data { + my ($r,$symb)=@_; + my $dom = $env{'request.role.domain'}; + my $domdesc = &Apache::lonnet::domain($dom,'description'); + $r->print(&Apache::loncommon::coursebrowser_javascript($dom)); + my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', + 'domainid', + 'coursename',$dom); + my $syllabuslink = ''.&mt('Syllabus').''. + (' 'x2).&mt('(shows course personnel)'); + my $default_form_data=&defaultFormData($symb); + my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.'); + my $nocourseid_alert = &mt("Please use the 'Select Course' link to open a separate window where you can search for a course to which a file can be uploaded."); + $r->print(&Apache::lonhtmlcommon::scripttag(' + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("'.$nofile_alert.'"); + return false; + } + if (formname.courseid.value == "") { + alert("'.$nocourseid_alert.'"); + return false; + } + formname.submit(); + } + + function ToSyllabus() { + var cdom = '."'$dom'".'; + var cnum = document.rules.courseid.value; + if (cdom == "" || cdom == null) { + return; + } + if (cnum == "" || cnum == null) { + return; + } + syllwin=window.open("/public/"+cdom+"/"+cnum+"/syllabus","LONCAPASyllabus", + "height=350,width=350,scrollbars=yes,menubar=no"); + return; + } + +')); + $r->print(' ++ '.&mt('The requested filename was invalid.').' +
+'); + return; + } + my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; + my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; + my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; + &Apache::lonnet::allowuploaded('/adm/grades',$orig); + &Apache::lonnet::allowuploaded('/adm/grades',$corrected); + &Apache::lonnet::allowuploaded('/adm/grades',$skipped); + $r->print(' ++ '.&mt('[_1]Original[_2] file as uploaded by the scantron office.', + '','').' +
++ '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', + '','').' +
++ '.&mt('[_1]Skipped[_2], a file of records that were skipped.', + '','').' +
+'); + return ''; +} + +sub checkscantron_results { + my ($r,$symb) = @_; + if (!$symb) {return '';} + my $cid = $env{'request.course.id'}; + my %lettdig = &letter_to_digits(); + my $numletts = scalar(keys(%lettdig)); + my $cnum = $env{'course.'.$cid.'.num'}; + my $cdom = $env{'course.'.$cid.'.domain'}; + my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'}); + my %record; + my %scantron_config = + &Apache::grades::get_scantron_config($env{'form.scantron_format'}); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); + my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); + my $classlist=&Apache::loncoursedata::get_classlist(); + my %idmap=&Apache::grades::username_to_idmap($classlist); + my $navmap=Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + $r->print(&navmap_errormsg()); + return ''; + } + my $map=$navmap->getResourceByUrl($sequence); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb,%orderedforcode); + if (ref($map)) { + $randomorder=$map->randomorder(); + $randompick=$map->randompick(); + } + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return ''; + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); + my ($uname,$udom); + my (%scandata,%lastname,%bylast); + $r->print(' +' + .&mt('Comparison of bubblesheet data (including corrections) with corresponding submission records (most recent submission) for [_1][quant,_2,student][_3] ([quant,_4,bubblesheet line] per student).', + '', + $numstudents, + '', + $env{'form.scantron_maxbubble'}) + .'
' + ); + $r->print(''
+ .&mt('Exact matches for [_1][quant,_2,student][_3].','',$passed,'')
+ .'
'
+ .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','',$failed,'')
+ .'
'.&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 {
- $request->print(&Apache::lonxml::tokeninputfield());
+ my ($uname,$udom)=split(/\:/,$correct_ids{$id});
+ $result.=&Apache::loncommon::plainname($uname,$udom);
}
+ $number++;
}
+ $result.="
'.&mt('Access Denied ([_1])',$command).'
'); } } - &send_footer($request); + if ($ssi_error) { + &ssi_print_error($request); + } + if ($env{'form.inhibitmenu'}) { + $request->print(&Apache::loncommon::end_page()); + } else { + &Apache::lonquickgrades::endGradeScreen($request); + } + &reset_caches(); return OK; } 1; __END__; + + +=head1 NAME + +Apache::grades + +=head1 SYNOPSIS + +Handles the viewing of grades. + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 OVERVIEW + +Do an ssi with retries: +While I'd love to factor out this with the vesrion in lonprintout, +that would either require a data coupling between modules, which I refuse to perpetuate (there's quite enough of that already), or would require the invention of another infrastructure +I'm not quite ready to invent (e.g. an ssi_with_retry object). + +At least the logic that drives this has been pulled out into loncommon. + + + +ssi_with_retries - Does the server side include of a resource. + if the ssi call returns an error we'll retry it up to + the number of times requested by the caller. + If we still have a proble, no text is appended to the + output and we set some global variables. + to indicate to the caller an SSI error occurred. + All of this is supposed to deal with the issues described + in LonCAPA BZ 5631 see: + http://bugs.lon-capa.org/show_bug.cgi?id=5631 + by informing the user that this happened. + +Parameters: + resource - The resource to include. This is passed directly, without + interpretation to lonnet::ssi. + form - The form hash parameters that guide the interpretation of the resource + + retries - Number of retries allowed before giving up completely. +Returns: + On success, returns the rendered resource identified by the resource parameter. +Side Effects: + The following global variables can be set: + ssi_error - If an unrecoverable error occurred this becomes true. + It is up to the caller to initialize this to false + if desired. + ssi_error_resource - If an unrecoverable error occurred, this is the value + of the resource that could not be rendered by the ssi + call. + ssi_error_message - The error string fetched from the ssi response + in the event of an error. + + +=head1 HANDLER SUBROUTINE + +ssi_with_retries() + +=head1 SUBROUTINES + +=over + +=head1 Routines to display previous version of a Task for a specific student + +Tasks are graded pass/fail. Students who have yet to pass a particular Task +can receive another opportunity. Access to tasks is slot-based. If a slot +requires a proctor to check-in the student, a new version of the Task will +be created when the student is checked in to the new opportunity. + +If a particular student has tried two or more versions of a particular task, +the submission screen provides a user with vgr privileges (e.g., a Course +Coordinator) the ability to display a previous version worked on by the +student. By default, the current version is displayed. If a previous version +has been selected for display, submission data are only shown that pertain +to that particular version, and the interface to submit grades is not shown. + +=over 4 + +=item show_previous_task_version() + +Displays a specified version of a student's Task, as the student sees it. + +Inputs: 2 + request - request object + symb - unique symb for current instance of resource + +Output: None. + +Side Effects: calls &show_problem() to print version of Task, with + version contained in form item: $env{'form.previousversion'} + +=item choose_task_version_form() + +Displays a web form used to select which version of a student's view of a +Task should be displayed. Either launches a pop-up window, or replaces +content in existing pop-up, or replaces page in main window. + +Inputs: 4 + symb - unique symb for current instance of resource + uname - username of student + udom - domain of student + nomenu - 1 if display is in a pop-up window, and hence no menu + breadcrumbs etc., are displayed + +Output: 4 + current - student's current version + displayed - student's version being displayed + result - scalar containing HTML for web form used to switch to + a different version (or a link to close window, if pop-up). + js - javascript for processing selection in versions web form + +Side Effects: None. + +=item previous_display_javascript() + +Inputs: 2 + nomenu - 1 if display is in a pop-up window, and hence no menu + breadcrumbs etc., are displayed. + current - student's current version number. + +Output: 1 + js - javascript for processing selection in versions web form. + +Side Effects: None. + +=back + +=head1 Routines to process bubblesheet data. + +=over 4 + +=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 + + $randomorder - True if exam folder has randomorder set + $randompick - True if exam folder has randompick set + $respnumlookup - Reference to HASH mapping question numbers in bubble lines + for current line to question number used for same question + in "Master Seqence" (as seen by Course Coordinator). + $startline - Reference to hash where key is question number (0 is first) + and value is number of first bubble line for current student + or code-based randompick and/or randomorder. + + + +=item scantron_get_maxbubble() : + + Arguments: + $nav_error - Reference to scalar which is a flag to indicate a + failure to retrieve a navmap object. + if $nav_error is set to 1 by scantron_get_maxbubble(), the + calling routine should trap the error condition and display the warning + found in &navmap_errormsg(). + + $scantron_config - Reference to bubblesheet format configuration hash. + + 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'}, + $env{'form.scantron.first_bubble_line.n'} and + $env{"form.scantron.sub_bubblelines.n"} + which are the total number of bubble lines, the number of bubble + lines for response n and number of the first bubble line for response n, + and a comma separated list of numbers of bubble lines for sub-questions + (for optionresponse, matchresponse, and rankresponse items), for response n. + + +=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. + +=item scantron_process_students() : + + Routine that does the actual grading of the bubblesheet 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. + +=item scantron_upload_scantron_data() : + + Creates the screen for adding a new bubblesheet data file to a course. + +=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. + +=item valid_file() : + + Validates that the requested bubble data file exists in the course. + +=item scantron_download_scantron_data() : + + Shows a list of the three internal files (original, corrected, + skipped) for a specific bubblesheet data file that exists in the + course. + +=item scantron_validate_ID() : + + Validates all scanlines in the selected file to not have any + invalid or underspecified student/employee IDs + +=item navmap_errormsg() : + + Returns HTML mark-up inside a with a link to re-initialize the course. + Should be called whenever the request to instantiate a navmap object fails. + +=back + +=back + +=cutThe 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.