--- loncom/homework/grades.pm 2020/11/08 22:23:52 1.777
+++ loncom/homework/grades.pm 2025/06/28 14:35:00 1.811
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.777 2020/11/08 22:23:52 raeburn Exp $
+# $Id: grades.pm,v 1.811 2025/06/28 14:35:00 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -47,10 +47,12 @@ use Apache::lonstathelpers;
use Apache::lonquickgrades;
use Apache::bridgetask();
use Apache::lontexconvert();
+use Apache::loncourserespicker;
use String::Similarity;
use HTML::Parser();
use File::MMagic;
use LONCAPA;
+use LONCAPA::ltiutils();
use POSIX qw(floor);
@@ -65,7 +67,7 @@ my $ssi_retries = 5;
my $ssi_error;
my $ssi_error_resource;
my $ssi_error_message;
-
+my $registered_cleanup;
sub ssi_with_retries {
my ($resource, $retries, %form) = @_;
@@ -636,7 +638,7 @@ COMMONJSFUNCTIONS
#--- Dumps the class list with usernames,list of sections,
#--- section, ids and fullnames for each user.
sub getclasslist {
- my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus) = @_;
+ my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus,$filterbypbid,$possibles) = @_;
my @getsec;
my @getgroup;
my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
@@ -664,12 +666,16 @@ sub getclasslist {
#
my %sections;
my %fullnames;
+ my %passback;
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);
+ } elsif ($filterbypbid) {
+ $cdom = $env{"course.$env{'request.course.id'}.domain"};
+ $cnum = $env{"course.$env{'request.course.id'}.num"};
}
foreach my $student (keys(%$classlist)) {
my $end =
@@ -756,6 +762,27 @@ sub getclasslist {
}
}
}
+ if ($filterbypbid) {
+ if (ref($possibles) eq 'HASH') {
+ unless (exists($possibles->{$student})) {
+ delete($classlist->{$student});
+ next;
+ }
+ }
+ my $udom =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()];
+ my $uname =
+ $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()];
+ if (($udom ne '') && ($uname ne '')) {
+ my %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',[$filterbypbid],$udom,$uname);
+ if (ref($pbinfo{$filterbypbid}) eq 'ARRAY') {
+ $passback{$student} = $pbinfo{$filterbypbid};
+ } else {
+ delete($classlist->{$student});
+ next;
+ }
+ }
+ }
$section = ($section ne '' ? $section : 'none');
if (&canview($section)) {
if (!@getsec || grep(/^\Q$section\E$/,@getsec)) {
@@ -771,7 +798,7 @@ sub getclasslist {
}
}
my @sections = sort(keys(%sections));
- return ($classlist,\@sections,\%fullnames);
+ return ($classlist,\@sections,\%fullnames,\%passback);
}
sub canmodify {
@@ -854,14 +881,20 @@ sub jscriptNform {
-# Given the score (as a number [0-1] and the weight) what is the final
-# point value? This function will round to the nearest tenth, third,
-# or quarter if one of those is within the tolerance of .00001.
+# Given the score (as a number [0-1], the weight, and a posible
+# reduction for submission between duedate and overduedate)
+# what is the final point value? This function will round to
+# the nearest tenth, third, or quarter if one of those is
+# within the tolerance of .00001.
sub compute_points {
- my ($score, $weight) = @_;
+ my ($score, $weight, $latefrac) = @_;
my $tolerance = .00001;
my $points = $score * $weight;
+ if (($latefrac ne '') &&
+ ($latefrac < 1) && ($latefrac >= 0)) {
+ $points = $points * $latefrac;
+ }
# Check for nearness to 1/x.
my $check_for_nearness = sub {
@@ -1034,6 +1067,877 @@ sub verifyreceipt {
return $string;
}
+#-------------------------------------------------------------------
+
+#------------------------------------------- Grade Passback Routines
+#
+
+sub initialpassback {
+ my ($request,$symb) = @_;
+ my $cdom = $env{"course.$env{'request.course.id'}.domain"};
+ my $cnum = $env{"course.$env{'request.course.id'}.num"};
+ my $crstype = &Apache::loncommon::course_type();
+ my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum);
+ my $readonly;
+ unless ($perm{'mgr'}) {
+ $readonly = 1;
+ }
+ my $formname = 'initialpassback';
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my $output;
+ if (!defined($navmap)) {
+ if ($crstype eq 'Community') {
+ $output = &mt('Unable to retrieve information about community contents');
+ } else {
+ $output = &mt('Unable to retrieve information about course contents');
+ }
+ return '
'.$output.'
';
+ }
+ return &Apache::loncourserespicker::create_picker($navmap,'passback',$formname,$crstype,undef,
+ undef,undef,undef,undef,undef,undef,
+ \%passback,$readonly);
+}
+
+sub passback_filters {
+ my ($request,$symb) = @_;
+ my $cdom = $env{"course.$env{'request.course.id'}.domain"};
+ my $cnum = $env{"course.$env{'request.course.id'}.num"};
+ my $crstype = &Apache::loncommon::course_type();
+ my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen);
+ if ($env{'form.passback'} ne '') {
+ $chosen = &unescape($env{'form.passback'});
+ ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
+ ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen);
+ }
+ my $result;
+ if ($launcher ne '') {
+ $result = &launcher_info_box($launcher,$appname,$setter,$linkuri,$scope).
+ '
'.&mt('Set criteria to use to list students for possible passback of scores, then push Next [_1]',
+ '→').
+ '
';
+ }
+ $result .= ''."\n";
+ return $result;
+}
+
+sub names_for_passback {
+ my ($request,$symb) = @_;
+ my $cdom = $env{"course.$env{'request.course.id'}.domain"};
+ my $cnum = $env{"course.$env{'request.course.id'}.num"};
+ my $crstype = &Apache::loncommon::course_type();
+ my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen);
+ if ($env{'form.passback'} ne '') {
+ $chosen = &unescape($env{'form.passback'});
+ ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
+ ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen);
+ }
+ my ($result,$ctr,$newcommand,$submittext);
+ if ($launcher ne '') {
+ $result = &launcher_info_box($launcher,$appname,$setter,$linkuri,$scope);
+ }
+ $ctr = 0;
+ my @statuses = &Apache::loncommon::get_env_multiple('form.Status');
+ my $stu_status = join(':',@statuses);
+ $result .= ''."\n";
+ return $result;
+}
+
+sub do_passback {
+ my ($request,$symb) = @_;
+ my $cdom = $env{"course.$env{'request.course.id'}.domain"};
+ my $cnum = $env{"course.$env{'request.course.id'}.num"};
+ my $crstype = &Apache::loncommon::course_type();
+ my ($launchsymb,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen);
+ if ($env{'form.passback'} ne '') {
+ $chosen = &unescape($env{'form.passback'});
+ ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
+ ($launchsymb,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen);
+ }
+ if ($launchsymb ne '') {
+ $request->print(&launcher_info_box($launchsymb,$appname,$setter,$linkuri,$scope));
+ }
+ my $error;
+ if ($perm{'mgr'}) {
+ if ($launchsymb ne '') {
+ my @poss_students = &Apache::loncommon::get_env_multiple('form.stuinfo');
+ if (@poss_students) {
+ my %possibles;
+ foreach my $item (@poss_students) {
+ my ($stuname,$studom) = split(/:/,$item,3);
+ $possibles{$stuname.':'.$studom} = 1;
+ }
+ my ($sections,$groups,$group_display,$disabled) = §ions_and_groups();
+ my ($classlist,undef,$fullname,$pbinfo) =
+ &getclasslist($sections,'1',$groups,'','','',$chosen,\%possibles);
+ if ((ref($classlist) eq 'HASH') && (ref($pbinfo) eq 'HASH')) {
+ my %passback = %{$pbinfo};
+ my (%tosend,%remotenotok,%scorenotok,%zeroposs,%nopbinfo);
+ foreach my $possible (keys(%possibles)) {
+ if ((exists($classlist->{$possible})) &&
+ (exists($passback{$possible})) && (ref($passback{$possible}) eq 'ARRAY')) {
+ $tosend{$possible} = 1;
+ }
+ }
+ if (keys(%tosend)) {
+ my ($lti_in_use,$crsdef);
+ my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/);
+ if ($ltitype eq 'c') {
+ my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
+ $lti_in_use = $crslti{$ltinum};
+ $crsdef = 1;
+ } else {
+ my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
+ $lti_in_use = $domlti{$ltinum};
+ }
+ if (ref($lti_in_use) eq 'HASH') {
+ my $msgformat = $lti_in_use->{'passbackformat'};
+ my $keynum = $lti_in_use->{'cipher'};
+ my $scoretype = 'decimal';
+ if ($lti_in_use->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) {
+ $scoretype = $1;
+ }
+ my $pbmap;
+ if ($launchsymb =~ /\.(page|sequence)$/) {
+ $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($launchsymb))[2]);
+ } else {
+ $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($launchsymb))[0]);
+ }
+ $pbmap = &Apache::lonnet::clutter($pbmap);
+ my $pbscope;
+ if ($scope eq 'res') {
+ $pbscope = 'resource';
+ } elsif ($scope eq 'map') {
+ $pbscope = 'nonrec';
+ } elsif ($scope eq 'rec') {
+ $pbscope = 'map';
+ }
+ my %pb = &common_passback_info();
+ my $numstudents = scalar(keys(%tosend));
+ my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($request,$numstudents);
+ my $outcome = &Apache::loncommon::start_data_table().
+ &Apache::loncommon::start_data_table_header_row();
+ my $loop = 0;
+ while ($loop < 2) {
+ $outcome .= '
');
+ }
+ if ($noconfirm) {
+ $request->print(' '.&mt('Score receipt not confirmed by receiving CMS').':'.
+ '
'.$noconfirm.'
');
+ }
+ if ($noscore) {
+ $request->print(' '.&mt('Score computation or transmission failed').':'.
+ '
'.$noscore.'
');
+ }
+ $request->print('');
+ }
+ } else {
+ $error = &mt('Settings for deep-link launch target unavailable, so no scores were sent');
+ }
+ } else {
+ $error = &mt('No available students for whom scores can be sent.');
+ }
+ } else {
+ $error = &mt('Classlist could not be retrieved so no scores were sent.');
+ }
+ } else {
+ $error = &mt('No students selected to receive scores so none were sent.');
+ }
+ } else {
+ if ($env{'form.passback'}) {
+ $error = &mt('Deep-link launch target was invalid so no scores were sent.');
+ } else {
+ $error = &mt('Deep-link launch target was missing so no scores were sent.');
+ }
+ }
+ } else {
+ $error = &mt('You do not have permission to manage grades, so no scores were sent');
+ }
+ if ($error) {
+ $request->print('
'.$error.'
');
+ }
+ return;
+}
+
+sub get_passback_launcher {
+ my ($cdom,$cnum,$chosen) = @_;
+ my ($linkuri,$linkprotector,$scope) = split("\0",$chosen);
+ my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/);
+ my ($appname,$setter);
+ if ($ltitype eq 'c') {
+ my %lti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
+ if (ref($lti{$ltinum}) eq 'HASH') {
+ $appname = $lti{$ltinum}{'name'};
+ if ($appname) {
+ $setter = ' (defined in course)';
+ }
+ }
+ } elsif ($ltitype eq 'd') {
+ my %lti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
+ if (ref($lti{$ltinum}) eq 'HASH') {
+ $appname = $lti{$ltinum}{'name'};
+ if ($appname) {
+ $setter = ' (defined in domain)';
+ }
+ }
+ }
+ my $launchsymb = &Apache::loncommon::symb_from_tinyurl($linkuri,$cnum,$cdom);
+ if ($launchsymb eq '') {
+ my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum);
+ foreach my $poss_symb (keys(%passback)) {
+ if (ref($passback{$poss_symb}) eq 'HASH') {
+ if (exists($passback{$poss_symb}{$chosen})) {
+ $launchsymb = $poss_symb;
+ last;
+ }
+ }
+ }
+ if ($launchsymb ne '') {
+ return ($launchsymb,$appname,$setter);
+ }
+ } else {
+ my %passback = &Apache::lonnet::get('nohist_linkprot_passback',[$launchsymb],$cdom,$cnum);
+ if (ref($passback{$launchsymb}) eq 'HASH') {
+ if (exists($passback{$launchsymb}{$chosen})) {
+ return ($launchsymb,$appname,$setter);
+ }
+ }
+ }
+ return ();
+}
+
+sub sections_and_groups {
+ my (@sections,@groups,$group_display);
+ @groups = &Apache::loncommon::get_env_multiple('form.group');
+ if (grep(/^all$/,@groups)) {
+ @groups = ('all');
+ $group_display = 'all';
+ } elsif (grep(/^none$/,@groups)) {
+ @groups = ('none');
+ $group_display = 'none';
+ } elsif (@groups > 0) {
+ $group_display = join(', ',@groups);
+ }
+ if ($env{'request.course.sec'} ne '') {
+ @sections = ($env{'request.course.sec'});
+ } else {
+ @sections = &Apache::loncommon::get_env_multiple('form.section');
+ }
+ my $disabled = ' disabled="disabled"';
+ if ($perm{'mgr'}) {
+ if (grep(/^all$/,@sections)) {
+ undef($disabled);
+ } else {
+ foreach my $sec (@sections) {
+ if (&canmodify($sec)) {
+ undef($disabled);
+ last;
+ }
+ }
+ }
+ }
+ if (grep(/^all$/,@sections)) {
+ @sections = ('all');
+ }
+ return(\@sections,\@groups,$group_display,$disabled);
+}
+
+sub launcher_info_box {
+ my ($launcher,$appname,$setter,$linkuri,$scope) = @_;
+ my $shownscope;
+ if ($scope eq 'res') {
+ $shownscope = &mt('Resource');
+ } elsif ($scope eq 'map') {
+ $shownscope = &mt('Folder');
+ } elsif ($scope eq 'rec') {
+ $shownscope = &mt('Folder + sub-folders');
+ }
+ return '
';
- next;
- }
- foreach my $submission (@$string) {
- my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
- if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }
- my ($ressub,$hide,$draft,$subval) = split(/:/,$submission,4);
- # Similarity check
- my $similar='';
- my ($type,$trial,$rndseed);
- if ($hide eq 'rand') {
- $type = 'randomizetry';
- $trial = $record{"resource.$partid.tries"};
- $rndseed = $record{"resource.$partid.rndseed"};
- }
- if ($env{'form.checkPlag'}) {
- my ($oname,$odom,$ocrsid,$oessay,$osim)=
- &most_similar($uname,$udom,$symb,$subval);
- if ($osim) {
- $osim=int($osim*100.0);
- 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='';
- 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.')').
- '
';
- } else {
- my %old_course_desc;
- if ($ocrsid ne '') {
- 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.')').
- '
';
+ next;
+ }
+ foreach my $submission (@$string) {
+ my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/);
+ if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; }
+ my ($ressub,$hide,$draft,$subval) = split(/:/,$submission,4);
+ # Similarity check
+ my $similar='';
+ my ($type,$trial,$rndseed);
+ if ($hide eq 'rand') {
+ $type = 'randomizetry';
+ $trial = $record->{"resource.$partid.tries"};
+ $rndseed = $record->{"resource.$partid.rndseed"};
+ }
+ if ($env{'form.checkPlag'}) {
+ my ($oname,$odom,$ocrsid,$oessay,$osim)=
+ &most_similar($uname,$udom,$symb,$subval);
+ if ($osim) {
+ $osim=int($osim*100.0);
+ 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='';
+ 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.')').
+ '
';
+ } else {
+ my %old_course_desc;
+ if ($ocrsid ne '') {
+ 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.')').
+ '