--- loncom/homework/grades.pm 2008/02/04 23:30:05 1.507 +++ loncom/homework/grades.pm 2008/04/16 23:30:03 1.517 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.507 2008/02/04 23:30:05 raeburn Exp $ +# $Id: grades.pm,v 1.517 2008/04/16 23:30:03 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; @@ -1759,9 +1842,9 @@ sub download_all_link { join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); my $identifier = &Apache::loncommon::get_cgi_id(); - &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students, - 'cgi.'.$identifier.'.symb' => $symb, - 'cgi.'.$identifier.'.parts' => $parts,); + &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, + 'cgi.'.$identifier.'.symb' => $symb, + 'cgi.'.$identifier.'.parts' => $parts,}); $r->print(''. &mt('Download All Submitted Documents').''); return @@ -2685,7 +2768,7 @@ sub check_and_remove_from_queue { sub handback_files { my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; - my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio'; + my $portfolio_root = '/userfiles/portfolio'; my ($partlist,$handgrade,$responseType) = &response_type($symb); my @part_response_id = &flatten_responseType($responseType); @@ -2703,7 +2786,8 @@ sub handback_files { my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); - my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root); + my $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath); my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); # fix file name my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); @@ -2839,8 +2923,7 @@ sub version_portfiles { my $version_parts = join('|',@$v_flag); my @returned_keys; my $parts = join('|', @$parts_graded); - my $portfolio_root = &propath($domain,$stu_name). - '/userfiles/portfolio'; + my $portfolio_root = '/userfiles/portfolio'; foreach my $key (keys(%$record)) { my $new_portfiles; if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { @@ -2851,7 +2934,8 @@ sub version_portfiles { my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); - my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root); + my $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath); my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); if ($new_answer ne 'problem getting file') { @@ -3960,31 +4044,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 +4765,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 @@ -4750,8 +4835,9 @@ sub get_response_bubbles { sub scantron_filenames { my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $getpropath = 1; my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, - &propath($cdom,$cname)); + $getpropath); my @possiblenames; foreach my $filename (sort(@files)) { ($filename)=split(/&/,$filename); @@ -4880,6 +4966,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 +5545,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); @@ -5556,7 +5647,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)) { @@ -6030,8 +6124,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.' @@ -6792,13 +6885,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 @@ -6832,7 +6926,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. ")."
"); @@ -7113,7 +7210,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 @@ -7145,23 +7242,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); @@ -7170,11 +7271,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); } @@ -7186,10 +7294,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') { @@ -7199,6 +7308,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'}}); @@ -7323,9 +7436,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'}); @@ -7357,6 +7473,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)=('',''); @@ -7384,7 +7511,7 @@ SCANTRONFORM ($uname,$udom)=split(/:/,$uname); &Apache::lonxml::clear_problem_counter(); - &Apache::lonnet::appenv(%$scan_record); + &Apache::lonnet::appenv($scan_record); if (&scantron_clear_skip($scanlines,$scan_data,$i)) { &scantron_putfile($scanlines,$scan_data); @@ -7405,10 +7532,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}; @@ -7710,14 +7843,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"; @@ -8450,7 +8581,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'}) { @@ -8463,7 +8594,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, @@ -8550,6 +8681,9 @@ sub handler { $request->print("Access Denied ($command)"); } } + if ($ssi_error) { + &ssi_print_error($request); + } $request->print(&Apache::loncommon::end_page()); &reset_caches(); return '';