--- loncom/homework/grades.pm 2002/04/09 03:56:29 1.20 +++ loncom/homework/grades.pm 2008/12/15 20:55:38 1.536 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.20 2002/04/09 03:56:29 albertel Exp $ +# $Id: grades.pm,v 1.536 2008/12/15 20:55:38 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,10 +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 + + package Apache::grades; use strict; @@ -36,407 +34,9064 @@ 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 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).
+'
"; + } else { + $result.=" | "; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$symb); + $result.=' | '.&mt('Part: [_1]',$display_part).' '. + $resID.' | '. + ''.&mt('Type: [_1]',$responsetype).' | '.&mt('Handgrade: [_1]',$handgrade).' | '; + } + } + $result.='
'; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. + $grayFont.$bottomrow.'
'; + } 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('Answer').' '.$toprow.''. + ' '.$grayFont.&mt('Item ID').' '. + $middlerow.''.' '.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } 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-'. + '
'. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. + $grayFont.$bottomrow.'
'.&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('
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'; + + $result .= ''. + &mt('The above receipt matches the following [numerate,_1,student].',$matches). + '
'. + $header. + $contents. + &Apache::loncommon::end_data_table()."\n"; + } + return $string.&show_grading_menu_form($symb); +} + +#--- This is called by a number of programs. +#--- Called from the Grading Menu - View/Grade an individual student +#--- Also called directly when one clicks on the subm button +# on the problem page. sub listStudents { - my ($request) = shift; - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - my $chome=$ENV{"course.$ENV{'request.course.id'}.home"}; - $request->print ('Username | Domain | Name | |
---|---|---|---|