--- loncom/homework/grades.pm 2008/12/10 21:30:38 1.528.2.1 +++ loncom/homework/grades.pm 2010/04/01 02:28:27 1.574.2.10 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.528.2.1 2008/12/10 21:30:38 raeburn Exp $ +# $Id: grades.pm,v 1.574.2.10 2010/04/01 02:28:27 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,6 +26,8 @@ # http://www.lon-capa.org/ # + + package Apache::grades; use strict; use Apache::style; @@ -58,46 +60,6 @@ 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); @@ -135,9 +97,15 @@ sub ssi_print_error { # # --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($symb) = @_; + my ($symb,$errorref) = @_; my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + if (ref($errorref)) { + $$errorref = 'navmap'; + return; + } + } my $res = $navmap->getBySymb($symb); my $partlist = $res->parts(); my $url = $res->src(); @@ -182,9 +150,15 @@ sub nameUserString { #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { - my ($symb) = shift; + my ($symb,$response_error) = @_; my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + if (ref($response_error)) { + $$response_error = 1; + } + return; + } my $res = $navmap->getBySymb($symb); my $partlist = $res->parts(); my %vPart = @@ -231,12 +205,17 @@ sub get_display_part { #--- Show resource title #--- and parts and response type sub showResourceInfo { - my ($symb,$probTitle,$checkboxes) = @_; + my ($symb,$probTitle,$checkboxes,$res_error) = @_; my $col=3; if ($checkboxes) { $col=4; } my $result = '
'.&mt('Part: [_1]',$display_part).' '. - $resID.' | '. - ''.&mt('Type: [_1]',$responsetype).' | '; + $result.=''.&mt('Part').': '.$display_part. + ' '.$resID.' | '. + ''.&mt('Type').': '.$responsetype.' | '; # ''.&mt('Handgrade: [_1]',$handgrade).' | '; } } @@ -272,28 +251,54 @@ sub reset_caches { { my %analyze_cache; + my %analyze_cache_formkeys; sub reset_analyze_cache { undef(%analyze_cache); + undef(%analyze_cache_formkeys); } sub get_analyze { - my ($symb,$uname,$udom,$no_increment)=@_; + my ($symb,$uname,$udom,$no_increment,$add_to_hash)=@_; my $key = "$symb\0$uname\0$udom"; - return $analyze_cache{$key} if (exists($analyze_cache{$key})); + 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 $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, - 'grade_noincrement' => $no_increment)); + 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 (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; } @@ -306,12 +311,41 @@ sub reset_caches { sub get_radiobutton_correct_foil { my ($partid,$respid,$symb,$uname,$udom)=@_; my $analyze = &get_analyze($symb,$uname,$udom); - foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) { - if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { - return $foil; + my $foils = &get_order($partid,$respid,$symb,$uname,$udom); + 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) = @_; + 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); + 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); + } + } #--- Clean response type for display @@ -737,7 +771,7 @@ sub verifyreceipt { my $title.= '