--- loncom/homework/grades.pm 2008/02/01 22:50:43 1.503 +++ loncom/homework/grades.pm 2008/03/24 19:14:07 1.513.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.503 2008/02/01 22:50:43 raeburn Exp $ +# $Id: grades.pm,v 1.513.2.2 2008/03/24 19:14:07 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -47,8 +47,91 @@ use LONCAPA; use POSIX qw(floor); + my %perm=(); +# These variables are used to recover from ssi errors + +my $ssi_retries = 5; +my $ssi_error; +my $ssi_error_resource; +my $ssi_error_message; + + +# 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. +# +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 $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('An unrecoverable network error occurred:').'

+

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

'); + return; +} + # # --- Retrieve the parts from the metadata file.--- sub getpartlist { @@ -201,13 +284,13 @@ sub reset_caches { 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)); + my $subresult=&ssi_with_retries($url, $ssi_retries, + ('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; @@ -3960,31 +4043,31 @@ sub csvuploadassign { $grades{$store_key}=$entries{$fields{$dest}}; } } - if (! %grades) { push(@skipped,"$username:$domain no data to save"); } - $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; - my $result=&Apache::lonnet::cstore(\%grades,$symb, + if (! %grades) { + push(@skipped,&mt("[_1]: no data to save","$username:$domain")); + } else { + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $result=&Apache::lonnet::cstore(\%grades,$symb, $env{'request.course.id'}, $domain,$username); - if ($result eq 'ok') { - $request->print('.'); - } else { - $request->print("

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

" ); - } - $request->rflush(); - $countdone++; + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print("

". + &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", + "$username:$domain",$result)."

"); + } + $request->rflush(); + $countdone++; + } } - $request->print("
Saved $countdone students\n"); + $request->print('
'.&mt("Saved [_1] students",$countdone)."\n"); if (@skipped) { - $request->print('

Skipped Students

'); + $request->print('

'.&mt('Skipped Students').'

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

Students Not Allowed to Modify

'); + $request->print('

'.&mt('Students Not Allowed to Modify').'

'); foreach my $student (@notallowed) { $request->print("$student
\n"); } } $request->print("
\n"); @@ -4681,9 +4764,10 @@ my %bubble_lines_per_response; # no. my %first_bubble_line; # First bubble line no. for each bubble. -my %subdivided_bubble_lines; # no. bubble lines for optionresponse - # or matchresponse where an individual - # response can have multiple lines +my %subdivided_bubble_lines; # no. bubble lines for optionresponse, + # matchresponse or rankresponse, where + # an individual response can have multiple + # lines my %responsetype_per_response; # responsetype for each response @@ -4880,6 +4964,8 @@ sub scantron_selectphase { my $CODE_unique=&scantron_CODEunique(); my $result; + $ssi_error = 0; + # Chunk of form to prompt for a file to grade and how: $result.= ' @@ -5457,7 +5543,10 @@ sub scantron_validator_lettnum { my $occurrences = 0; if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || ($responsetype_per_response{$questnum-1} eq 'formularesponse') || - ($responsetype_per_response{$questnum-1} eq 'stringresponse')) { + ($responsetype_per_response{$questnum-1} eq 'stringresponse') || + ($responsetype_per_response{$questnum-1} eq 'imageresponse') || + ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || + ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { my @singlelines = split('',$currquest); foreach my $entry (@singlelines) { $occurrences = &occurence_count($entry,$matchon); @@ -5524,6 +5613,10 @@ sub scantron_validator_positional { # If the split only gives us one element.. the full length of the # answer string, no bubbles are filled in: + if ($answers_needed eq '') { + return; + } + if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { for (my $ans=0; $ans<$answers_needed; $ans++ ) { $record->{"scantron.$ansnum.answer"}=''; @@ -5552,7 +5645,10 @@ sub scantron_validator_positional { # if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || ($responsetype_per_response{$questnum-1} eq 'formularesponse') || - ($responsetype_per_response{$questnum-1} eq 'stringresponse')) { + ($responsetype_per_response{$questnum-1} eq 'stringresponse') || + ($responsetype_per_response{$questnum-1} eq 'imageresponse') || + ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || + ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { my $doubleerror = 0; while (($currquest >= $$scantron_config{'Qlength'}) && (!$doubleerror)) { @@ -5950,6 +6046,8 @@ SCANTRONFORM ''."\n"; $chunk .= ''."\n"; + $chunk .= + ''."\n"; $result .= $chunk; $line++; } @@ -6024,8 +6122,7 @@ sub scantron_validate_file { } if (!$stop) { my $warning=&scantron_warning_screen('Start Grading'); - $r->print(' -'.&mt('Validation process complete.').'
+ $r->print(&mt('Validation process complete.').'
'.$warning.' @@ -6760,7 +6857,7 @@ sub questions_to_line_list { $first = $first_bubble_line{$question-1} + 1; $count = $bubble_lines_per_response{$question-1}; } - my $last = $first+$count-1; + $last = $first+$count-1; push(@lines, ($first..$last)); } return join(',', @lines); @@ -6786,13 +6883,14 @@ for multi and missing bubble cases). Numbered from 0 (but question numbers are from 1. %first_bubble_line - Starting bubble line for each question. - %subdivided_bubble_lines - optionresponse and matchresponse type - problems render as separate sub-questions, + %subdivided_bubble_lines - optionresponse, matchresponse and rankresponse + type problems render as separate sub-questions, in exam mode. This hash contains a comma-separated list of the lines per sub-question. - %responsetype_per_response - essayresponse, forumalaresponse, and - stringresponse type problem parts can have + %responsetype_per_response - essayresponse, formularesponse, + stringresponse, imageresponse, reactionresponse, + and organicresponse type problem parts can have multiple lines per response if the weight assigned exceeds 10. In this case, only one bubble per line is permitted, but more @@ -6826,7 +6924,10 @@ sub prompt_for_corrections { $r->print(&mt('The group of bubble lines below responds to a single question.').'
'); if (($responsetype_per_response{$question-1} eq 'essayresponse') || ($responsetype_per_response{$question-1} eq 'formularesponse') || - ($responsetype_per_response{$question-1} eq 'stringresponse')) { + ($responsetype_per_response{$question-1} eq 'stringresponse') || + ($responsetype_per_response{$question-1} eq 'imageresponse') || + ($responsetype_per_response{$question-1} eq 'reactionresponse') || + ($responsetype_per_response{$question-1} eq 'organicresponse')) { $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their scantron sheets.",$lines).'

'.&mt('A non-zero score can be assigned to the student during scantron grading by selecting a bubble in at least one line.').'
'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'
'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'

'); } else { $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."
"); @@ -7107,7 +7208,7 @@ sub scantron_validate_doublebubble { 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 items only), for response n. + (for optionresponse, matchresponse, and rankresponse items), for response n. =cut @@ -7139,23 +7240,27 @@ sub scantron_get_maxbubble { my $response_number = 0; my $bubble_line = 0; foreach my $resource (@resources) { - # Need to retrieve part IDs and response IDs because essayresponse - # items are not included in $analysis{'parts'} from lonnet::ssi. + my $symb = $resource->symb(); + # Need to retrieve part IDs and response IDs because essayresponse, + # reactionresponse and organicresponse items are not included in + # $analysis{'parts'} from lonnet::ssi. my %possible_part_ids; if (ref($resource->parts()) eq 'ARRAY') { foreach my $part (@{$resource->parts()}) { - my @resp_ids = $resource->responseIds($part); - foreach my $id (@resp_ids) { - $possible_part_ids{$part.'.'.$id} = 1; + if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) { + my @resp_ids = $resource->responseIds($part); + foreach my $id (@resp_ids) { + $possible_part_ids{$part.'.'.$id} = 1; + } } } } - my $result=&Apache::lonnet::ssi($resource->src(), - ('symb' => $resource->symb()), - ('grade_target' => 'analyze'), - ('grade_courseid' => $cid), - ('grade_domain' => $udom), - ('grade_username' => $uname)); + my $result=&ssi_with_retries($resource->src(), $ssi_retries, + ('symb' => $symb, + 'grade_target' => 'analyze', + 'grade_courseid' => $cid, + 'grade_domain' => $udom, + 'grade_username' => $uname)); my (undef, $an) = split(/_HASH_REF__/,$result, 2); @@ -7164,11 +7269,18 @@ sub scantron_get_maxbubble { my %analysis = &Apache::lonnet::str2hash($an); if (ref($analysis{'parts'}) eq 'ARRAY') { - @parts = @{$analysis{'parts'}}; + foreach my $part (@{$analysis{'parts'}}) { + my ($id,$respid) = split(/\./,$part); + if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { + push(@parts,$part); + } + } } # Add part_ids for any essayresponse items. foreach my $part_id (keys(%possible_part_ids)) { - if ($analysis{$part_id.'.type'} eq 'essayresponse') { + if (($analysis{$part_id.'.type'} eq 'essayresponse') || + ($analysis{$part_id.'.type'} eq 'reactionresponse') || + ($analysis{$part_id.'.type'} eq 'organicresponse')) { if (!grep(/^\Q$part_id\E$/,@parts)) { push (@parts,$part_id); } @@ -7180,10 +7292,11 @@ sub scantron_get_maxbubble { # TODO - make this a persistent hash not an array. - # optionresponse and matchresponse type items render as - # separate sub-questions in exam mode. + # optionresponse, matchresponse and rankresponse type items + # render as separate sub-questions in exam mode. if (($analysis{$part_id.'.type'} eq 'optionresponse') || - ($analysis{$part_id.'.type'} eq 'matchresponse')) { + ($analysis{$part_id.'.type'} eq 'matchresponse') || + ($analysis{$part_id.'.type'} eq 'rankresponse')) { my ($numbub,$numshown); if ($analysis{$part_id.'.type'} eq 'optionresponse') { if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') { @@ -7193,6 +7306,10 @@ sub scantron_get_maxbubble { if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') { $numbub = scalar(@{$analysis{$part_id.'.items'}}); } + } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') { + if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') { + $numbub = scalar(@{$analysis{$part_id.'.foils'}}); + } } if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') { $numshown = scalar(@{$analysis{$part_id.'.shown'}}); @@ -7260,7 +7377,25 @@ sub scantron_validate_missingbubbles { # Probably here's where the error is... foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { - if ($missing > $max_bubble) { next; } + my $lastbubble; + if ($missing =~ /^(\d+)\.(\d+)$/) { + my $question = $1; + my $subquestion = $2; + if (!defined($first_bubble_line{$question -1})) { next; } + my $first = $first_bubble_line{$question-1}; + my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); + my $subcount = 1; + while ($subcount<$subquestion) { + $first += $subans[$subcount-1]; + $subcount ++; + } + my $count = $subans[$subquestion-1]; + $lastbubble = $first + $count; + } else { + if (!defined($first_bubble_line{$missing - 1})) { next; } + $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1}; + } + if ($lastbubble > $max_bubble) { next; } push(@to_correct,$missing); } if (@to_correct) { @@ -7299,9 +7434,12 @@ sub scantron_validate_missingbubbles { sub scantron_process_students { my ($r) = @_; + my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); my ($symb)=&get_symb($r); - if (!$symb) {return '';} + if (!$symb) { + return ''; + } my $default_form_data=&defaultFormData($symb); my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); @@ -7333,6 +7471,17 @@ SCANTRONFORM my ($uname,$udom,$started); &scantron_get_maxbubble(); # Need the bubble lines array to parse. + + + # If an ssi failed in scantron_get_maxbubble, put an error message out to + # the user and return. + + if ($ssi_error) { + $r->print(""); + &ssi_print_error($r); + $r->print(&show_grading_menu_form($symb)); + return ''; # Dunno why the other returns return '' rather than just returning. + } while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); @@ -7381,10 +7530,16 @@ SCANTRONFORM $form{'CODE'}=$scan_record->{'scantron.CODE'}; } else { $form{'CODE'}=''; + } + my $result=&ssi_with_retries($resource->src(), $ssi_retries, %form); + if ($ssi_error) { + $ssi_error = 0; # So end of handler error message does not trigger. + $r->print(""); + &ssi_print_error($r); + $r->print(&show_grading_menu_form($symb)); + return ''; # Why return ''? Beats me. } - my $result=&Apache::lonnet::ssi($resource->src(),%form); - if ($result ne '') { - } + if (&Apache::loncommon::connection_aborted($r)) { last; } } $completedstudents{$uname}={'line'=>$line}; @@ -7686,14 +7841,12 @@ sub grading_menu { $menudata->{'url'}.'" >'. $menudata->{'name'}."\n"; } else { - $Str .='

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

'; - $Str .= (' 'x8). - &mt(' receipt: [_1]', - &Apache::lonnet::recprefix($env{'request.course.id'}). - '-'); + ' /> '. + &Apache::lonnet::recprefix($env{'request.course.id'}). + '-'; } $Str .= ' '.(' 'x8).$menudata->{'short_description'}. "\n"; @@ -8426,7 +8579,7 @@ sub handler { &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); } - + $ssi_error = 0; $request->print(&Apache::loncommon::start_page('Grading')); if ($symb eq '' && $command eq '') { if ($env{'user.adv'}) { @@ -8439,7 +8592,7 @@ sub handler { if ($tsymb) { my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { - $request->print(&Apache::lonnet::ssi_body('/res/'.$url, + $request->print(&ssi_with_retries('/res/'.$url, $ssi_retries, ('grade_username' => $tuname, 'grade_domain' => $tudom, 'grade_courseid' => $tcrsid, @@ -8526,6 +8679,9 @@ sub handler { $request->print("Access Denied ($command)"); } } + if ($ssi_error) { + &ssi_print_error($request); + } $request->print(&Apache::loncommon::end_page()); &reset_caches(); return '';