--- loncom/homework/grades.pm 2007/11/16 07:56:15 1.492 +++ loncom/homework/grades.pm 2010/03/19 21:22:34 1.599 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.492 2007/11/16 07:56:15 albertel Exp $ +# $Id: grades.pm,v 1.599 2010/03/19 21:22:34 www 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; @@ -47,96 +49,66 @@ use LONCAPA; use POSIX qw(floor); -my %perm=(); -my %bubble_lines_per_response = (); # no. bubble lines for each response. - # index is "symb.part_id" - -my %first_bubble_line = (); # First bubble line no. for each bubble. - -# Save and restore the bubble lines array to the form env. - - -sub save_bubble_lines { - foreach my $line (keys(%bubble_lines_per_response)) { - $env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; - $env{"form.scantron.first_bubble_line.$line"} = - $first_bubble_line{$line}; - } -} - -sub restore_bubble_lines { - my $line = 0; - %bubble_lines_per_response = (); - while ($env{"form.scantron.bubblelines.$line"}) { - my $value = $env{"form.scantron.bubblelines.$line"}; - $bubble_lines_per_response{$line} = $value; - $first_bubble_line{$line} = - $env{"form.scantron.first_bubble_line.$line"}; - $line++; - } - -} - -# Given the parsed scanline, get the response for -# 'answer' number n: +my %perm=(); -sub get_response_bubbles { - my ($parsed_line, $response) = @_; +# These variables are used to recover from ssi errors +my $ssi_retries = 5; +my $ssi_error; +my $ssi_error_resource; +my $ssi_error_message; - my $bubble_line = $first_bubble_line{$response-1} +1; - my $bubble_lines= $bubble_lines_per_response{$response-1}; - - my $selected = ""; - for (my $bline = 0; $bline < $bubble_lines; $bline++) { - $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; - $bubble_line++; +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 $selected; -} + return $content; -# ----- These first few routines are general use routines.---- - -# Return the number of occurences of a pattern in a string. - -sub occurence_count { - my ($string, $pattern) = @_; - - my @matches = ($string =~ /$pattern/g); - - return scalar(@matches); } +# +# Prodcuces an ssi retry failure error message to the user: +# - -# Take a string known to have digits and convert all the -# digits into letters in the range J,A..I. - -sub digits_to_letters { - my ($input) = @_; - - my @alphabet = ('J', 'A'..'I'); - - my @input = split(//, $input); - my $output =''; - for (my $i = 0; $i < scalar(@input); $i++) { - if ($input[$i] =~ /\d/) { - $output .= $alphabet[$input[$i]]; - } else { - $output .= $input[$i]; - } - } - return $output; +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.--- +# Returns an array of everything that the resources stores away +# + 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(); @@ -152,13 +124,17 @@ sub getpartlist { } # --- Get the symbolic name of a problem and the url +# Generate an error message if symb could not be found unless silent flag is set +# Takes $env{'form.symb'} by default; if not present, takes $env{'form.url'} and tries to get symb from that +# + sub get_symb { my ($request,$silent) = @_; (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); if ($symb eq '') { if (!$silent) { - $request->print("Unable to handle ambiguous references:$url:."); + $request->print(&mt("Unable to handle ambiguous references: [_1].",$url)); return (); } } @@ -181,10 +157,20 @@ 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); + unless (ref($res)) { + $$response_error = 1; + return; + } my $partlist = $res->parts(); my %vPart = map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); @@ -220,7 +206,8 @@ sub get_display_part { my ($partID,$symb)=@_; my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); if (defined($display) and $display ne '') { - $display.= " (id $partID)"; + $display.= ' (' + .&mt('Part ID: [_1]',$partID).')'; } else { $display=$partID; } @@ -229,40 +216,52 @@ sub get_display_part { #--- Show resource title #--- and parts and response type -sub showResourceInfo { - my ($symb,$probTitle,$checkboxes) = @_; - my $col=3; - if ($checkboxes) { $col=4; } - my $result = '

'.&mt('Current Resource').': '.$probTitle.'

'."\n"; - $result .=''; - my ($partlist,$handgrade,$responseType) = &response_type($symb); - my %resptype = (); - my $hdgrade='no'; - my %partsseen; - foreach my $partID (sort keys(%$responseType)) { - foreach my $resID (sort keys(%{ $responseType->{$partID} })) { - my $handgrade=$$handgrade{$partID.'_'.$resID}; - my $responsetype = $responseType->{$partID}->{$resID}; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''; - if ($checkboxes) { - if (exists($partsseen{$partID})) { - $result.=""; - } else { - $result.=""; - } - $partsseen{$partID}=1; - } - my $display_part=&get_display_part($partID,$symb); - $result.=''. - ''; -# ''; - } - } - $result.='
 '.&mt('Part: [_1]',$display_part).' '. - $resID.''.&mt('Type: [_1]',$responsetype).'
'.&mt('Handgrade: [_1]',$handgrade).'
'."\n"; - return $result,$responseType,$hdgrade,$partlist,$handgrade; -} +#sub showResourceInfo { +# my ($symb,$probTitle,$checkboxes,$res_error) = @_; +# my $result = '

'.&mt('Current Resource').': '.$probTitle.'

'."\n"; +# my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error); +# if (ref($res_error)) { +# if ($$res_error) { +# return; +# } +# } +# $result.=&Apache::loncommon::start_data_table() +# .&Apache::loncommon::start_data_table_header_row(); +# if ($checkboxes) { +# $result.=' '; +# } +# $result.=''.&mt('Problem Part').'' +# .''.&mt('Res. ID').'' +# .''.&mt('Type').'' +# .&Apache::loncommon::end_data_table_header_row(); +# my %resptype = (); +# my $hdgrade='no'; +# my %partsseen; +# foreach my $partID (sort(keys(%$responseType))) { +# foreach my $resID (sort(keys(%{ $responseType->{$partID} }))) { +# my $handgrade=$$handgrade{$partID.'_'.$resID}; +# my $responsetype = $responseType->{$partID}->{$resID}; +# $hdgrade = $handgrade if ($handgrade eq 'yes'); +# $result.=&Apache::loncommon::start_data_table_row(); +# if ($checkboxes) { +# if (exists($partsseen{$partID})) { +# $result.=" "; +# } else { +# $result.=""; +# } +# $partsseen{$partID}=1; +# } +# my $display_part=&get_display_part($partID,$symb); +# $result.=''.$display_part.'' +# .''.''.$resID.'' +# .''.&mt($responsetype).'' +# .''.&mt('Handgrade: [_1]',$handgrade).'' +# .&Apache::loncommon::end_data_table_row(); +# } +# } +# $result.=&Apache::loncommon::end_data_table(); +# return $result,$responseType,$hdgrade,$partlist,$handgrade; +#} sub reset_caches { &reset_analyze_cache(); @@ -271,45 +270,101 @@ 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)=@_; + 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=&Apache::lonnet::ssi($url, - ('grade_target' => 'analyze'), - ('grade_domain' => $udom), - ('grade_symb' => $symb), - ('grade_courseid' => - $env{'request.course.id'}), - ('grade_username' => $uname)); + 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)=@_; - my $analyze = &get_analyze($symb,$uname,$udom); + 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); - 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 @@ -377,7 +432,7 @@ sub cleanRecord { return '
'. ''.$toprow.''. ''. - $grayFont.$bottomrow.''.'
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; + $bottomrow.''.''; } elsif ($response eq 'essay') { if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', @@ -439,8 +494,7 @@ sub cleanRecord { #-- A couple of common js functions sub commonJSfunctions { my $request = shift; - $request->print(< + $request->print(&Apache::lonhtmlcommon::scripttag(< 1) { @@ -468,7 +522,6 @@ sub commonJSfunctions { return selectOne.value; } } - COMMONJSFUNCTIONS } @@ -623,13 +676,13 @@ sub student_gradeStatus { sub jscriptNform { my ($symb) = @_; my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); - my $jscript=''."\n"; + "\n"); $jscript.= '
'."\n". ''."\n". ''."\n". @@ -686,7 +739,7 @@ sub most_similar { # ignore empty submissions (occuring when only files are sent) - unless ($uessay=~/\w+/) { return ''; } + unless ($uessay=~/\w+/s) { return ''; } # these will be returned. Do not care if not at least 50 percent similar my $limit=0.6; @@ -735,7 +788,7 @@ sub verifyreceipt { my $title.= '

'. - &mt('Verifying Submission Receipt [_1]',$receipt). + &mt('Verifying Receipt No. [_1]',$receipt). '

'."\n". '

'.&mt('Resource: [_1]',$env{'form.probTitle'}). '

'."\n"; @@ -747,7 +800,13 @@ sub verifyreceipt { if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } my $parts=['0']; - if ($receiptparts) { ($parts)=&response_type($symb); } + if ($receiptparts) { + my $res_error; + ($parts)=&response_type($symb,\$res_error); + if ($res_error) { + return &navmap_errormsg(); + } + } my $header = &Apache::loncommon::start_data_table(). @@ -789,11 +848,14 @@ sub verifyreceipt { } } if ($matches == 0) { - $string = $title.&mt('No match found for the above receipt.'); + $string = $title + .'

' + .&mt('No match found for the above receipt number.') + .'

'; } else { $string = &jscriptNform($symb).$title. '

'. - &mt('The above receipt matches the following [numerate,_1,student].',$matches). + &mt('The above receipt number matches the following [quant,_1,student].',$matches). '

'. $header. $contents. @@ -819,20 +881,20 @@ sub listStudents { $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; - my $result='

 '. - &mt($viewgrade.' Submissions for a Student or a Group of Students') + my $result='

 ' + .&mt("$viewgrade Submissions for a Student or a Group of Students") .'

'; - my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); - - my %lt = ( 'multiple' => - "Please select a student or group of students before clicking on the Next button.", - 'single' => - "Please select the student before clicking on the Next button.", - ); - %lt = &Apache::lonlocal::texthash(%lt); - $request->print(< +# my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); + my ($partlist,$handgrade,$responseType) = &response_type($symb +#,$res_error + ); + + my %lt = &Apache::lonlocal::texthash ( + 'multiple' => 'Please select a student or group of students before clicking on the Next button.', + 'single' => 'Please select the student before clicking on the Next button.', + ); + $request->print(&Apache::lonhtmlcommon::scripttag(< LISTJAVASCRIPT &commonJSfunctions($request); @@ -870,20 +931,19 @@ LISTJAVASCRIPT my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked="checked"' : ''; my $checklastsub = $checkhdgrade eq '' ? 'checked="checked"' : ''; my $gradeTable=''. - "\n".$table; + "\n"; - $gradeTable .= - ' '. - &mt('View Problem Text: [_1]', - ''."\n". - ''."\n". - '').'
'."\n"; - $gradeTable .= - ' '. - &mt('View Answer: [_1]', - ''."\n". - ''."\n". - '').'
'."\n"; + $gradeTable .= &Apache::lonhtmlcommon::start_pick_box(); + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) + .''."\n" + .''."\n" + .'
'."\n" + .&Apache::lonhtmlcommon::row_closure(); + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer')) + .''."\n" + .''."\n" + .'
'."\n" + .&Apache::lonhtmlcommon::row_closure(); my $submission_options; if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { @@ -894,25 +954,32 @@ LISTJAVASCRIPT my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status; $env{'form.Status'} = $saveStatus; $submission_options.= - ''."\n". - ''."\n". - ''."\n". - ''; - $gradeTable .= - ' '. - &mt('Submissions: [_1]',$submission_options).'
'."\n"; + ''. + ''."\n". + ''. + ''."\n". + ''. + ''."\n". + ''. + ''; + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Submissions')) + .$submission_options + .&Apache::lonhtmlcommon::row_closure(); + + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Grading Increments')) + .'' + .&Apache::lonhtmlcommon::row_closure(); $gradeTable .= - ' '. - &mt('Grading Increments: [_1]', - ''); - - $gradeTable .= &build_section_inputs(). ''."\n". '
'."\n". @@ -923,23 +990,30 @@ LISTJAVASCRIPT ''."\n"; if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { - $gradeTable.=''."\n"; + $gradeTable .= ''."\n"; } else { - $gradeTable.=&mt('Student Status: [_1]', - &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).'
'; + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Student Status')) + .&Apache::lonhtmlcommon::StatusOptions( + $saveStatus,undef,1,'javascript:reLoadList(this.form);') + .&Apache::lonhtmlcommon::row_closure(); } - $gradeTable.=&mt('To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '. - 'next to the student\'s name(s). Then click on the Next button.').'
'."\n". - ''."\n"; + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism')) + .'' + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box(); + + $gradeTable .= '

' + .&mt('To '.lc($viewgrade)." a submission or a group of submissions, click on the check box(es) next to the student's name(s). Then click on the Next button.")."\n" + .'' + .'

'; # checkall buttons $gradeTable.=&check_script('gradesub', 'stuinfo'); $gradeTable.='
'."\n"; + 'onclick="javascript:checkSelect(this.form.stuinfo);" '."\n". + 'value="'.&mt('Next').' →" />
'."\n"; $gradeTable.=&check_buttons(); - $gradeTable.=''; my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); $gradeTable.= &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(); @@ -1022,14 +1096,14 @@ LISTJAVASCRIPT $gradeTable.= &Apache::loncommon::start_data_table_row(); } $gradeTable.=''.$ctr.' '. - '