--- loncom/homework/grades.pm 2025/01/18 21:29:42 1.596.2.12.2.60.2.9
+++ loncom/homework/grades.pm 2019/02/06 05:46:51 1.758
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.596.2.12.2.60.2.9 2025/01/18 21:29:42 raeburn Exp $
+# $Id: grades.pm,v 1.758 2019/02/06 05:46:51 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -44,14 +44,11 @@ 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 Apache::loncourserespicker;
use String::Similarity;
-use HTML::Parser();
-use File::MMagic;
use LONCAPA;
-use LONCAPA::ltiutils();
use POSIX qw(floor);
@@ -66,7 +63,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) = @_;
@@ -149,7 +146,6 @@ 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) = @_;
@@ -167,7 +163,6 @@ 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);
@@ -177,20 +172,13 @@ 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,$numresp,$numessay,$numdropbox);
+ return ($partlist,\%handgrade,\%response_types);
}
sub flatten_responseType {
@@ -217,129 +205,6 @@ 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 ''.&keywords_highlight($answer).''; + } elsif ( $response eq 'organic') { my $result=&mt('Smile representation: [_1]', '"'.&HTML::Entities::encode($answer, '"<>&').'"'); @@ -638,7 +504,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,$filterbypbid,$possibles) = @_; + my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus) = @_; my @getsec; my @getgroup; my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); @@ -666,16 +532,12 @@ 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"}; + ($partlist,my $handgrade,my $responseType) = &response_type($symb,\$res_error); } foreach my $student (keys(%$classlist)) { my $end = @@ -762,27 +624,6 @@ 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)) { @@ -798,7 +639,7 @@ sub getclasslist { } } my @sections = sort(keys(%sections)); - return ($classlist,\@sections,\%fullnames,\%passback); + return ($classlist,\@sections,\%fullnames); } sub canmodify { @@ -812,7 +653,7 @@ sub canmodify { #can modify the requested section return 1; } else { - # can't modify the requested section + # can't modify the request section return 0; } } @@ -825,19 +666,19 @@ sub canview { my ($sec)=@_; if ($perm{'vgr'}) { if (!defined($perm{'vgr_section'})) { - # can view whole class + # can modify whole class return 1; } else { if ($sec eq $perm{'vgr_section'}) { - #can view the requested section + #can modify the requested section return 1; } else { - # can't view the requested section + # can't modify the request section return 0; } } } - #can't view + #can't modify return 0; } @@ -978,14 +819,14 @@ sub initialverifyreceipt { #--- Check whether a receipt number is valid.--- sub verifyreceipt { - my ($request,$symb) = @_; + my ($request,$symb) = @_; my $courseid = $env{'request.course.id'}; my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $title = + my $title.= '
'.$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]',
- '→').
- '
'.&mt('Scores sent to launcher CMS').'
'.$outcome.'
'); - } else { - $request->print(''.&mt('No scores sent to launcher CMS').'
'); - } - if (keys(%tosend)) { - $request->print(''.&mt('No scores sent for following')); - my ($zeros,$nopbcreds,$noconfirm,$noscore); - foreach my $student (sort - { - if (lc($$fullname{$a}) ne lc($$fullname{$b})) { - return (lc($$fullname{$a}) cmp lc($$fullname{$b})); - } - return $a cmp $b; - } (keys(%$fullname))) { - next unless ($tosend{$student}); - my ($uname,$udom) = split(/:/,$student); - my $line = '
'.$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 ''. - &Apache::lonhtmlcommon::start_pick_box(). - &Apache::lonhtmlcommon::row_title(&mt('Launch Item Title')). - &Apache::lonnet::gettitle($launcher). - &Apache::lonhtmlcommon::row_closure(). - &Apache::lonhtmlcommon::row_title(&mt('Deep-link')). - $linkuri. - &Apache::lonhtmlcommon::row_closure(). - &Apache::lonhtmlcommon::row_title(&mt('Launcher')). - $appname.' '.$setter. - &Apache::lonhtmlcommon::row_closure(). - &Apache::lonhtmlcommon::row_title(&mt('Score Type')). - $shownscope. - &Apache::lonhtmlcommon::row_closure(1). - &Apache::lonhtmlcommon::end_pick_box().'
'."\n"; -} - -sub passbacks_for_symb { - my ($cdom,$cnum,$symb) = @_; - my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum); - my %needpb; - if (keys(%passback)) { - my $checkpb = 1; - if (exists($passback{$symb})) { - if (keys(%passback) == 1) { - undef($checkpb); - } - if (ref($passback{$symb}) eq 'HASH') { - foreach my $launcher (keys(%{$passback{$symb}})) { - $needpb{$launcher} = $symb; - } - } - } - if ($checkpb) { - my ($map,$id,$url) = &Apache::lonnet::decode_symb($symb); - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - my $mapres = $navmap->getResourceByUrl($map); - if (ref($mapres)) { - my $mapsymb = $mapres->symb(); - if (exists($passback{$mapsymb})) { - if (keys(%passback) == 1) { - undef($checkpb); - } - if (ref($passback{$mapsymb}) eq 'HASH') { - foreach my $launcher (keys(%{$passback{$mapsymb}})) { - $needpb{$launcher} = $mapsymb; - } - } - } - my %posspb; - if ($checkpb) { - my @recurseup = $navmap->recurseup_maps($map,1); - if (@recurseup) { - map { $posspb{$_} = 1; } @recurseup; - } - } - foreach my $key (keys(%passback)) { - if (exists($posspb{$key})) { - if (ref($passback{$key}) eq 'HASH') { - foreach my $launcher (keys(%{$passback{$key}})) { - my ($linkuri,$linkprotector,$scope) = split("\0",$launcher); - next unless ($scope eq 'rec'); - $needpb{$launcher} = $key; - } - } - } - } - } - } - } - } - return %needpb; -} - -sub process_passbacks { - my ($context,$symbs,$cdom,$cnum,$udom,$uname,$usec,$weights,$awardeds,$excuseds,$needpb, - $skip_passback,$pbsave,$pbids) = @_; - if ((ref($needpb) eq 'HASH') && (ref($skip_passback) eq 'HASH') && (ref($pbsave) eq 'HASH')) { - my (%weight,%awarded,%excused); - if ((ref($symbs) eq 'ARRAY') && (ref($weights) eq 'HASH') && (ref($awardeds) eq 'HASH') && - (ref($excuseds) eq 'HASH')) { - %weight = %{$weights}; - %awarded = %{$awardeds}; - %excused = %{$excuseds}; - } - my $uhome = &Apache::lonnet::homeserver($uname,$udom); - my @launchers = keys(%{$needpb}); - my %pbinfo; - if (ref($pbids) eq 'HASH') { - %pbinfo = %{$pbids}; - } else { - %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',\@launchers,$udom,$uname); - } - my %pbc = &common_passback_info(); - foreach my $launcher (@launchers) { - if (ref($pbinfo{$launcher}) eq 'ARRAY') { - my $pbid = $pbinfo{$launcher}[0]; - my $pburl = $pbinfo{$launcher}[1]; - my (%total_by_symb,%possible_by_symb); - if (($pbid ne '') && ($pburl ne '')) { - next if ($skip_passback->{$launcher}); - my %pb = %pbc; - if ((exists($pbsave->{$launcher})) && - (ref($pbsave->{$launcher}) eq 'HASH')) { - foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat', - 'symb','map','pbscope','linkuri','linkprotector','scope') { - $pb{$item} = $pbsave->{$launcher}{$item}; - } - } else { - my $ltitype; - ($pb{'linkuri'},$pb{'linkprotector'},$pb{'scope'}) = split("\0",$launcher); - ($pb{'ltinum'},$ltitype) = ($pb{'linkprotector'} =~ /^(\d+)(c|d)$/); - if ($ltitype eq 'c') { - my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider'); - $pb{'lti_in_use'} = $crslti{$pb{'ltinum'}}; - $pb{'crsdef'} = 1; - } else { - my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot'); - $pb{'lti_in_use'} = $domlti{$pb{'ltinum'}}; - } - if (ref($pb{'lti_in_use'}) eq 'HASH') { - $pb{'msgformat'} = $pb{'lti_in_use'}->{'passbackformat'}; - $pb{'keynum'} = $pb{'lti_in_use'}->{'cipher'}; - $pb{'scoretype'} = 'decimal'; - if ($pb{'lti_in_use'}->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) { - $pb{'scoretype'} = $1; - } - $pb{'symb'} = $needpb->{$launcher}; - if ($pb{'symb'} =~ /\.(page|sequence)$/) { - $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[2]); - } else { - $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[0]); - } - $pb{'map'} = &Apache::lonnet::clutter($pb{'map'}); - if ($pb{'scope'} eq 'res') { - $pb{'pbscope'} = 'resource'; - } elsif ($pb{'scope'} eq 'map') { - $pb{'pbscope'} = 'nonrec'; - } elsif ($pb{'scope'} eq 'rec') { - $pb{'pbscope'} = 'map'; - } - foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat', - 'symb','map','pbscope','linkuri','linkprotector','scope') { - $pbsave->{$launcher}{$item} = $pb{$item}; - } - } else { - $skip_passback->{$launcher} = 1; - } - } - if (ref($symbs) eq 'ARRAY') { - foreach my $symb (@{$symbs}) { - if ((ref($weight{$symb}) eq 'HASH') && (ref($awarded{$symb}) eq 'HASH') && - (ref($excused{$symb}) eq 'HASH')) { - foreach my $part (keys(%{$weight{$symb}})) { - if ($excused{$symb}{$part}) { - next; - } - my $partweight = $weight{$symb}{$part} eq '' ? 1 : - $weight{$symb}{$part}; - if ($awarded{$symb}{$part}) { - $total_by_symb{$symb} += $partweight * $awarded{$symb}{$part}; - } - $possible_by_symb{$symb} += $partweight; - } - } - } - } - if ($context eq 'updatebypage') { - my $ltigrade = { - 'ltinum' => $pb{'ltinum'}, - 'lti' => $pb{'lti_in_use'}, - 'crsdef' => $pb{'crsdef'}, - 'cid' => $cdom.'_'.$cnum, - 'uname' => $uname, - 'udom' => $udom, - 'uhome' => $uhome, - 'usec' => $usec, - 'pbid' => $pbid, - 'pburl' => $pburl, - 'pbtype' => $pb{'type'}, - 'pbscope' => $pb{'pbscope'}, - 'pbmap' => $pb{'map'}, - 'pbsymb' => $pb{'symb'}, - 'format' => $pb{'scoretype'}, - 'scope' => $pb{'scope'}, - 'clientip' => $pb{'clientip'}, - 'linkprot' => $pb{'linkprotector'}.':'.$pb{'linkuri'}, - 'total_s' => \%total_by_symb, - 'possible_s' => \%possible_by_symb, - }; - push(@Apache::grades::ltipassback,$ltigrade); - next; - } - my ($total,$possible); - if ($pb{'pbscope'} eq 'resource') { - $total = $total_by_symb{$pb{'symb'}}; - $possible = $possible_by_symb{$pb{'symb'}}; - } elsif (($pb{'pbscope'} eq 'map') || ($pb{'pbscope'} eq 'nonrec')) { - ($total,$possible) = - &Apache::lonhomework::get_lti_score($uname,$udom,$usec,$pb{'map'},$pb{'pbscope'}, - \%total_by_symb,\%possible_by_symb); - } - if (!$possible) { - $total = 0; - $possible = 1; - } - my ($sent,$score,$code,$result) = - &LONCAPA::ltiutils::send_grade($cdom,$cnum,$pb{'crsdef'},$pb{'type'},$pb{'ltinum'}, - $pb{'keynum'},$pbid,$pburl,$pb{'scoretype'},$pb{'sigmethod'}, - $pb{'msgformat'},$total,$possible); - my $no_passback; - if ($sent) { - if ($code == 200) { - my $namespace = $cdom.'_'.$cnum.'_lp_passback'; - my $store = { - 'score' => $score, - 'ip' => $pb{'ip'}, - 'host' => $pb{'lonhost'}, - 'protector' => $pb{'linkprotector'}, - 'deeplink' => $pb{'linkuri'}, - 'scope' => $pb{'scope'}, - 'url' => $pburl, - 'id' => $pbid, - 'clientip' => $pb{'clientip'}, - 'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'}, - }; - my $value=''; - foreach my $key (keys(%{$store})) { - $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&'; - } - $value=~s/\&$//; - &Apache::lonnet::courselog(&escape($pb{'linkuri'}).':'.$uname.':'.$udom.':EXPORT:'.$value); - &Apache::lonnet::store_userdata({'score' => $score},$launcher,$namespace,$udom,$uname,$pb{'ip'}); - } else { - $no_passback = 1; - } - } else { - $no_passback = 1; - } - if ($no_passback) { - &Apache::lonnet::log($udom,$uname,$uhome,$no_passback." score: $score; total: $total; possible: $possible"); - my $ltigrade = { - 'ltinum' => $pb{'ltinum'}, - 'lti' => $pb{'lti_in_use'}, - 'crsdef' => $pb{'crsdef'}, - 'cid' => $cdom.'_'.$cnum, - 'uname' => $uname, - 'udom' => $udom, - 'uhome' => $uhome, - 'pbid' => $pbid, - 'pburl' => $pburl, - 'pbtype' => $pb{'type'}, - 'pbscope' => $pb{'pbscope'}, - 'pbmap' => $pb{'map'}, - 'pbsymb' => $pb{'symb'}, - 'format' => $pb{'scoretype'}, - 'scope' => $pb{'scope'}, - 'clientip' => $pb{'clientip'}, - 'linkprot' => $pb{'linkprotector'}.':'.$pb{'linkuri'}, - 'total' => $total, - 'possible' => $possible, - 'score' => $score, - }; - &Apache::lonnet::put('linkprot_passback_pending',$ltigrade,$cdom,$cnum); - } - } - } - } - } - return; -} - -sub common_passback_info { - my %pbc = ( - sigmethod => 'HMAC-SHA1', - type => 'linkprot', - clientip => &Apache::lonnet::get_requestor_ip(), - lonhost => $Apache::lonnet::perlvar{'lonHostID'}, - ip => &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}), - ); - return %pbc; -} - #--- 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,$symb,$submitonly,$divforres) = @_; + my ($request,$symb,$submitonly) = @_; my $is_tool = ($symb =~ /ext\.tool$/); my $cdom = $env{"course.$env{'request.course.id'}.domain"}; @@ -1945,26 +915,41 @@ sub listStudents { my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; unless ($submitonly) { - $submitonly = $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; } my $result=''; my $res_error; - my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error); - - my $table; - if (ref($partlist) eq 'ARRAY') { - if (scalar(@$partlist) > 1 ) { - $table = &showResourceInfo($symb,$partlist,$responseType,'gradesub',1); - } elsif ($divforres) { - $table = ''; - } else { - $table = ''.&mt('[_1]Message:[_2] No more students for this section or class.','','').'
'."\n"; + my $the_end.=''.&mt('[_1]Message:[_2] No more students for this section or class.','','').'
'."\n"; $request->print($the_end); } return ''; @@ -4461,8 +3228,7 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { - my ($request,$symb,$stuname,$domain,$newflg,$submitter, - $part,$queueable,$needpb,$skip_passback,$pbsave) = @_; + my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; my @version_parts; my $usec = &Apache::lonnet::getsection($domain,$stuname, $env{'request.course.id'}); @@ -4470,7 +3236,7 @@ sub saveHandGrade { my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); my @parts_graded; my %newrecord = (); - my ($pts,$wgt,$totchg,$sendupdate,$poss_pb) = ('','',0,0,0); + my ($pts,$wgt,$totchg) = ('','',0); my %aggregate = (); my $aggregateflag = 0; if ($env{'form.HIDE'.$newflg}) { @@ -4478,33 +3244,18 @@ sub saveHandGrade { my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1); $totchg += $numchgs; } - if ((ref($needpb) eq 'HASH') && (keys(%{$needpb}))) { - $poss_pb = 1; - } - my (%weights,%awardeds,%excuseds); my @parts = split(/:/,$env{'form.partlist'.$newflg}); foreach my $new_part (@parts) { - #collaborator ($submitter may vary for different parts) + #collaborator ($submi may vary for different parts if ($submitter && $new_part ne $part) { next; } my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; - if ($poss_pb) { - $weights{$symb}{$new_part} = - &Apache::lonnet::EXT('resource.'.$new_part.'.weight',$symb,$udom,$uname); - } elsif ($env{'form.WGT'.$newflg.'_'.$new_part} eq '') { - $weights{$symb}{$new_part} = 1; - } else { - $weights{$symb}{$new_part} = $env{'form.WGT'.$newflg.'_'.$new_part}; - } if ($dropMenu eq 'excused') { - $excuseds{$symb}{$new_part} = 1; - $awardeds{$symb}{$new_part} = ''; if ($record{'resource.'.$new_part.'.solved'} ne 'excused') { $newrecord{'resource.'.$new_part.'.solved'} = 'excused'; if (exists($record{'resource.'.$new_part.'.awarded'})) { $newrecord{'resource.'.$new_part.'.awarded'} = ''; } $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; - $sendupdate ++; } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts @@ -4528,9 +3279,6 @@ sub saveHandGrade { &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); $aggregateflag = 1; } - $sendupdate ++; - $excuseds{$symb}{$new_part} = ''; - $awardeds{$symb}{$new_part} = ''; } elsif ($dropMenu eq '') { $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? $env{'form.GD_BOX'.$newflg.'_'.$new_part} : @@ -4541,15 +3289,12 @@ sub saveHandGrade { $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : $env{'form.WGT'.$newflg.'_'.$new_part}; my $partial= $pts/$wgt; - $awardeds{$symb}{$new_part} = $partial; - $excuseds{$symb}{$new_part} = ''; if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { #do not update score for part if not changed. &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); next; } else { push(@parts_graded,$new_part); - $sendupdate ++; } if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { $newrecord{'resource.'.$new_part.'.awarded'} = $partial; @@ -4595,17 +3340,13 @@ sub saveHandGrade { &Apache::lonnet::cstore(\%newrecord,$symb, $env{'request.course.id'},$domain,$stuname); &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, - $cdom,$cnum,$domain,$stuname,$queueable); + $cdom,$cnum,$domain,$stuname); } if ($aggregateflag) { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, $cdom,$cnum); } - if (($sendupdate || $totchg) && (!$submitter) && ($poss_pb)) { - &process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,$usec,\%weights, - \%awardeds,\%excuseds,$needpb,$skip_passback,$pbsave); - } - return ('',$pts,$wgt,$totchg,$sendupdate); + return ('',$pts,$wgt,$totchg); } sub makehidden { @@ -4639,7 +3380,7 @@ sub makehidden { } sub check_and_remove_from_queue { - my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname,$queueable) = @_; + my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_; my @ungraded_parts; foreach my $part (@{$parts}) { if ( $record->{ 'resource.'.$part.'.awarded'} eq '' @@ -4647,9 +3388,7 @@ sub check_and_remove_from_queue { && $newrecord->{'resource.'.$part.'.awarded'} eq '' && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' ) { - if ($queueable->{$part}) { - push(@ungraded_parts, $part); - } + push(@ungraded_parts, $part); } } if ( !@ungraded_parts ) { @@ -4675,19 +3414,19 @@ sub handback_files { my $part_resp = join('_',@{ $part_response_id }); if (($env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'} =~ /^\d+$/) & ($new_part eq $part_id)) { for (my $counter=1; $counter<=$env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'}; $counter++) { - # if multiple files are uploaded names will be 'returndoc2','returndoc3' - if ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter}) { + # if multiple files are uploaded names will be 'returndoc2','returndoc3' + if ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter}) { my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter.'.filename'}; my ($directory,$answer_file) = ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter} =~ /^(.*?)([^\/]*)$/); my ($answer_name,$answer_ver,$answer_ext) = - &file_name_version_ext($answer_file); + &Apache::lonnet::file_name_version_ext($answer_file); my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); my $getpropath = 1; - my ($dir_list,$listerror) = + my ($dir_list,$listerror) = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path, $domain,$stuname,$getpropath); - my $version = &get_next_version($answer_name,$answer_ext,$dir_list); + my $version = &Apache::lonnet::get_next_version($answer_name,$answer_ext,$dir_list); # fix filename my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, @@ -4705,8 +3444,7 @@ sub handback_files { $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; } $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; - $file_msg.=''.$save_file_name."".&mt('Users are in domain: [_1]',$domform)."
\n"); + $request->print("\n".&mt('Users are in domain: [_1]',$domform)."
\n"); } foreach my $key (sort(keys(%env))) { if ($key !~ /^form\.(.*)$/) { next; } @@ -6125,44 +4736,21 @@ sub get_fields { } sub csvuploadassign { - my ($request,$symb) = @_; + my ($request,$symb)= @_; if (!$symb) {return '';} my $error_msg = ''; my $datatoken = &Apache::loncommon::valid_datatoken($env{'form.datatoken'}); - if ($datatoken ne '') { + 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(); my $courseid=$env{'request.course.id'}; - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my ($classlist) = &getclasslist('all',0); my @notallowed; my @skipped; my @warnings; my $countdone=0; - my @parts; - my %needpb = &passbacks_for_symb($cdom,$cnum,$symb); - my $passback; - if (keys(%needpb)) { - $passback = 1; - my $navmap = Apache::lonnavmaps::navmap->new(); - if (ref($navmap)) { - my $res = $navmap->getBySymb($symb); - if (ref($res)) { - my $partlist = $res->parts(); - if (ref($partlist) eq 'ARRAY') { - @parts = sort(@{$partlist}); - } - } - } else { - return &navmap_errormsg(); - } - } - my (%skip_passback,%pbsave,%weights,%awardeds,%excuseds); - foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); my $domain; @@ -6177,13 +4765,45 @@ sub csvuploadassign { if (!$username) { my $id=$entries{$fields{'ID'}}; $id=~s/\s//g; - my %ids=&Apache::lonnet::idget($domain,$id); - $username=$ids{$id}; + if ($id ne '') { + my %ids=&Apache::lonnet::idget($domain,[$id]); + $username=$ids{$id}; + } else { + if ($entries{$fields{'clicker'}}) { + my $clicker = $entries{$fields{'clicker'}}; + $clicker=~s/\s//g; + if ($clicker ne '') { + my %clickers = &Apache::lonnet::idget($domain,[$clicker],'clickers'); + if ($clickers{$clicker} ne '') { + my $match = 0; + my @inclass; + foreach my $poss (split(/,/,$clickers{$clicker})) { + if (exists($$classlist{"$poss:$domain"})) { + $username = $poss; + push(@inclass,$poss); + $match ++; + + } + } + if ($match > 1) { + undef($username); + $request->print(''. + &mt('Score not saved for clicker: [_1] (matched multiple usernames: [_2])', + $clicker,join(', ',@inclass)).'
'); + } + } + } + } + } } if (!exists($$classlist{"$username:$domain"})) { my $id=$entries{$fields{'ID'}}; $id=~s/\s//g; - if ($id) { + my $clicker = $entries{$fields{'clicker'}}; + $clicker=~s/\s//g; + if ($clicker) { + push(@skipped,"$clicker:$domain"); + } elsif ($id) { push(@skipped,"$id:$domain"); } else { push(@skipped,"$username:$domain"); @@ -6205,18 +4825,13 @@ sub csvuploadassign { my $part=$1; my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', $symb,$domain,$username); - $weights{$symb}{$part} = $wgt; if ($wgt) { $entries{$fields{$dest}}=~s/\s//g; my $pcr=$entries{$fields{$dest}} / $wgt; - if ($passback) { - $awardeds{$symb}{$part} = $pcr; - $excuseds{$symb}{$part} = ''; - } my $award=($pcr == 0) ? 'incorrect_by_override' : 'correct_by_override'; if ($pcr>1) { - push(@warnings,&mt("[_1]: point value larger than weight","$username:$domain")); + push(@warnings,&mt("[_1]: point value larger than weight","$username:$domain")); } $grades{"resource.$part.awarded"}=$pcr; $grades{"resource.$part.solved"}=$award; @@ -6232,28 +4847,12 @@ sub csvuploadassign { if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } my $store_key=$dest; - if ($passback) { - if ($store_key=~/stores_(.*)_(awarded|solved)/) { - my ($part,$key) = ($1,$2); - unless ((ref($weights{$symb}) eq 'HASH') && (exists($weights{$symb}{$part}))) { - $weights{$symb}{$part} = &Apache::lonnet::EXT('resource.'.$part.'.weight', - $symb,$domain,$username); - } - if ($key eq 'awarded') { - $awardeds{$symb}{$part} = $entries{$fields{$dest}}; - } elsif ($key eq 'solved') { - if ($entries{$fields{$dest}} =~ /^excused/) { - $excuseds{$symb}{$part} = 1; - } - } - } - } $store_key=~s/^stores/resource/; $store_key=~s/_/\./g; $grades{$store_key}=$entries{$fields{$dest}}; } } - if (! %grades) { + if (! %grades) { push(@skipped,&mt("[_1]: no data to save","$username:$domain")); } else { $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; @@ -6264,33 +4863,12 @@ sub csvuploadassign { # Successfully stored $request->print('.'); # Remove from grading queue - &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,$cnum, - $domain,$username); + &Apache::bridgetask::remove_from_queue('gradingqueue',$symb, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}, + $domain,$username); $countdone++; - if ($passback) { - my @parts_in_upload; - if (ref($weights{$symb}) eq 'HASH') { - @parts_in_upload = sort(keys(%{$weights{$symb}})); - } - my @diffs = &Apache::loncommon::compare_arrays(\@parts_in_upload,\@parts); - if (@diffs > 0) { - my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$username); - foreach my $part (@parts) { - next if (grep(/^\Q$part\E$/,@parts_in_upload)); - $weights{$symb}{$part} = &Apache::lonnet::EXT('resource.'.$part.'.weight', - $symb,$domain,$username); - if ($record{"resource.$part.solved"} =~/^excused/) { - $excuseds{$symb}{$part} = 1; - } else { - $excuseds{$symb}{$part} = ''; - } - $awardeds{$symb}{$part} = $record{"resource.$part.awarded"}; - } - } - &process_passbacks('csvupload',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights, - \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave); - } - } else { + } else { $request->print("". &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", "$username:$domain",$result)."
"); @@ -6345,7 +4923,6 @@ 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('Unable to accept last correction, an error occurred: [_1]',
$errmsg)
@@ -8695,7 +7144,7 @@ sub scantron_validate_file {
while (!$stop && $currentphase < scalar(@validate_phases)) {
$r->print(&mt('Validating '.$validate_phases[$currentphase]).'
');
$r->rflush();
-
+
my $which="scantron_validate_".$validate_phases[$currentphase];
{
no strict 'refs';
@@ -8725,7 +7174,7 @@ sub scantron_validate_file {
$r->print('');
$r->print(' '.&mt('this error').'
');
- $r->print('
'.&mt('Or return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','','').'
'); + $r->print(''.&mt('Or return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','','').'
'); } else { if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { $r->print(''); @@ -9104,9 +7553,10 @@ sub scantron_validate_sequence { my @resources= $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); if (@resources) { - $r->print('' + $r->print( + '
' .&mt('Some resources in the sequence currently are not set to' - .' exam mode. Grading these resources currently may not' + .' bubblesheet exam mode. Grading these resources currently may not' .' work correctly.') .'
' ); @@ -9228,10 +7678,10 @@ sub scantron_get_correction { if ($error =~ /ID$/) { if ($error eq 'incorrectID') { - $r->print(''.&mt("The encoded ID is not in the classlist"). + $r->print('
'.&mt("The encoded ID is not in the classlist"). "
\n"); } elsif ($error eq 'duplicateID') { - $r->print(''.&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."
\n"); + $r->print(''.&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."
\n"); } $r->print($message); $r->print("".&mt("How should I handle this?")."
\n");
@@ -9251,8 +7701,8 @@ sub scantron_get_correction {
} elsif ($error eq 'duplicateCODE') {
$r->print('
'.&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."
\n"); } - $r->print("".&mt('The CODE on the form is [_1]', - "'$$scan_record{'scantron.CODE'}'") + $r->print("
".&mt('The CODE on the form is [_1]', + "'$$scan_record{'scantron.CODE'}'") ."
\n"); $r->print($message); $r->print("".&mt("How should I handle this?")."
\n"); @@ -9349,7 +7799,7 @@ ENDSCRIPT # The form field scantron_questions is actually a list of line numbers not # a list of question numbers. Therefore: # - + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, $respnumlookup,$startline); @@ -9374,7 +7824,7 @@ sub verify_bubbles_checked { my $ansnumstr = join('","',@ansnums); my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines."); &js_escape(\$warning); - my $output = &Apache::lonhtmlcommon::scripttag(<'.&mt("Uploading file to [_1]",$coursedata{'description'}).'
'); + $r->print(''.&mt('Uploading file to [_1]','"'.$coursedata{'description'}.'"').'
'); if (length($env{'form.upfile'}) < 2) { $r->print( &Apache::lonhtmlcommon::confirm_success( @@ -10799,7 +9221,7 @@ sub scantron_upload_scantron_data_save { my $result = &Apache::lonnet::userfileupload('upfile','scantron','scantron',$parser,'','', $env{'form.courseid'},$env{'form.domainid'}); - if ($result =~ m{^/uploaded/}) { + if ($result =~ m{^/uploaded/}) { $r->print( &Apache::lonhtmlcommon::confirm_success(&mt('Upload successful')).''. - &mt('Comparison of bubblesheet data (including corrections) with corresponding submission records (most recent submission) for [_1][quant,_2,student][_3] ([quant,_4,bubblesheet line] per student).', - '', - $numstudents, - '', - $env{'form.scantron_maxbubble'}). - '
' + $r->print( + '' + .&mt('Comparison of bubblesheet data (including corrections) with corresponding submission records (most recent submission) for [_1][quant,_2,student][_3] ([quant,_4,bubblesheet line] per student).', + '', + $numstudents, + '', + $env{'form.scantron_maxbubble'}) + .'
' ); $r->print(''
.&mt('Exact matches for [_1][quant,_2,student][_3].','',$passed,'')
.'
'
.&mt('Discrepancies detected for [_1][quant,_2,student][_3].','',$failed,'')
- .'