--- loncom/homework/grades.pm 2002/07/08 21:18:54 1.37 +++ loncom/homework/grades.pm 2010/04/12 12:55:18 1.611 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.37 2002/07/08 21:18:54 ng Exp $ +# $Id: grades.pm,v 1.611 2010/04/12 12:55:18 www 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,372 +34,1406 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; +use Apache::lonnavmaps; use Apache::lonhomework; +use Apache::lonpickcode; +use Apache::loncoursedata; +use Apache::lonmsg(); use Apache::Constants qw(:common); +use Apache::lonlocal; +use Apache::lonenc; +use String::Similarity; +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; + + +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; -sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'); - } - return ''; } +# +# Prodcuces an ssi retry failure error message to the user: +# -sub verifyreceipt { - my $request=shift; - my $courseid=$ENV{'request.course.id'}; -# my $cdom=$ENV{"course.$courseid.domain"}; -# my $cnum=$ENV{"course.$courseid.num"}; - my $receipt=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. - $ENV{'form.receipt'}; - $receipt=~s/[^\-\d]//g; - my $symb=$ENV{'form.symb'}; - unless ($symb) { - $symb=&Apache::lonnet::symbread($ENV{'form.url'}); +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 student_gradeStatus { - my ($url,$udom,$uname) = @_; - 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); - foreach my $part (&getpartlist($url)) { - my ($temp,$part,$type)=split(/_/,$part); - if ($type eq 'solved') { - my ($status,$foo)=split(/_/,$record{"resource.$part.$type"},2); - $status = 'partial' if ($foo =~ /^partially/); - $status = 'nothing' if ($status eq ''); - return $type,$status; +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 ''; + return $display; } -sub get_fullname { - my ($sname,$sdom) = @_; - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'], - $sdom,$sname); - 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'}; +sub reset_caches { + &reset_analyze_cache(); + &reset_perm(); +} + +{ + my %analyze_cache; + my %analyze_cache_formkeys; + + sub reset_analyze_cache { + undef(%analyze_cache); + undef(%analyze_cache_formkeys); } - return $fullname; + + sub get_analyze { + my ($symb,$uname,$udom,$no_increment,$add_to_hash)=@_; + my $key = "$symb\0$uname\0$udom"; + 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 (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)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,$no_increment); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my $analyze = &get_analyze($symb,$uname,$udom); + 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); + } + } -sub listStudents { - my ($request) = shift; - my $cdom =$ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum =$ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec =$ENV{'form.section'}; - my $submitonly=$ENV{'form.submitonly'}; - - $request->print(<
-
'.$item.' | ';
+ $middlerow.=''.$grayFont.$answer{$foil}.' | ';
+ } else {
+ $toprow.=''.$item.' | ';
+ $middlerow.=''.$grayFont.$answer{$foil}.' | ';
+ }
+ $bottomrow.=''.$grayFont.$foil.' | ';
+ }
+ return ''; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=' '.&mt('true').' | ';
+ } else {
+ $toprow.=''.&mt('true').' | ';
+ }
+ } else {
+ $toprow.=''.&mt('false').' | ';
+ }
+ $bottomrow.=''.$grayFont.$foil.' | ';
+ }
+ return ''; + } 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- -g; + return ' '.&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(' ',($version,@matches)); + + + } else { + my $result = + ' ' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .' '; + + $result .= '
'."\n".
- ' | '.$sname.' | '."\n".
- ' '.$fullname.' | '."\n".
- ' '.$sdom.' | '."\n");
- $request->print(' '.$status.' | '."\n");
+#-- A couple of common js functions
+sub commonJSfunctions {
+ my $request = shift;
+ $request->print(&Apache::lonhtmlcommon::scripttag(< |
' + .&mt('No match found for the above receipt number.') + .'
'; + } else { + $string = &jscriptNform($symb).$title. + ''. + &mt('The above receipt number matches the following [quant,_1,student].',$matches). + '
'. + $header. + $contents. + &Apache::loncommon::end_data_table()."\n"; + } + return $string.&show_grading_menu_form($symb); } -#FIXME need to look at the metadata';
- $result.='
|
\n"; + $radio.=(($ctr+1)%10 == 0 ? ' |
'."\n"; + $endform.=' '."\n"; + my $ntstu =''."\n"; + my $nsel = ($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : '1'); + $ntstu =~ s/ |
Resource: | '. - ''.$url.' |
Type: | '. - ''.$responsetype.' Handgrade: '.$handgrade.' |
'."\n";
- $result.='
|
'."\n";
- $result.='
|
'."\n";
- $result.='
|
'."\n";
- $result.='
|
\n"; + $result.=(($ctr+1)%10 == 0 ? ' |
'.
+ &mt('Number of records updated = [_1] for [quant,_2,student].',
+ $rec_update,$count).'
'.
+ ''.&mt('Total number of students = [_1]',$env{'form.total'}).
+ '
'."\n";
+ $result.='
|
+ +
+ENDPICK + my %fields=&get_fields(); + if (!defined($fields{'domain'})) { + my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); + $request->print("\nUsers are in domain: ".$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(); + $countdone++; + } + } + $request->print('