--- loncom/homework/grades.pm 2008/02/04 13:46:35 1.505
+++ loncom/homework/grades.pm 2008/04/21 16:30:47 1.518
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.505 2008/02/04 13:46:35 raeburn Exp $
+# $Id: grades.pm,v 1.518 2008/04/21 16:30:47 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('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)
-
-
');
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);
@@ -4794,19 +4880,69 @@ sub scantron_uploads {
=cut
sub scantron_scantab {
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
my $result=''."\n";
-
return $result;
}
+=pod
+
+=item get_scantronformat_file
+
+ Returns an array containing lines from the scantron format file for
+ the domain of the course.
+
+ If a url for a custom.tab file is listed in domain's configuration.db,
+ lines are from this file.
+
+ Otherwise, if a default.tab has been published in RES space by the
+ domainconfig user, lines are from this file.
+
+ Otherwise, fall back to getting lines from the legacy file on the
+ local server: /home/httpd/lonTabs/scantronformat.tab
+
+=cut
+
+sub get_scantronformat_file {
+ my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom);
+ my $gottab = 0;
+ my @lines;
+ if (ref($domconfig{'scantron'}) eq 'HASH') {
+ if ($domconfig{'scantron'}{'scantronformat'} ne '') {
+ my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'});
+ if ($formatfile ne '-1') {
+ @lines = split("\n",$formatfile,-1);
+ $gottab = 1;
+ }
+ }
+ }
+ if (!$gottab) {
+ my $confname = $cdom.'-domainconfig';
+ my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab';
+ my $formatfile = &Apache::lonnet::getfile($default);
+ if ($formatfile ne '-1') {
+ @lines = split("\n",$formatfile,-1);
+ $gottab = 1;
+ }
+ }
+ if (!$gottab) {
+ my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+ @lines = <$fh>;
+ close($fh);
+ }
+ return @lines;
+}
+
=pod
=item scantron_CODElist
@@ -4880,6 +5016,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.= '
@@ -5063,10 +5201,10 @@ sub scantron_selectphase {
sub get_scantron_config {
my ($which) = @_;
- my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
+ my @lines = &get_scantronformat_file();
my %config;
#FIXME probably should move to XML it has already gotten a bit much now
- foreach my $line (<$fh>) {
+ foreach my $line (@lines) {
my ($name,$descrip)=split(/:/,$line);
if ($name ne $which ) { next; }
chomp($line);
@@ -5457,7 +5595,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 +5665,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 +5697,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)) {
@@ -6026,8 +6174,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.'
@@ -6762,7 +6909,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);
@@ -6788,13 +6935,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
@@ -6828,7 +6976,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. ")." ");
@@ -7109,7 +7260,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
@@ -7141,23 +7292,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);
@@ -7166,11 +7321,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);
}
@@ -7182,10 +7344,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') {
@@ -7195,6 +7358,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'}});
@@ -7319,9 +7486,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'});
@@ -7353,6 +7523,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)=('','');
@@ -7380,7 +7561,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);
@@ -7401,10 +7582,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};
@@ -7706,14 +7893,12 @@ sub grading_menu {
$menudata->{'url'}.'" >'.
$menudata->{'name'}."\n";
} else {
- $Str .='