--- loncom/homework/grades.pm 2016/10/14 17:33:34 1.596.2.12.2.37
+++ 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.596.2.12.2.37 2016/10/14 17:33:34 raeburn 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
#
@@ -44,6 +44,9 @@ 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;
@@ -354,7 +357,7 @@ sub reset_caches {
}
sub scantron_partids_tograde {
- my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row) = @_;
+ my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row,$scancode) = @_;
my (%analysis,@parts);
if (ref($resource)) {
my $symb = $resource->symb();
@@ -362,6 +365,13 @@ sub reset_caches {
if ($check_for_randomlist) {
$add_to_form = { 'check_parts_withrandomlist' => 1,};
}
+ if ($scancode) {
+ if (ref($add_to_form) eq 'HASH') {
+ $add_to_form->{'code_for_randomlist'} = $scancode;
+ } else {
+ $add_to_form = { 'code_for_randomlist' => $scancode,};
+ }
+ }
my $analyze =
&get_analyze($symb,$uname,$udom,undef,$add_to_form,
undef,undef,undef,$bubbles_per_row);
@@ -465,6 +475,7 @@ 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 = &Apache::lontexconvert::msgtexconverted($answer);
return '
'.&keywords_highlight($answer).'
';
} elsif ( $response eq 'organic') {
my $result=&mt('Smile representation: [_1]',
@@ -2044,6 +2055,7 @@ sub submission {
$env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
my ($symb) = &get_symb($request);
if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
+ my ($essayurl,%coursedesc_by_cid);
if (!&canview($usec)) {
$request->print(
@@ -2181,11 +2193,24 @@ sub submission {
#
# Load the other essays for similarity check
#
- my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);
- my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
- $apath=&escape($apath);
- $apath=~s/\W/\_/gs;
- &init_old_essays($symb,$apath,$adom,$aname);
+ (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb);
+ if ($essayurl eq 'lib/templates/simpleproblem.problem') {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ if ($cdom ne '' && $cnum ne '') {
+ my ($map,$id,$res) = &Apache::lonnet::decode_symb($symb);
+ if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(default(?:|_\d+)\.(?:sequence|page))$}) {
+ my $apath = $1.'_'.$id;
+ $apath=~s/\W/\_/gs;
+ &init_old_essays($symb,$apath,$cdom,$cnum);
+ }
+ }
+ } else {
+ my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
+ $apath=&escape($apath);
+ $apath=~s/\W/\_/gs;
+ &init_old_essays($symb,$apath,$adom,$aname);
+ }
}
}
@@ -2326,27 +2351,52 @@ sub submission {
&most_similar($uname,$udom,$symb,$subval);
if ($osim) {
$osim=int($osim*100.0);
- my %old_course_desc =
- &Apache::lonnet::coursedescription($ocrsid,
- {'one_time' => 1});
-
if ($hide eq 'anon') {
$similar='
'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'
'.
&mt('As the current submission is for an anonymous survey, no other details are available.').'
';
} else {
- $similar="
".
- &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])',
- $osim,
- &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')',
- $old_course_desc{'description'},
- $old_course_desc{'num'},
- $old_course_desc{'domain'}).
- '
'.
- &keywords_highlight($oessay).
- '
';
- }
- }
- }
+ $similar='
';
+ if ($essayurl eq 'lib/templates/simpleproblem.problem') {
+ $similar .= ''.
+ &mt('Essay is [_1]% similar to an essay by [_2]',
+ $osim,
+ &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')').
+ '
';
+ } elsif ($ocrsid ne '') {
+ my %old_course_desc;
+ if (ref($coursedesc_by_cid{$ocrsid}) eq 'HASH') {
+ %old_course_desc = %{$coursedesc_by_cid{$ocrsid}};
+ } else {
+ my $args;
+ if ($ocrsid ne $env{'request.course.id'}) {
+ $args = {'one_time' => 1};
+ }
+ %old_course_desc =
+ &Apache::lonnet::coursedescription($ocrsid,$args);
+ $coursedesc_by_cid{$ocrsid} = \%old_course_desc;
+ }
+ $similar .=
+ &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])',
+ $osim,
+ &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')',
+ $old_course_desc{'description'},
+ $old_course_desc{'num'},
+ $old_course_desc{'domain'}).
+ '';
+ } else {
+ $similar .=
+ ''.
+ &mt('Essay is [_1]% similar to an essay by [_2] in an unknown course',
+ $osim,
+ &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')').
+ '
';
+ }
+ $similar .= ''.
+ &keywords_highlight($oessay).
+ '
';
+ }
+ }
+ }
my $order=&get_order($partid,$respid,$symb,$uname,$udom,
undef,$type,$trial,$rndseed);
if ($env{'form.lastSub'} eq 'lastonly' || $env{'form.lastSub'} eq 'datesub' || $env{'form.lastSub'} =~ /^(last|all)$/ || ($env{'form.lastSub'} eq 'hdgrade' &&
@@ -3756,7 +3806,7 @@ sub viewgrades {
#retrieve selected groups
my (@groups,$group_display);
- @groups = &Apache::loncommon::get_env_multiple(form.group');
+ @groups = &Apache::loncommon::get_env_multiple('form.group');
if (grep(/^all$/,@groups)) {
@groups = ('all');
} elsif (grep(/^none$/,@groups)) {
@@ -3973,7 +4023,7 @@ sub viewgrades {
$result .= &mt('There are no students in section(s) [_1] with enrollment status [_2] to modify or grade.',
$section_display,$stu_status);
} elsif (grep(/^none$/,@groups)) {
- $result .= &mt('There are no students in section(s) [_1] nd no group with enrollment status [_2] to modify or grade.',
+ $result .= &mt('There are no students in section(s) [_1] and no group with enrollment status [_2] to modify or grade.',
$section_display,$stu_status);
} else {
$result .= &mt('There are no students in section(s) [_1] and group(s) [_2] with enrollment status [_3] to modify or grade.',
@@ -4170,6 +4220,7 @@ sub editgrades {
$ctr++;
}
my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
+ my $totcolspan = 0;
foreach my $partid (@partid) {
$header .= ''.&mt('Old Score').' | '.
''.&mt('New Score').' | ';
@@ -4186,6 +4237,7 @@ sub editgrades {
''.&mt('New').' '.$display.' | ';
$columns{$partid}+=2;
}
+ $totcolspan += $columns{$partid};
}
foreach my $partid (@partid) {
my $display_part=&get_display_part($partid,$symb);
@@ -4201,20 +4253,20 @@ sub editgrades {
my @noupdate;
my ($updateCtr,$noupdateCtr) = (1,1);
for ($i=0; $i<$env{'form.total'}; $i++) {
- my $line;
my $user = $env{'form.ctr'.$i};
my ($uname,$udom)=split(/:/,$user);
my %newrecord;
my $updateflag = 0;
- $line .= ''.&nameUserString(undef,$$fullname{$user},$uname,$udom).' | ';
- my $usec=$classlist->{"$uname:$udom"}[5];
- if (!&canmodify($usec)) {
- my $numcols=scalar(@partid)*4+2;
- push(@noupdate,
- $line."".
- &mt('Not allowed to modify student')." | ");
- next;
- }
+ my $usec=$classlist->{"$uname:$udom"}[5];
+ my $canmodify = &canmodify($usec);
+ my $line = ''.
+ &nameUserString(undef,$$fullname{$user},$uname,$udom).' | ';
+ if (!$canmodify) {
+ push(@noupdate,
+ $line."".
+ &mt('Not allowed to modify student')." | ");
+ next;
+ }
my %aggregate = ();
my $aggregateflag = 0;
$user=~s/:/_/; # colon doen't work in javascript for names
@@ -4329,8 +4381,7 @@ sub editgrades {
}
}
if (@noupdate) {
-# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
- my $numcols=scalar(@partid)*4+2;
+ my $numcols=$totcolspan+2;
$result .= &Apache::loncommon::start_data_table_row('LC_empty_row').
''.
&mt('No Changes Occurred For the Students Below').
@@ -4598,8 +4649,10 @@ sub csvuploadmap {
if (!$env{'form.datatoken'}) {
$datatoken=&Apache::loncommon::upfile_store($request);
} else {
- $datatoken=$env{'form.datatoken'};
- &Apache::loncommon::load_tmp_file($request);
+ $datatoken=&Apache::loncommon::valid_datatoken($env{'form.datatoken'});
+ if ($datatoken ne '') {
+ &Apache::loncommon::load_tmp_file($request,$datatoken);
+ }
}
my @records=&Apache::loncommon::upfile_record_sep();
if ($env{'form.noFirstLine'}) { shift(@records); }
@@ -4703,7 +4756,10 @@ sub csvuploadassign {
my ($symb)=&get_symb($request);
if (!$symb) {return '';}
my $error_msg = '';
- &Apache::loncommon::load_tmp_file($request);
+ my $datatoken = &Apache::loncommon::valid_datatoken($env{'form.datatoken'});
+ if ($datatoken ne '') {
+ &Apache::loncommon::load_tmp_file($request,$datatoken);
+ }
my @gradedata = &Apache::loncommon::upfile_record_sep();
if ($env{'form.noFirstLine'}) { shift(@gradedata); }
my %fields=&get_fields();
@@ -4856,6 +4912,7 @@ LISTJAVASCRIPT
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 $result=' '.
&mt('Manual Grading by Page or Sequence').'';
@@ -4926,7 +4983,7 @@ LISTJAVASCRIPT
' | '.&nameUserString('header').' | '.
&Apache::loncommon::end_data_table_header_row();
- my (undef,undef,$fullname) = &getclasslist($getsec,'1');
+ my (undef,undef,$fullname) = &getclasslist($getsec,'1',$getgroup);
my $ptr = 1;
foreach my $student (sort
{
@@ -8783,9 +8840,14 @@ SCANTRONFORM
}
if ((exists($grader_randomlists_by_symb{$ressymb})) ||
(ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
+ my $currcode;
+ if (exists($grader_randomlists_by_symb{$ressymb})) {
+ $currcode = $scancode;
+ }
my ($analysis,$parts) =
&scantron_partids_tograde($resource,$env{'request.course.id'},
- $uname,$udom,undef,$bubbles_per_row);
+ $uname,$udom,undef,$bubbles_per_row,
+ $currcode);
$partids_by_symb{$ressymb} = $parts;
} else {
$partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb};
@@ -9455,10 +9517,14 @@ sub checkscantron_results {
my $ressymb = $resource->symb();
if ((exists($grader_randomlists_by_symb{$ressymb})) ||
(ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) {
+ my $currcode;
+ if (exists($grader_randomlists_by_symb{$ressymb})) {
+ $currcode = $scancode;
+ }
(my $analysis,$parts) =
&scantron_partids_tograde($resource,$env{'request.course.id'},
$username,$domain,undef,
- $bubbles_per_row);
+ $bubbles_per_row,$currcode);
} else {
$parts = $grader_partids_by_symb{$ressymb};
}
@@ -10008,7 +10074,8 @@ sub substatus_options {
'queued' => 'in grading queue',
'graded' => 'with ungraded submissions',
'incorrect' => 'with incorrect submissions',
- 'all' => 'with any status');
+ 'all' => 'with any status',
+ );
}
sub reset_perm {
@@ -10283,7 +10350,7 @@ sub process_clicker_file {
$result .=
&Apache::lonhtmlcommon::confirm_success(
&mt('No IDs found to determine correct answer'),1);
- return $result,.&show_grading_menu_form($symb);
+ return $result.&show_grading_menu_form($symb);
}
}
if (length($env{'form.upfile'}) < 2) {
@@ -10293,6 +10360,22 @@ sub process_clicker_file {
''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''),1);
return $result.&show_grading_menu_form($symb);
}
+ my $mimetype;
+ if ($env{'form.upfiletype'} eq 'iclicker') {
+ my $mm = new File::MMagic;
+ $mimetype = $mm->checktype_contents($env{'form.upfile'});
+ unless (($mimetype eq 'text/plain') || ($mimetype eq 'text/html')) {
+ $result.= ''.
+ &Apache::lonhtmlcommon::confirm_success(
+ &mt('File format is neither csv (iclicker 6) nor xml (iclicker 7)'),1).'
';
+ return $result.&show_grading_menu_form($symb);
+ }
+ } elsif (($env{'form.upfiletype'} ne 'interwrite') && ($env{'form.upfiletype'} ne 'turning')) {
+ $result .= ''.
+ &Apache::lonhtmlcommon::confirm_success(
+ &mt('Invalid clicker type: choose one of: i>clicker, Interwrite PRS, or Turning Technologies.'),1).'
';
+ return $result.&show_grading_menu_form($symb);
+ }
# Were able to get all the info needed, now analyze the file
@@ -10320,12 +10403,14 @@ ENDHEADER
my $errormsg='';
my $number=0;
if ($env{'form.upfiletype'} eq 'iclicker') {
- ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
- }
- if ($env{'form.upfiletype'} eq 'interwrite') {
+ if ($mimetype eq 'text/plain') {
+ ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
+ } elsif ($mimetype eq 'text/html') {
+ ($errormsg,$number)=&iclickerxml_eval(\@questiontitles,\%responses);
+ }
+ } elsif ($env{'form.upfiletype'} eq 'interwrite') {
($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
- }
- if ($env{'form.upfiletype'} eq 'turning') {
+ } elsif ($env{'form.upfiletype'} eq 'turning') {
($errormsg,$number)=&turning_eval(\@questiontitles,\%responses);
}
$result.='
'.&mt('Found [_1] question(s)',$number).'
'.
@@ -10427,6 +10512,49 @@ sub iclicker_eval {
}
return ($errormsg,$number);
}
+
+sub iclickerxml_eval {
+ my ($questiontitles,$responses)=@_;
+ my $number=0;
+ my $errormsg='';
+ my @state;
+ my %respbyid;
+ my $p = HTML::Parser->new
+ (
+ xml_mode => 1,
+ start_h =>
+ [sub {
+ my ($tagname,$attr) = @_;
+ push(@state,$tagname);
+ if ("@state" eq "ssn p") {
+ my $title = $attr->{qn};
+ $title =~ s/(^\s+|\s+$)//g;
+ $questiontitles->[$number]=$title;
+ } elsif ("@state" eq "ssn p v") {
+ my $id = $attr->{id};
+ my $entry = $attr->{ans};
+ $id=~s/^[\#0]+//;
+ $entry =~s/[^a-zA-Z0-9\.\*\-\+]+//g;
+ $respbyid{$id}[$number] = $entry;
+ }
+ }, "tagname, attr"],
+ end_h =>
+ [sub {
+ my ($tagname) = @_;
+ if ("@state" eq "ssn p") {
+ $number++;
+ }
+ pop(@state);
+ }, "tagname"],
+ );
+
+ $p->parse($env{'form.upfile'});
+ $p->eof;
+ foreach my $id (keys(%respbyid)) {
+ $responses->{$id}=join(',',@{$respbyid{$id}});
+ }
+ return ($errormsg,$number);
+}
sub interwrite_eval {
my ($questiontitles,$responses)=@_;