--- loncom/homework/grades.pm 2008/11/18 19:14:28 1.530 +++ loncom/homework/grades.pm 2019/07/07 15:31:52 1.596.2.12.2.48 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.530 2008/11/18 19:14:28 jms Exp $ +# $Id: grades.pm,v 1.596.2.12.2.48 2019/07/07 15:31:52 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,163 +26,7 @@ # http://www.lon-capa.org/ # -=head1 NAME - -Apache::grades - -=head1 SYNOPSIS - -Handles the viewing of grades. - -This is part of the LearningOnline Network with CAPA project -described at http://www.lon-capa.org. - -=head1 OVERVIEW - -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. - - -=head1 HANDLER SUBROUTINE - -ssi_with_retries() - -=head1 SUBROUTINES - -=over - -=item scantron_get_correction() : - - Builds the interface screen to interact with the operator to fix a - specific error condition in a specific scanline - - Arguments: - $r - Apache request object - $i - number of the current scanline - $scan_record - hash ref as returned from &scantron_parse_scanline() - $scan_config - hash ref as returned from &get_scantron_config() - $line - full contents of the current scanline - $error - error condition, valid values are - 'incorrectCODE', 'duplicateCODE', - 'doublebubble', 'missingbubble', - 'duplicateID', 'incorrectID' - $arg - extra information needed - For errors: - - duplicateID - paper number that this studentID was seen before on - - duplicateCODE - array ref of the paper numbers this CODE was - seen on before - - incorrectCODE - current incorrect CODE - - doublebubble - array ref of the bubble lines that have double - bubble errors - - missingbubble - array ref of the bubble lines that have missing - bubble errors - -=item scantron_get_maxbubble() : - - Returns the maximum number of bubble lines that are expected to - occur. Does this by walking the selected sequence rendering the - resource and then checking &Apache::lonxml::get_problem_counter() - for what the current value of the problem counter is. - - Caches the results to $env{'form.scantron_maxbubble'}, - $env{'form.scantron.bubble_lines.n'}, - $env{'form.scantron.first_bubble_line.n'} and - $env{"form.scantron.sub_bubblelines.n"} - 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, matchresponse, and rankresponse items), for response n. - - -=item scantron_validate_missingbubbles() : - - Validates all scanlines in the selected file to not have any - answers that don't have bubbles that have not been verified - to be bubble free. - -=item scantron_process_students() : - - Routine that does the actual grading of the bubble sheet information. - - The parsed scanline hash is added to %env - - Then foreach unskipped scanline it does an &Apache::lonnet::ssi() - foreach resource , with the form data of - - 'submitted' =>'scantron' - 'grade_target' =>'grade', - 'grade_username'=> username of student - 'grade_domain' => domain of student - 'grade_courseid'=> of course - 'grade_symb' => symb of resource to grade - - This triggers a grading pass. The problem grading code takes care - of converting the bubbled letter information (now in %env) into a - valid submission. - -=item scantron_upload_scantron_data() : - - Creates the screen for adding a new bubble sheet data file to a course. - -=item scantron_upload_scantron_data_save() : - - Adds a provided bubble information data file to the course if user - has the correct privileges to do so. - -=item valid_file() : - - Validates that the requested bubble data file exists in the course. - -=item scantron_download_scantron_data() : - - Shows a list of the three internal files (original, corrected, - skipped) for a specific bubble sheet data file that exists in the - course. - -=item scantron_validate_ID() : - - Validates all scanlines in the selected file to not have any - invalid or underspecified student IDs - -=back -=cut package Apache::grades; use strict; @@ -196,9 +40,13 @@ use Apache::lonhomework; use Apache::lonpickcode; use Apache::loncoursedata; use Apache::lonmsg(); -use Apache::Constants qw(:common); +use Apache::Constants qw(:common :http); use Apache::lonlocal; use Apache::lonenc; +use Apache::bridgetask(); +use Apache::lontexconvert(); +use HTML::Parser(); +use File::MMagic; use String::Similarity; use LONCAPA; @@ -207,6 +55,7 @@ use POSIX qw(floor); my %perm=(); +my %old_essays=(); # These variables are used to recover from ssi errors @@ -253,9 +102,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(); @@ -273,13 +128,16 @@ sub getpartlist { # --- Get the symbolic name of a problem and the url 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:."); - return (); - } + my $symb=$env{'form.symb'}; + unless ($symb) { + (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + $symb = &Apache::lonnet::symbread($url); + if ($symb eq '') { + if (!$silent) { + $request->print(&mt("Unable to handle ambiguous references: [_1].",$url)); + return (); + } + } } &Apache::lonenc::check_decrypt(\$symb); return ($symb); @@ -300,10 +158,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')); @@ -339,7 +207,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; } @@ -349,87 +218,178 @@ 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 ($symb,$probTitle,$checkboxes,$res_error) = @_; my $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.='
---|---|---|---|
"; - } 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).' | '; - } + 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.='
'; + $bottomrow.''; } elsif ($response eq 'match') { my %answer=&Apache::lonnet::str2hash($answer); + my @answer = %answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @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); @@ -476,12 +440,12 @@ sub cleanRecord { ''. '
'. ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. - $grayFont.$bottomrow.'
'; + $bottomrow.''; } elsif ($response eq 'essay') { if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', @@ -511,10 +475,11 @@ sub cleanRecord { $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 $result=&mt('Smile representation: [_1]', + '"'.&HTML::Entities::encode($answer, '"<>&').'"'); my $jme=$record->{$version."resource.$partid.$respid.molecule"}; $result.=&Apache::chemresponse::jme_img($jme,$answer,400); return $result; @@ -548,12 +513,14 @@ sub cleanRecord { $result.=''; return $result; } - } elsif ( $response =~ m/(?:numerical|formula)/) { + } elsif ( $response =~ m/(?:numerical|formula|custom)/) { + # Respect multiple input fields, see Bug #5409 $answer = &Apache::loncommon::format_previous_attempt_value('submission', $answer); + return $answer; } - return $answer; + return &HTML::Entities::encode($answer, '"<>&'); } #-- A couple of common js functions @@ -798,7 +765,11 @@ sub compute_points { # sub most_similar { - my ($uname,$udom,$uessay,$old_essays)=@_; + my ($uname,$udom,$symb,$uessay)=@_; + + unless ($symb) { return ''; } + + unless (ref($old_essays{$symb}) eq 'HASH') { return ''; } # ignore spaces and punctuation @@ -806,7 +777,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; @@ -815,11 +786,11 @@ sub most_similar { my $scrsid=''; my $sessay=''; # go through all essays ... - foreach my $tkey (keys(%$old_essays)) { + foreach my $tkey (keys(%{$old_essays{$symb}})) { my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); # ... except the same student next if (($tname eq $uname) && ($tdom eq $udom)); - my $tessay=$old_essays->{$tkey}; + my $tessay=$old_essays{$symb}{$tkey}; $tessay=~s/\W+/ /gs; # String similarity gives up if not even limit my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); @@ -829,7 +800,7 @@ sub most_similar { $sname=$tname; $sdom=$tdom; $scrsid=$tcrsid; - $sessay=$old_essays->{$tkey}; + $sessay=$old_essays{$symb}{$tkey}; } } if ($limit>0.6) { @@ -855,9 +826,9 @@ sub verifyreceipt { my $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. @@ -939,18 +919,17 @@ sub listStudents { $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; - my $result='