# The LearningOnline Network with CAPA # The LON-CAPA Grading handler # # $Id: grades.pm,v 1.487 2007/11/08 20:47:56 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # package Apache::grades; use strict; 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=(); 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: sub get_response_bubbles { my ($parsed_line, $response) = @_; 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++; } return $selected; } # ----- 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); } # 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; } # # --- Retrieve the parts from the metadata file.--- sub getpartlist { my ($symb) = @_; my $navmap = Apache::lonnavmaps::navmap->new(); my $res = $navmap->getBySymb($symb); my $partlist = $res->parts(); my $url = $res->src(); my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys')); my @stores; foreach my $part (@{ $partlist }) { foreach my $key (@metakeys) { if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } } } return @stores; } # --- 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 (); } } &Apache::lonenc::check_decrypt(\$symb); return ($symb); } #--- Format fullname, username:domain if different for display #--- Use anywhere where the student names are listed sub nameUserString { my ($type,$fullname,$uname,$udom) = @_; if ($type eq 'header') { return ' '.&mt('Fullname').' ('.&mt('Username').')'; } else { return ' '.$fullname.' ('.$uname. ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; } } #--- 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 $navmap = Apache::lonnavmaps::navmap->new(); my $res = $navmap->getBySymb($symb); 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 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.= " (id $partID)"; } else { $display=$partID; } return $display; } #--- Show resource title #--- and parts and response type sub showResourceInfo { my ($symb,$probTitle,$checkboxes) = @_; my $col=3; if ($checkboxes) { $col=4; } my $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).' | '; } } $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 ($symb) = &get_symb($request); my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; my $result='