--- loncom/homework/grades.pm 2010/04/12 12:55:18 1.611
+++ loncom/homework/grades.pm 2020/11/08 22:23:52 1.777
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.611 2010/04/12 12:55:18 www Exp $
+# $Id: grades.pm,v 1.777 2020/11/08 22:23:52 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -40,10 +40,16 @@ 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::lonstathelpers;
+use Apache::lonquickgrades;
+use Apache::bridgetask();
+use Apache::lontexconvert();
use String::Similarity;
+use HTML::Parser();
+use File::MMagic;
use LONCAPA;
use POSIX qw(floor);
@@ -51,6 +57,7 @@ use POSIX qw(floor);
my %perm=();
+my %old_essays=();
# These variables are used to recover from ssi errors
@@ -112,7 +119,11 @@ sub getpartlist {
my $res = $navmap->getBySymb($symb);
my $partlist = $res->parts();
my $url = $res->src();
- my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys'));
+ my $toolsymb;
+ if ($url =~ /ext\.tool$/) {
+ $toolsymb = $symb;
+ }
+ my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys',$toolsymb));
my @stores;
foreach my $part (@{ $partlist }) {
@@ -136,7 +147,8 @@ sub nameUserString {
}
#--- Get the partlist and the response type for a given problem. ---
-#--- Indicate if a response type is coded handgraded or not. ---
+#--- Count responseIDs, essayresponse items, and dropbox items ---
+#--- Sets response_error pointer to "1" if navmaps object broken ---
sub response_type {
my ($symb,$response_error) = @_;
@@ -153,6 +165,7 @@ sub response_type {
return;
}
my $partlist = $res->parts();
+ my ($numresp,$numessay,$numdropbox) = (0,0,0);
my %vPart =
map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart'));
my (%response_types,%handgrade);
@@ -162,13 +175,20 @@ sub response_type {
my @types = $res->responseType($part);
my @ids = $res->responseIds($part);
for (my $i=0; $i < scalar(@ids); $i++) {
+ $numresp ++;
$response_types{$part}{$ids[$i]} = $types[$i];
+ if ($types[$i] eq 'essay') {
+ $numessay ++;
+ if (&Apache::lonnet::EXT("resource.$part".'_'.$ids[$i].".uploadedfiletypes",$symb)) {
+ $numdropbox ++;
+ }
+ }
$handgrade{$part.'_'.$ids[$i]} =
&Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i].
'.handgrade',$symb);
}
}
- return ($partlist,\%handgrade,\%response_types);
+ return ($partlist,\%handgrade,\%response_types,$numresp,$numessay,$numdropbox);
}
sub flatten_responseType {
@@ -195,9 +215,133 @@ sub get_display_part {
return $display;
}
+#--- Show parts and response type
+sub showResourceInfo {
+ my ($symb,$partlist,$responseType,$formname,$checkboxes,$uploads) = @_;
+ unless ((ref($partlist) eq 'ARRAY') && (ref($responseType) eq 'HASH')) {
+ return '
';
+ }
+ my $coltitle = &mt('Problem Part Shown');
+ if ($checkboxes) {
+ $coltitle = &mt('Problem Part');
+ } else {
+ my $checkedparts = 0;
+ foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
+ if (grep(/^\Q$partid\E$/,@{$partlist})) {
+ $checkedparts ++;
+ }
+ }
+ if ($checkedparts == scalar(@{$partlist})) {
+ return '
';
+ }
+ if ($uploads) {
+ $coltitle = &mt('Problem Part Selected');
+ }
+ }
+ my $result = '
'. + &mt('No dropbox items or essayresponse items with uploadedfiletypes set.'). + '
'; + } else { + return ''; + $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); @@ -343,12 +514,14 @@ 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', @@ -378,10 +551,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').' '. - $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; @@ -415,12 +589,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 @@ -460,7 +636,7 @@ COMMONJSFUNCTIONS #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$filterlist,$getgroup) = @_; + my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus) = @_; my @getsec; my @getgroup; my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); @@ -488,6 +664,13 @@ sub getclasslist { # my %sections; my %fullnames; + my ($cdom,$cnum,$partlist); + if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { + $cdom = $env{"course.$env{'request.course.id'}.domain"}; + $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $res_error; + ($partlist) = &response_type($symb,\$res_error); + } foreach my $student (keys(%$classlist)) { my $end = $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; @@ -504,7 +687,7 @@ sub getclasslist { my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; # filter students according to status selected - if ($filterlist && (!($stu_status =~ /Any/))) { + if ($filterbyaccstatus && (!($stu_status =~ /Any/))) { if (!($stu_status =~ $status)) { delete($classlist->{$student}); next; @@ -521,13 +704,58 @@ sub getclasslist { } } if (($grp eq 'none') && !$group) { - $exclude = 0; + $exclude = 0; } } if ($exclude) { delete($classlist->{$student}); + next; } } + if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { + my $udom = + $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()]; + my $uname = + $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()]; + if (($symb ne '') && ($udom ne '') && ($uname ne '')) { + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + if (!defined($queue_status{'gradingqueue'})) { + delete($classlist->{$student}); + next; + } + } else { + my (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); + my $submitted = 0; + my $graded = 0; + my $incorrect = 0; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); + + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } + } + if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$graded && ($submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$incorrect && $submitonly eq 'incorrect') { + delete($classlist->{$student}); + next; + } + } + } + } $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { @@ -542,7 +770,6 @@ sub getclasslist { delete($classlist->{$student}); } } - my %seen = (); my @sections = sort(keys(%sections)); return ($classlist,\@sections,\%fullnames); } @@ -558,7 +785,7 @@ sub canmodify { #can modify the requested section return 1; } else { - # can't modify the request section + # can't modify the requested section return 0; } } @@ -571,19 +798,19 @@ sub canview { my ($sec)=@_; if ($perm{'vgr'}) { if (!defined($perm{'vgr_section'})) { - # can modify whole class + # can view whole class return 1; } else { if ($sec eq $perm{'vgr_section'}) { - #can modify the requested section + #can view the requested section return 1; } else { - # can't modify the request section + # can't view the requested section return 0; } } } - #can't modify + #can't view return 0; } @@ -617,7 +844,6 @@ sub jscriptNform { "\n"); $jscript.= ''."\n". ''. ''."\n". + $optiontext{'last'}.' '."\n". ''. - ''."\n". + ''."\n". ''. ''; - $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Submissions')) + $optiontext{'all'}.''; + my $viewtitle; + if ($is_tool) { + $viewtitle = &mt('View Transactions'); + } else { + $viewtitle = &mt('View Submissions'); + } + my ($compmsg,$nocompmsg); + $nocompmsg = ' checked="checked"'; + if ($numessay) { + $compmsg = $nocompmsg; + $nocompmsg = ''; + } + $gradeTable .= &Apache::lonhtmlcommon::row_title($viewtitle) .$submission_options + .&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Send Messages')) + .'' + .'' + .'' .&Apache::lonhtmlcommon::row_closure(); $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Grading Increments')) @@ -912,34 +1182,35 @@ LISTJAVASCRIPT .'' .'' .'' - .'' - .&Apache::lonhtmlcommon::row_closure(); - + .''; $gradeTable .= &build_section_inputs(). ''."\n". - '
' - .&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" + .$regrademsg."\n" .'' .'
'; @@ -956,9 +1227,7 @@ LISTJAVASCRIPT while ($loop < 2) { $gradeTable.='');
- pDoc.write('
|