--- loncom/homework/grades.pm 2017/05/19 16:40:50 1.739
+++ loncom/homework/grades.pm 2020/08/26 18:13:40 1.771
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.739 2017/05/19 16:40:50 raeburn Exp $
+# $Id: grades.pm,v 1.771 2020/08/26 18:13:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -46,7 +46,10 @@ 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);
@@ -116,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 }) {
@@ -293,7 +300,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();
@@ -301,7 +308,14 @@ sub reset_caches {
if ($check_for_randomlist) {
$add_to_form = { 'check_parts_withrandomlist' => 1,};
}
- my $analyze =
+ 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);
if (ref($analyze) eq 'HASH') {
@@ -331,7 +345,7 @@ sub cleanRecord {
if ($response =~ /^(option|rank)$/) {
my %answer=&Apache::lonnet::str2hash($answer);
my @answer = %answer;
- %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer;
+ %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer;
my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
my ($toprow,$bottomrow);
foreach my $foil (@$order) {
@@ -349,7 +363,7 @@ sub cleanRecord {
} elsif ($response eq 'match') {
my %answer=&Apache::lonnet::str2hash($answer);
my @answer = %answer;
- %answer = map {&HTML::Entities::encode($_, '"<>&')} @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);
@@ -406,8 +420,8 @@ 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]',
'"'.&HTML::Entities::encode($answer, '"<>&').'"');
@@ -491,7 +505,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'));
@@ -519,6 +533,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,my $handgrade,my $responseType) = &response_type($symb,\$res_error);
+ }
foreach my $student (keys(%$classlist)) {
my $end =
$classlist->{$student}->[&Apache::loncoursedata::CL_END()];
@@ -535,7 +556,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;
@@ -552,13 +573,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)) {
@@ -573,7 +639,6 @@ sub getclasslist {
delete($classlist->{$student});
}
}
- my %seen = ();
my @sections = sort(keys(%sections));
return ($classlist,\@sections,\%fullnames);
}
@@ -589,7 +654,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;
}
}
@@ -602,19 +667,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;
}
@@ -755,14 +820,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 =
'
'.
&mt('Verifying Receipt Number [_1]',$receipt).
'
'."\n";
@@ -845,12 +910,13 @@ sub verifyreceipt {
sub listStudents {
my ($request,$symb,$submitonly) = @_;
+ my $is_tool = ($symb =~ /ext\.tool$/);
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'};
unless ($submitonly) {
- $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
+ $submitonly = $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
}
my $result='';
@@ -900,38 +966,66 @@ LISTJAVASCRIPT
"\n";
$gradeTable .= &Apache::lonhtmlcommon::start_pick_box();
- $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text'))
- .''."\n"
- .''."\n"
- .' '."\n"
- .&Apache::lonhtmlcommon::row_closure();
- $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer'))
- .''."\n"
- .''."\n"
- .' '."\n"
- .&Apache::lonhtmlcommon::row_closure();
+ unless ($is_tool) {
+ $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text'))
+ .''."\n"
+ .''."\n"
+ .' '."\n"
+ .&Apache::lonhtmlcommon::row_closure();
+ $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer'))
+ .''."\n"
+ .''."\n"
+ .' '."\n"
+ .&Apache::lonhtmlcommon::row_closure();
+ }
my $submission_options;
my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status'));
my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status;
$env{'form.Status'} = $saveStatus;
+ my %optiontext;
+ if ($is_tool) {
+ %optiontext = &Apache::lonlocal::texthash (
+ lastonly => 'last transaction',
+ last => 'last transaction with details',
+ datesub => 'all transactions',
+ all => 'all transactions with details',
+ );
+ } else {
+ %optiontext = &Apache::lonlocal::texthash (
+ lastonly => 'last submission',
+ last => 'last submission with details',
+ datesub => 'all submissions',
+ all => 'all submissions with details',
+ );
+ }
$submission_options.=
''.
''."\n".
+ $optiontext{'lastonly'}.' '."\n".
''.
''."\n".
+ $optiontext{'last'}.' '."\n".
''.
''."\n".
+ $optiontext{'datesub'}.''."\n".
''.
'';
- $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Submissions'))
+ $optiontext{'all'}.'';
+ my $viewtitle;
+ if ($is_tool) {
+ $viewtitle = &mt('View Transactions');
+ } else {
+ $viewtitle = &mt('View Submissions');
+ }
+ $gradeTable .= &Apache::lonhtmlcommon::row_title($viewtitle)
.$submission_options
.&Apache::lonhtmlcommon::row_closure();
+ my $closure;
+ if (($is_tool) && (exists($env{'form.Status'}))) {
+ $closure = 1;
+ }
$gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Grading Increments'))
.''
- .&Apache::lonhtmlcommon::row_closure();
+ .&Apache::lonhtmlcommon::row_closure($closure);
$gradeTable .=
&build_section_inputs().
@@ -950,19 +1044,30 @@ LISTJAVASCRIPT
if (exists($env{'form.Status'})) {
$gradeTable .= ''."\n";
} else {
+ if ($is_tool) {
+ $closure = 1;
+ }
$gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Student Status'))
.&Apache::lonhtmlcommon::StatusOptions(
$saveStatus,undef,1,'javascript:reLoadList(this.form);')
- .&Apache::lonhtmlcommon::row_closure();
+ .&Apache::lonhtmlcommon::row_closure($closure);
}
- $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism'))
- .''
- .&Apache::lonhtmlcommon::row_closure(1)
- .&Apache::lonhtmlcommon::end_pick_box();
-
+ unless ($is_tool) {
+ $closure = 1;
+ $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism'))
+ .''
+ .&Apache::lonhtmlcommon::row_closure($closure);
+ }
+ $gradeTable .= &Apache::lonhtmlcommon::end_pick_box();
+ my $regrademsg;
+ if ($is_tool) {
+ $regrademsg =&mt("To view/grade/regrade, click on the check box(es) next to the student's name(s). Then click on the Next button.");
+ } else {
+ $regrademsg = &mt("To view/grade/regrade 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.");
+ }
$gradeTable .= '
'
- .&mt("To view/grade/regrade 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"
.''
.'
';
@@ -1108,8 +1213,8 @@ LISTJAVASCRIPT
#---- Called from the listStudents routine
sub check_script {
- my ($form, $type)=@_;
- my $chkallscript= &Apache::lonhtmlcommon::scripttag('
+ my ($form,$type) = @_;
+ my $chkallscript = &Apache::lonhtmlcommon::scripttag('
function checkall() {
for (i=0; iprint(&mt('There are currently no submitted documents.'));
- return;
+ $r->print(&mt('There are currently no submitted documents.'));
+ return;
}
-
my $all_students =
join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo'));
@@ -1944,7 +2047,55 @@ sub submit_download_link {
my ($request,$symb) = @_;
if (!$symb) { return ''; }
#FIXME: Figure out which type of problem this is and provide appropriate download
- &download_all_link($request,$symb);
+ my $res_error;
+ my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error);
+ if (ref($res_error)) {
+ if ($$res_error) {
+ $request->print(&mt('An error occurred retrieving response types'));
+ return;
+ }
+ }
+ my ($numupload,$numessay) = (0,0);
+ if (ref($responseType) eq 'HASH') {
+ foreach my $part (sort(keys(%$responseType))) {
+ foreach my $id (sort(keys(%{ $responseType->{$part} }))) {
+ my $responsetype = $responseType->{$part}->{$id};
+ if ($responsetype eq 'essay') {
+ my $uploadedfiletypes =
+ &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes",$symb);
+ if ($uploadedfiletypes) {
+ $numupload++;
+ } else {
+ $numessay++;
+ }
+ }
+ }
+ }
+ }
+ if (($numupload) || ($numessay)) {
+ my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'};
+ my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'};
+ my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'};
+ (undef,undef,my $fullname) = &getclasslist($getsec,1,$getgroup,$symb,$submitonly,1);
+ if (ref($fullname) eq 'HASH') {
+ my @students = map { $_.':'.$fullname->{$_} } (keys(%{$fullname}));
+ if (@students) {
+ @{$env{'form.stuinfo'}} = @students;
+ if ($numupload) {
+ &download_all_link($request,$symb);
+ }
+# FIXME Need to provide a mechanism to download essays, i.e., if $numessay > 0
+# Needs to omit user's identity if resource instance is for an anonymous survey.
+ } else {
+ $request->print(&mt('No students match the criteria you selected'));
+ }
+ } else {
+ $request->print(&mt('Could not retrieve student information'));
+ }
+ } else {
+ $request->print(&mt('No essayresponse items found'));
+ }
+ return;
}
sub build_section_inputs {
@@ -1970,6 +2121,8 @@ sub submission {
my $probtitle=&Apache::lonnet::gettitle($symb);
if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }
+ my $is_tool = ($symb =~ /ext\.tool$/);
+ my ($essayurl,%coursedesc_by_cid);
if (!&canview($usec)) {
$request->print(
@@ -1982,8 +2135,10 @@ sub submission {
}
if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; }
- if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; }
- if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; }
+ unless ($is_tool) {
+ if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; }
+ if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; }
+ }
my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
my $checkIcon = ''
- .'
'.&mt('Submissions').'
';
+ .'
'.$boxtitle.'
';
$result.=''."\n";
# if ($env{'form.handgrade'} eq 'no') {
- if (1) {
+ unless ($is_tool) {
$result.='
'
.&mt('Part(s) graded correct by the computer is marked with a [_1] symbol.',$checkIcon)
."
\n";
@@ -2171,7 +2343,7 @@ sub submission {
my $fullname;
my $col_fullnames = [];
# if ($env{'form.handgrade'} eq 'yes') {
- if (1) {
+ unless ($is_tool) {
(my $sub_result,$fullname,$col_fullnames)=
&check_collaborators($symb,$uname,$udom,\%record,$handgrade,
$counter);
@@ -2186,12 +2358,16 @@ sub submission {
# (3) Last submission plus the parts info
# (4) The whole record for this student
- my ($string,$timestamp)= &get_last_submission(\%record);
+ my ($string,$timestamp)= &get_last_submission(\%record,$is_tool);
my $lastsubonly;
if ($$timestamp eq '') {
$lastsubonly.='
'
@@ -2245,24 +2421,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'}).
- '
'.
+ &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.')').
+ '
';
+ }
+ }
+ $similar .= '
'.
+ &keywords_highlight($oessay).
+ '
';
}
}
}
@@ -2374,7 +2578,12 @@ sub submission {
my %seen = ();
my @partlist;
my @gradePartRespid;
- my @part_response_id = &flatten_responseType($responseType);
+ my @part_response_id;
+ if ($is_tool) {
+ @part_response_id = ([0,'']);
+ } else {
+ @part_response_id = &flatten_responseType($responseType);
+ }
$request->print(
'
'
.'
'.&mt('Assign Grades').'
'
@@ -2500,7 +2709,7 @@ sub check_collaborators {
#--- Retrieve the last submission for all the parts
sub get_last_submission {
- my ($returnhash)=@_;
+ my ($returnhash,$is_tool)=@_;
my (@string,$timestamp,%lasthidden);
if ($$returnhash{'version'}) {
my %lasthash=();
@@ -2566,8 +2775,14 @@ sub get_last_submission {
}
}
if (!@string) {
+ my $msg;
+ if ($is_tool) {
+ $msg = &mt('No grade passed back.');
+ } else {
+ $msg = &mt('Nothing submitted - no attempts.');
+ }
$string[0] =
- ''.&mt('Nothing submitted - no attempts.').'';
+ ''.$msg.'';
}
return (\@string,\$timestamp);
}
@@ -3554,6 +3769,11 @@ VIEWJAVASCRIPT
#--- show scores for a section or whole class w/ option to change/update a score
sub viewgrades {
my ($request,$symb) = @_;
+ my ($is_tool,$toolsymb);
+ if ($symb =~ /ext\.tool$/) {
+ $is_tool = 1;
+ $toolsymb = $symb;
+ }
&viewgrades_js($request);
#need to make sure we have the correct data for later EXT calls,
@@ -3634,7 +3854,13 @@ sub viewgrades {
if ($env{'form.submitonly'} eq 'all') {
$result.= '
';
}
$result.= &Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
@@ -3716,10 +3953,10 @@ sub viewgrades {
my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
my @partids = ();
foreach my $part (@parts) {
- my $display=&Apache::lonnet::metadata($url,$part.'.display');
+ my $display=&Apache::lonnet::metadata($url,$part.'.display',$toolsymb);
my $narrowtext = &mt('Tries');
$display =~ s|^Number of Attempts|$narrowtext |; # makes the column narrower
- if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
+ if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name',$toolsymb); }
my ($partid) = &split_part_type($part);
push(@partids,$partid);
#
@@ -3760,7 +3997,7 @@ sub viewgrades {
return $a cmp $b;
} (keys(%$fullname))) {
$result.=&viewstudentgrade($symb,$env{'request.course.id'},
- $_,$$fullname{$_},\@parts,\%weight,\$ctr,\%last_resets);
+ $_,$$fullname{$_},\@parts,\%weight,\$ctr,\%last_resets,$is_tool);
}
$result.=&Apache::loncommon::end_data_table();
$result.=''."\n";
@@ -3848,7 +4085,7 @@ sub viewgrades {
#--- call by previous routine to display each student who satisfies submission filter.
sub viewstudentgrade {
- my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_;
+ my ($symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets,$is_tool) = @_;
my ($uname,$udom) = split(/:/,$student);
my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
my $submitonly = $env{'form.submitonly'};
@@ -3954,10 +4191,14 @@ sub viewstudentgrade {
# record does not get update if unchanged
sub editgrades {
my ($request,$symb) = @_;
+ my $toolsymb;
+ if ($symb =~ /ext\.tool$/) {
+ $toolsymb = $symb;
+ }
my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
my $title='
'.&mt('Current Grade Status').'
';
- $title.='
'.&mt('Section: [_1]',$section_display).'
'."\n";
+ $title.='
'.&mt('Section:').' '.$section_display.'
'."\n";
my $result= &Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
@@ -3991,6 +4232,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').'
';
@@ -3999,7 +4241,7 @@ sub editgrades {
my ($part,$type) = &split_part_type($stores);
if ($part !~ m/^\Q$partid\E/) { next;}
if ($type eq 'awarded' || $type eq 'solved') { next; }
- my $display=&Apache::lonnet::metadata($url,$stores.'.display');
+ my $display=&Apache::lonnet::metadata($url,$stores.'.display',$toolsymb);
$display =~ s/\[Part: \Q$part\E\]//;
my $narrowtext = &mt('Tries');
$display =~ s/Number of Attempts/$narrowtext/;
@@ -4007,6 +4249,7 @@ sub editgrades {
'
'.&mt('New').' '.$display.'
';
$columns{$partid}+=2;
}
+ $totcolspan += $columns{$partid};
}
foreach my $partid (@partid) {
my $display_part=&get_display_part($partid,$symb);
@@ -4022,18 +4265,18 @@ 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 .= '
';
my $usec=$classlist->{"$uname:$udom"}[5];
- if (!&canmodify($usec)) {
- my $numcols=scalar(@partid)*4+2;
+ my $canmodify = &canmodify($usec);
+ my $line = '
");
next;
}
my %aggregate = ();
@@ -4150,8 +4393,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').
@@ -4192,7 +4434,7 @@ sub split_part_type {
#
#--- Javascript to handle csv upload
sub csvupload_javascript_reverse_associate {
- my $error1=&mt('You need to specify the username or the student/employee ID');
+ my $error1=&mt('You need to specify the username, the student/employee ID, or the clicker ID');
my $error2=&mt('You need to specify at least one grading field');
&js_escape(\$error1);
&js_escape(\$error2);
@@ -4201,13 +4443,15 @@ sub csvupload_javascript_reverse_associa
var foundsomething=0;
var founduname=0;
var foundID=0;
+ var foundclicker=0;
for (i=0;i<=vf.nfields.value;i++) {
tw=eval('vf.f'+i+'.selectedIndex');
if (i==0 && tw!=0) { foundID=1; }
if (i==1 && tw!=0) { founduname=1; }
- if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; }
+ if (i==2 && tw!=0) { foundclicker=1; }
+ if (i!=0 && i!=1 && i!=2 && i!=3 && tw!=0) { foundsomething=1; }
}
- if (founduname==0 && foundID==0) {
+ if (founduname==0 && foundID==0 && foundclicker==0) {
alert('$error1');
return;
}
@@ -4234,7 +4478,7 @@ ENDPICK
}
sub csvupload_javascript_forward_associate {
- my $error1=&mt('You need to specify the username or the student/employee ID');
+ my $error1=&mt('You need to specify the username, the student/employee ID, or the clicker ID');
my $error2=&mt('You need to specify at least one grading field');
&js_escape(\$error1);
&js_escape(\$error2);
@@ -4243,13 +4487,15 @@ sub csvupload_javascript_forward_associa
var foundsomething=0;
var founduname=0;
var foundID=0;
+ var foundclicker=0;
for (i=0;i<=vf.nfields.value;i++) {
tw=eval('vf.f'+i+'.selectedIndex');
if (tw==1) { foundID=1; }
if (tw==2) { founduname=1; }
- if (tw>3) { foundsomething=1; }
+ if (tw==3) { foundclicker=1; }
+ if (tw>4) { foundsomething=1; }
}
- if (founduname==0 && foundID==0) {
+ if (founduname==0 && foundID==0 && Ć’oundclicker==0) {
alert('$error1');
return;
}
@@ -4307,6 +4553,10 @@ ENDPICK
sub csvupload_fields {
my ($symb,$errorref) = @_;
+ my $toolsymb;
+ if ($symb =~ /ext\.tool$/) {
+ $toolsymb = $symb;
+ }
my (@parts) = &getpartlist($symb,$errorref);
if (ref($errorref)) {
if ($$errorref) {
@@ -4315,15 +4565,15 @@ sub csvupload_fields {
}
my @fields=(['ID','Student/Employee ID'],
- ['clicker','Clicker ID'],
['username','Student Username'],
+ ['clicker','Clicker ID'],
['domain','Student Domain']);
my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
foreach my $part (sort(@parts)) {
my @datum;
- my $display=&Apache::lonnet::metadata($url,$part.'.display');
+ my $display=&Apache::lonnet::metadata($url,$part.'.display',$toolsymb);
my $name=$part;
- if (!$display) { $display = $name; }
+ if (!$display) { $display = $name; }
@datum=($name,$display);
if ($name=~/^stores_(.*)_awarded/) {
push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]);
@@ -4391,15 +4641,17 @@ ENDUPFORM
sub csvuploadmap {
- my ($request,$symb)= @_;
+ my ($request,$symb) = @_;
if (!$symb) {return '';}
my $datatoken;
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();
&csvuploadmap_header($request,$symb,$datatoken,$#records+1);
@@ -4485,10 +4737,13 @@ sub get_fields {
}
sub csvuploadassign {
- my ($request,$symb)= @_;
+ my ($request,$symb) = @_;
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();
my %fields=&get_fields();
my $courseid=$env{'request.course.id'};
@@ -4598,7 +4853,7 @@ sub csvuploadassign {
$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'}";
@@ -4669,6 +4924,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').'
';
@@ -4758,7 +5014,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
{
@@ -4808,7 +5064,7 @@ sub getSymbMap {
my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); },
1,0,1);
for my $sequence ($navmap->getById('0.0'), @sequences) {
- if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
+ if ($navmap->hasResource($sequence, sub { shift->is_gradable(); }, 0) ) {
my $title = $minder.'.'.
&HTML::Entities::encode($sequence->compTitle(),'"\'&');
push(@titles, $title); # minder in case two titles are identical
@@ -4905,10 +5161,11 @@ sub displayPage {
if($curRes == $iterator->BEGIN_MAP) { $depth++; }
if($curRes == $iterator->END_MAP) { $depth--; }
- if (ref($curRes) && $curRes->is_problem()) {
+ if (ref($curRes) && $curRes->is_gradable()) {
my $parts = $curRes->parts();
my $title = $curRes->compTitle();
my $symbx = $curRes->symb();
+ my $is_tool = ($symbx =~ /ext\.tool$/);
$studentTable.=
&Apache::loncommon::start_data_table_row().
'
'.$prob.
@@ -4919,26 +5176,34 @@ sub displayPage {
'
|g;
+ $studentTable.=' '.$title.' '.&mt('Correct answer').': '.$companswer;
+ }
}
my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname);
if ($env{'form.lastSub'} eq 'datesub') {
if ($record{'version'} eq '') {
- $studentTable.=' '.&mt('No recorded submission for this problem.').' ';
+ my $msg = &mt('No recorded submission for this problem.');
+ if ($is_tool) {
+ $msg = &mt('No recorded transactions for this external tool');
+ }
+ $studentTable.=' '.$msg.' ';
} else {
my %responseType = ();
foreach my $partid (@{$parts}) {
@@ -4951,7 +5216,6 @@ sub displayPage {
$responseType{$partid} = \%responseIds;
}
$studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
-
}
} elsif ($env{'form.lastSub'} eq 'all') {
my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
@@ -4992,13 +5256,14 @@ sub displaySubByDates {
my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
my $isCODE=0;
my $isTask = ($symb =~/\.task$/);
+ my $is_tool = ($symb =~/\.tool$/);
if (exists($record->{'resource.CODE'})) { $isCODE=1; }
my $studentTable=&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
'
'.&mt('Date/Time').'
'.
($isCODE?'
'.&mt('CODE').'
':'').
($isTask?'
'.&mt('Version').'
':'').
- '
'.&mt('Submission').'
'.
+ '
'.($is_tool?&mt('Grade'):&mt('Submission')).'
'.
'
'.&mt('Status').'
'.
&Apache::loncommon::end_data_table_header_row();
my ($version);
@@ -5006,7 +5271,11 @@ sub displaySubByDates {
my %orders;
$mark{'correct_by_student'} = $checkIcon;
if (!exists($$record{'1:timestamp'})) {
- return ' '.&mt('Nothing submitted - no attempts.').' ';
+ if ($is_tool) {
+ return ' '.&mt('No grade passed back.').' ';
+ } else {
+ return ' '.&mt('Nothing submitted - no attempts.').' ';
+ }
}
my $interaction;
@@ -5039,56 +5308,64 @@ sub displaySubByDates {
if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) {
$hidden = 1;
}
- my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
- : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
-
+ my @matchKey;
+ if ($isTask) {
+ @matchKey = sort(grep(/^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys));
+ } elsif ($is_tool) {
+ @matchKey = sort(grep(/^resource\.\Q$partid\E\.awarded$/,@versionKeys));
+ } else {
+ @matchKey = sort(grep(/^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
+ }
# next if ($$record{"$version:resource.$partid.solved"} eq '');
my $display_part=&get_display_part($partid,$symb);
foreach my $matchKey (@matchKey) {
if (exists($$record{$version.':'.$matchKey}) &&
$$record{$version.':'.$matchKey} ne '') {
-
- my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
- : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
- $displaySub[0].='';
- $displaySub[0].=''.&mt('Part: [_1]',$display_part).''
- .' '
- .'('.&mt('Response ID: [_1]',$responseId).')'
- .''
- .' ';
- if ($hidden) {
- $displaySub[0].= &mt('Anonymous Survey').'';
+ if ($is_tool) {
+ $displaySub[0].=$$record{"$version:resource.$partid.awarded"};
} else {
- my ($trial,$rndseed,$newvariation);
- if ($type eq 'randomizetry') {
- $trial = $$record{"$where.$partid.tries"};
- $rndseed = $$record{"$where.$partid.rndseed"};
- }
- if ($$record{"$where.$partid.tries"} eq '') {
- $displaySub[0].=&mt('Trial not counted');
- } else {
- $displaySub[0].=&mt('Trial: [_1]',
- $$record{"$where.$partid.tries"});
- if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) {
- if (($rndseed ne $lastrndseed{$partid}) &&
- (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) {
- $newvariation = ' ('.&mt('New variation this try').')';
- }
+ my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
+ : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
+ $displaySub[0].='';
+ $displaySub[0].=''.&mt('Part: [_1]',$display_part).''
+ .' '
+ .'('.&mt('Response ID: [_1]',$responseId).')'
+ .''
+ .' ';
+ if ($hidden) {
+ $displaySub[0].= &mt('Anonymous Survey').'';
+ } else {
+ my ($trial,$rndseed,$newvariation);
+ if ($type eq 'randomizetry') {
+ $trial = $$record{"$where.$partid.tries"};
+ $rndseed = $$record{"$where.$partid.rndseed"};
}
- $lastrndseed{$partid} = $rndseed;
- $lasttype{$partid} = $type;
- }
- my $responseType=($isTask ? 'Task'
+ if ($$record{"$where.$partid.tries"} eq '') {
+ $displaySub[0].=&mt('Trial not counted');
+ } else {
+ $displaySub[0].=&mt('Trial: [_1]',
+ $$record{"$where.$partid.tries"});
+ if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) {
+ if (($rndseed ne $lastrndseed{$partid}) &&
+ (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) {
+ $newvariation = ' ('.&mt('New variation this try').')';
+ }
+ }
+ $lastrndseed{$partid} = $rndseed;
+ $lasttype{$partid} = $type;
+ }
+ my $responseType=($isTask ? 'Task'
: $responseType->{$partid}->{$responseId});
- if (!exists($orders{$partid})) { $orders{$partid}={}; }
- if ((!exists($orders{$partid}->{$responseId})) || ($trial)) {
- $orders{$partid}->{$responseId}=
- &get_order($partid,$responseId,$symb,$uname,$udom,
- $no_increment,$type,$trial,$rndseed);
- }
- $displaySub[0].=''.$newvariation.''; # /nobreak
- $displaySub[0].=' '.
- &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).' ';
+ if (!exists($orders{$partid})) { $orders{$partid}={}; }
+ if ((!exists($orders{$partid}->{$responseId})) || ($trial)) {
+ $orders{$partid}->{$responseId}=
+ &get_order($partid,$responseId,$symb,$uname,$udom,
+ $no_increment,$type,$trial,$rndseed);
+ }
+ $displaySub[0].=''.$newvariation.''; # /nobreak
+ $displaySub[0].=' '.
+ &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).' ';
+ }
}
}
}
@@ -5103,14 +5380,22 @@ sub displaySubByDates {
lc($$record{"$where.$partid.award"}).' '.
$mark{$$record{"$where.$partid.solved"}}.
' ';
+ } elsif (($is_tool) && (exists($$record{"$version:resource.$partid.solved"}))) {
+ if ($$record{"$version:resource.$partid.solved"} =~ /^(in|)correct_by_passback$/) {
+ $displaySub[1].=&mt('Grade passed back by external tool');
+ }
}
if (exists $$record{"$where.$partid.regrader"}) {
- $displaySub[2].=$$record{"$where.$partid.regrader"}.
- ' ('.&mt('Part').': '.$display_part.')';
+ $displaySub[2].=$$record{"$where.$partid.regrader"};
+ unless ($is_tool) {
+ $displaySub[2].=' ('.&mt('Part').': '.$display_part.')';
+ }
} elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
$displaySub[2].=
- $$record{"$version:resource.$partid.regrader"}.
- ' ('.&mt('Part').': '.$display_part.')';
+ $$record{"$version:resource.$partid.regrader"};
+ unless ($is_tool) {
+ $displaySub[2].=' ('.&mt('Part').': '.$display_part.')';
+ }
}
}
# needed because old essay regrader has not parts info
@@ -5369,7 +5654,7 @@ the homework problem.
sub defaultFormData {
my ($symb)=@_;
- return '';
+ return '';
}
@@ -5522,7 +5807,7 @@ sub scantron_uploads {
sub scantron_scantab {
my $result='
'.&mt("If this information is correct, please click on '[_1]'.",&mt($button_text)).'
'.&mt('If something is incorrect, please return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','','').'
'.
+ &Apache::loncommon::end_data_table_row()."\n";
+ }
+ foreach my $sec (sort { $a <=> $b } keys(%bysec)) {
+ next if ($sec eq 'none');
+ $table .= &Apache::loncommon::start_data_table_row().
+ '
'.$sec.'
'.$bysec{$sec}.'
'.
+ &Apache::loncommon::end_data_table_row()."\n";
+ }
+ $table .= &Apache::loncommon::end_data_table()."\n";
+ $gradesections .= &mt('Sections represented in the bubblesheet data file (based on bubbled student IDs) are as follows:').
+ '
'.$table.'
';
+ if (@possibles) {
+ $gradesections .= '
'.
+ &mt('You have role(s) in [quant,_1,other section,other sections] with privileges to manage grades.',
+ scalar(@possibles)).' '.
+ &mt('Check which of those section(s), in addition to section [_1], you wish to grade using this bubblesheet file:',
+ ''.$checksec.'').' ';
+ foreach my $sec (sort {$a <=> $b } @possibles) {
+ $gradesections .= ''.(' 'x2);
+ }
+ $gradesections .= '
';
+ }
+ }
+ } else {
+ $gradesections = '
'.&mt('The selected file is unavailable').'
';
+ }
+ }
my $bubbledbyhand=&hand_bubble_option();
$r->print('
-'.$warning.$bubbledbyhand.'
+'.$warning.$gradesections.$bubbledbyhand.'
');
@@ -6969,11 +7155,42 @@ sub scantron_validate_file {
if ($env{'form.scantron_corrections'}) {
&scantron_process_corrections($r);
}
- $r->print('
'.&mt('Gathering necessary information.').'
');$r->rflush();
+
+ $r->print('
'.&mt('Gathering necessary information.').'
');
+ my ($checksec,@gradable);
+ if ($env{'request.course.sec'}) {
+ ($checksec,my @possibles) = &gradable_sections();
+ if ($checksec) {
+ if (@possibles) {
+ my @chosensecs = &Apache::loncommon::get_env_multiple('form.scantron_othersections');
+ if (@chosensecs) {
+ foreach my $sec (@chosensecs) {
+ if (grep(/^\Q$sec\E$/,@possibles)) {
+ unless (grep(/^\Q$sec\E$/,@gradable)) {
+ push(@gradable,$sec);
+ }
+ }
+ }
+ }
+ }
+ $r->print('
');
+ if (@gradable) {
+ my @showsections = sort { $a <=> $b } (@gradable,$checksec);
+ $r->print(
+ '
'.&mt('Sections to be Graded:').'
'.join(', ',@showsections).'
');
+ } else {
+ $r->print(
+ '
'.&mt('Section to be Graded:').'
'.$checksec.'
');
+ }
+ $r->print('
');
+ }
+ }
+ $r->rflush();
+
#get the student pick code ready
$r->print(&Apache::loncommon::studentbrowser_javascript());
my $nav_error;
- my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'});
my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);
if ($nav_error) {
$r->print(&navmap_errormsg());
@@ -6994,7 +7211,7 @@ sub scantron_validate_file {
$env{'form.validatepass'} = 0;
}
my $currentphase=$env{'form.validatepass'};
-
+ my %skipbysec=();
my $stop=0;
while (!$stop && $currentphase < scalar(@validate_phases)) {
@@ -7004,13 +7221,29 @@ sub scantron_validate_file {
my $which="scantron_validate_".$validate_phases[$currentphase];
{
no strict 'refs';
- ($stop,$currentphase)=&$which($r,$currentphase);
+ my @extras=();
+ if ($validate_phases[$currentphase] eq 'ID') {
+ @extras = (\%skipbysec,$checksec,@gradable);
+ }
+ ($stop,$currentphase)=&$which($r,$currentphase,@extras);
}
}
if (!$stop) {
my $warning=&scantron_warning_screen('Start Grading',$symb);
+ my $secinfo;
+ if (keys(%skipbysec) > 0) {
+ my $seclist = '
'.
+ &mt('Numbers of records for students in sections not being graded [_1]',
+ $seclist).
+ '
';
+ }
$r->print(&mt('Validation process complete.').' '.
- $warning.
+ $secinfo.$warning.
&mt('Perform verification for each student after storage of submissions?').
' '.
@@ -7426,14 +7659,15 @@ sub scantron_validate_sequence {
sub scantron_validate_ID {
- my ($r,$currentphase) = @_;
+ my ($r,$currentphase,$skipbysec,$checksec,@gradable) = @_;
#get student info
my $classlist=&Apache::loncoursedata::get_classlist();
my %idmap=&username_to_idmap($classlist);
+ my $secidx = &Apache::loncoursedata::CL_SECTION();
#get scantron line setup
- my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
my $nav_error;
@@ -7444,6 +7678,7 @@ sub scantron_validate_ID {
}
my %found=('ids'=>{},'usernames'=>{});
+ my $unsavedskips = 0;
for (my $i=0;$i<=$scanlines->{'count'};$i++) {
my $line=&scantron_get_line($scanlines,$scan_data,$i);
if ($line=~/^[\s\cz]*$/) { next; }
@@ -7456,13 +7691,41 @@ sub scantron_validate_ID {
}
if ($found) {
my $username=$idmap{$found};
+ if ($checksec) {
+ if (ref($classlist->{$username}) eq 'ARRAY') {
+ my $stusec = $classlist->{$username}->[$secidx];
+ if ($stusec ne $checksec) {
+ unless ((@gradable > 0) && (grep(/^\Q$stusec\E$/,@gradable))) {
+ my $skip=1;
+ &scantron_put_line($scanlines,$scan_data,$i,$line,$skip);
+ if (ref($skipbysec) eq 'HASH') {
+ if ($stusec eq '') {
+ $skipbysec->{'none'} ++;
+ } else {
+ $skipbysec->{$stusec} ++;
+ }
+ }
+ $unsavedskips ++;
+ next;
+ }
+ }
+ }
+ }
if ($found{'ids'}{$found}) {
&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
$line,'duplicateID',$found);
+ if ($unsavedskips) {
+ &scantron_putfile($scanlines,$scan_data);
+ $unsavedskips = 0;
+ }
return(1,$currentphase);
} elsif ($found{'usernames'}{$username}) {
&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
$line,'duplicateID',$username);
+ if ($unsavedskips) {
+ &scantron_putfile($scanlines,$scan_data);
+ $unsavedskips = 0;
+ }
return(1,$currentphase);
}
#FIXME store away line we previously saw the ID on to use above
@@ -7471,29 +7734,95 @@ sub scantron_validate_ID {
} else {
if ($id =~ /^\s*$/) {
my $username=&scan_data($scan_data,"$i.user");
- if (defined($username) && $found{'usernames'}{$username}) {
+ if (($checksec && $username ne '')) {
+ if (ref($classlist->{$username}) eq 'ARRAY') {
+ my $stusec = $classlist->{$username}->[$secidx];
+ if ($stusec ne $checksec) {
+ unless ((@gradable > 0) && (grep(/^\Q$stusec\E$/,@gradable))) {
+ my $skip=1;
+ &scantron_put_line($scanlines,$scan_data,$i,$line,$skip);
+ if (ref($skipbysec) eq 'HASH') {
+ if ($stusec eq '') {
+ $skipbysec->{'none'} ++;
+ } else {
+ $skipbysec->{$stusec} ++;
+ }
+ }
+ $unsavedskips ++;
+ next;
+ }
+ }
+ }
+ } elsif (defined($username) && $found{'usernames'}{$username}) {
&scantron_get_correction($r,$i,$scan_record,
\%scantron_config,
$line,'duplicateID',$username);
+ if ($unsavedskips) {
+ &scantron_putfile($scanlines,$scan_data);
+ $unsavedskips = 0;
+ }
return(1,$currentphase);
} elsif (!defined($username)) {
&scantron_get_correction($r,$i,$scan_record,
\%scantron_config,
$line,'incorrectID');
+ if ($unsavedskips) {
+ &scantron_putfile($scanlines,$scan_data);
+ $unsavedskips = 0;
+ }
return(1,$currentphase);
}
$found{'usernames'}{$username}++;
} else {
&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
$line,'incorrectID');
+ if ($unsavedskips) {
+ &scantron_putfile($scanlines,$scan_data);
+ $unsavedskips = 0;
+ }
return(1,$currentphase);
}
}
}
-
+ if ($unsavedskips) {
+ &scantron_putfile($scanlines,$scan_data);
+ $unsavedskips = 0;
+ }
return (0,$currentphase+1);
}
+sub scantron_get_sections {
+ my %bysec;
+ if ($env{'form.scantron_format'} ne '') {
+ my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'});
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ my $classlist=&Apache::loncoursedata::get_classlist();
+ my %idmap=&username_to_idmap($classlist);
+ foreach my $key (keys(%idmap)) {
+ my $lckey = lc($key);
+ $idmap{$lckey} = $idmap{$key};
+ }
+ my $secidx = &Apache::loncoursedata::CL_SECTION();
+ for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ my $line=&scantron_get_line($scanlines,$scan_data,$i);
+ if ($line=~/^[\s\cz]*$/) { next; }
+ my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
+ $scan_data);
+ my $id=lc($$scan_record{'scantron.ID'});
+ if (exists($idmap{$id})) {
+ if (ref($classlist->{$idmap{$id}}) eq 'ARRAY') {
+ my $stusec = $classlist->{$idmap{$id}}->[$secidx];
+ if ($stusec eq '') {
+ $bysec{'none'} ++;
+ } else {
+ $bysec{$stusec} ++;
+ }
+ }
+ }
+ }
+ }
+ return %bysec;
+}
sub scantron_get_correction {
my ($r,$i,$scan_record,$scan_config,$line,$error,$arg,
@@ -7680,7 +8009,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((<new();
@@ -8323,7 +8652,7 @@ sub scantron_validate_missingbubbles {
&Apache::lonnet::decode_symb($env{'form.selectpage'});
#get scantron line setup
- my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
my $navmap = Apache::lonnavmaps::navmap->new();
@@ -8452,7 +8781,7 @@ sub hand_bubble_option {
}
}
if ($needs_hand_bubbles) {
- my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'});
my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
return &mt('The sequence to be graded contains response types which are handgraded.').'
'.
&mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?',' ').
@@ -8471,7 +8800,7 @@ sub scantron_process_students {
}
my $default_form_data=&defaultFormData($symb);
- my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my %scantron_config=&Apache::lonnet::get_scantron_config($env{'form.scantron_format'});
my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
my ($scanlines,$scan_data)=&scantron_getfile();
my $classlist=&Apache::loncoursedata::get_classlist();
@@ -8511,9 +8840,10 @@ sub scantron_process_students {
SCANTRONFORM
$r->print($result);
+ my ($checksec,@possibles)=&gradable_sections();
my @delayqueue;
my (%completedstudents,%scandata);
-
+
my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
my $count=&get_todo_count($scanlines,$scan_data);
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
@@ -8539,7 +8869,7 @@ SCANTRONFORM
return ''; # Dunno why the other returns return '' rather than just returning.
}
- my %lettdig = &letter_to_digits();
+ my %lettdig = &Apache::lonnet::letter_to_digits();
my $numletts = scalar(keys(%lettdig));
my %orderedforcode;
@@ -8573,6 +8903,13 @@ SCANTRONFORM
next;
}
my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
+ if (($checksec ne '') && ($checksec ne $usec)) {
+ unless (grep(/^\Q$usec\E$/,@possibles)) {
+ &scantron_add_delay(\@delayqueue,$line,
+ "No role with manage grades privilege in student's section ($usec)",3);
+ next;
+ }
+ }
my $user = $uname.':'.$usec;
($uname,$udom)=split(/:/,$uname);
@@ -8601,9 +8938,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};
@@ -8859,8 +9201,9 @@ sub grade_student_bubbles {
}
sub scantron_upload_scantron_data {
- my ($r,$symb)=@_;
+ my ($r,$symb) = @_;
my $dom = $env{'request.role.domain'};
+ my ($formatoptions,$formattitle,$formatjs) = &scantron_upload_dataformat($dom);
my $domdesc = &Apache::lonnet::domain($dom,'description');
$r->print(&Apache::loncommon::coursebrowser_javascript($dom));
my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',
@@ -8900,6 +9243,7 @@ sub scantron_upload_scantron_data {
return;
}
+ '.$formatjs.'
'));
$r->print('
'.&mt('Send bubblesheet data to a course').'
@@ -8915,7 +9259,12 @@ sub scantron_upload_scantron_data {
&Apache::lonhtmlcommon::row_closure().
&Apache::lonhtmlcommon::row_title(&mt('Domain')).
''.$domdesc.
- &Apache::lonhtmlcommon::row_closure().
+ &Apache::lonhtmlcommon::row_closure());
+ if ($formatoptions) {
+ $r->print(&Apache::lonhtmlcommon::row_title($formattitle).$formatoptions.
+ &Apache::lonhtmlcommon::row_closure());
+ }
+ $r->print(
&Apache::lonhtmlcommon::row_title(&mt('File to upload')).
''.
&Apache::lonhtmlcommon::row_closure(1).
@@ -8928,9 +9277,87 @@ sub scantron_upload_scantron_data {
return '';
}
+sub scantron_upload_dataformat {
+ my ($dom) = @_;
+ my ($formatoptions,$formattitle,$formatjs);
+ $formatjs = <<'END';
+function toggleScantab(form) {
+ return;
+}
+END
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$dom);
+ if (ref($domconfig{'scantron'}) eq 'HASH') {
+ if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') {
+ if (keys(%{$domconfig{'scantron'}{'config'}}) > 1) {
+ if (($domconfig{'scantron'}{'config'}{'dat'}) &&
+ (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH')) {
+ if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') {
+ if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) {
+ my ($onclick,$formatextra,$singleline);
+ my @lines = &Apache::lonnet::get_scantronformat_file();
+ my $count = 0;
+ foreach my $line (@lines) {
+ next if ($line =~ /^#/);
+ $singleline = $line;
+ $count ++;
+ }
+ if ($count > 1) {
+ $formatextra = '
';
+ $onclick = ' onclick="toggleScantab(this.form);"';
+ $formatjs = <<"END";
+function toggleScantab(form) {
+ var divid = 'bubbletype';
+ if (document.getElementById(divid)) {
+ var radioname = 'fileformat';
+ var num = form.elements[radioname].length;
+ if (num) {
+ for (var i=0; i';
+ }
+ $formattitle = &mt('File format');
+ $formatoptions = ''.(' 'x2).
+ ''.$formatextra;
+ }
+ }
+ }
+ } elsif (keys(%{$domconfig{'scantron'}{'config'}}) == 1) {
+ if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') {
+ if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}})) {
+ $formattitle = &mt('Bubblesheet type');
+ $formatoptions = &scantron_scantab();
+ }
+ }
+ }
+ }
+ }
+ return ($formatoptions,$formattitle,$formatjs);
+}
sub scantron_upload_scantron_data_save {
- my($r,$symb)=@_;
+ my ($r,$symb) = @_;
my $doanotherupload=
' '."\n";
if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) &&
!&Apache::lonnet::allowed('usc',
- $env{'form.domainid'}.'_'.$env{'form.courseid'})) {
+ $env{'form.domainid'}.'_'.$env{'form.courseid'}) &&
+ !&Apache::lonnet::allowed('usc',
+ $env{'form.domainid'}.'_'.$env{'form.courseid'}.'/'.$env{'form.coursesec'})) {
$r->print(&mt("You are not allowed to upload bubblesheet data to the requested course.")." ");
unless ($symb) {
$r->print($doanotherupload);
@@ -8954,8 +9383,38 @@ sub scantron_upload_scantron_data_save {
&mt('The file: [_1] you attempted to upload contained no information. Please check that you entered the correct filename.',
''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''),1));
} else {
- my $result =
- &Apache::lonnet::userfileupload('upfile','','scantron','','','',
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$env{'form.domainid'});
+ my $parser;
+ if (ref($domconfig{'scantron'}) eq 'HASH') {
+ if (ref($domconfig{'scantron'}{'config'}) eq 'HASH') {
+ my $is_csv;
+ my @possibles = keys(%{$domconfig{'scantron'}{'config'}});
+ if (@possibles > 1) {
+ if ($env{'form.fileformat'} eq 'csv') {
+ if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') {
+ if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') {
+ if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) {
+ $is_csv = 1;
+ }
+ }
+ }
+ }
+ } elsif (@possibles == 1) {
+ if (ref($domconfig{'scantron'}{'config'}{'csv'}) eq 'HASH') {
+ if (ref($domconfig{'scantron'}{'config'}{'csv'}{'fields'}) eq 'HASH') {
+ if (keys(%{$domconfig{'scantron'}{'config'}{'csv'}{'fields'}}) > 1) {
+ $is_csv = 1;
+ }
+ }
+ }
+ }
+ if ($is_csv) {
+ $parser = $domconfig{'scantron'}{'config'}{'csv'};
+ }
+ }
+ }
+ my $result =
+ &Apache::lonnet::userfileupload('upfile','scantron','scantron',$parser,'','',
$env{'form.courseid'},$env{'form.domainid'});
if ($result =~ m{^/uploaded/}) {
$r->print(
@@ -8964,8 +9423,17 @@ sub scantron_upload_scantron_data_save {
(length($env{'form.upfile'})-1),
''.$result.''));
($uploadedfile) = ($result =~ m{/([^/]+)$});
+ if ($uploadedfile =~ /^scantron_orig_/) {
+ my $logname = $uploadedfile;
+ $logname =~ s/^scantron_orig_//;
+ if ($logname ne '') {
+ my $now = time;
+ my %info = ($logname => { $now => $env{'user.name'}.':'.$env{'user.domain'} });
+ &Apache::lonnet::put('scantronupload',\%info,$env{'form.domainid'},$env{'form.courseid'});
+ }
+ }
$r->print(&validate_uploaded_scantron_file($env{'form.domainid'},
- $env{'form.courseid'},$uploadedfile));
+ $env{'form.courseid'},$symb,$uploadedfile));
} else {
$r->print(
&Apache::lonhtmlcommon::confirm_success(&mt('Upload failed'),1).' '.
@@ -8983,13 +9451,34 @@ sub scantron_upload_scantron_data_save {
}
sub validate_uploaded_scantron_file {
- my ($cdom,$cname,$fname) = @_;
+ my ($cdom,$cname,$symb,$fname,$context,$countsref) = @_;
+
my $scanlines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.$fname);
my @lines;
if ($scanlines ne '-1') {
@lines=split("\n",$scanlines,-1);
}
- my $output;
+ my ($output,$secidx,$checksec,$priv,%crsroleshash,@possibles);
+ $secidx = &Apache::loncoursedata::CL_SECTION();
+ if ($context eq 'download') {
+ $priv = 'mgr';
+ } else {
+ $priv = 'usc';
+ }
+ unless ((&Apache::lonnet::allowed($priv,$env{'request.role.domain'})) ||
+ (($env{'request.course.id'}) &&
+ (&Apache::lonnet::allowed($priv,$env{'request.course.id'})))) {
+ if ($env{'request.course.sec'} ne '') {
+ unless (&Apache::lonnet::allowed($priv,
+ "$env{'request.course.id'}/$env{'request.course.sec'}")) {
+ unless ($context eq 'download') {
+ $output = '
'.&mt('You do not have permission to upload bubblesheet data').'
';
+ }
+ return $output;
+ }
+ ($checksec,@possibles)=&gradable_sections();
+ }
+ }
if (@lines) {
my (%counts,$max_match_format);
my ($found_match_count,$max_match_count,$max_match_pct) = (0,0,0);
@@ -9000,7 +9489,7 @@ sub validate_uploaded_scantron_file {
$idmap{$lckey} = $idmap{$key};
}
my %unique_formats;
- my @formatlines = &get_scantronformat_file();
+ my @formatlines = &Apache::lonnet::get_scantronformat_file();
foreach my $line (@formatlines) {
chomp($line);
my @config = split(/:/,$line);
@@ -9019,6 +9508,8 @@ sub validate_uploaded_scantron_file {
%{$counts{$key}} = (
'found' => 0,
'total' => 0,
+ 'totalanysec' => 0,
+ 'othersec' => 0,
);
foreach my $line (@lines) {
next if ($line =~ /^#/);
@@ -9026,6 +9517,23 @@ sub validate_uploaded_scantron_file {
my $id = substr($line,$idstart-1,$idlength);
$id = lc($id);
if (exists($idmap{$id})) {
+ if ($checksec ne '') {
+ $counts{$key}{'totalanysec'} ++;
+ if (ref($classlist->{$idmap{$id}}) eq 'ARRAY') {
+ my $stusec = $classlist->{$idmap{$id}}->[$secidx];
+ if ($stusec ne $checksec) {
+ if (@possibles) {
+ unless (grep(/^\Q$stusec\E$/,@possibles)) {
+ $counts{$key}{'othersec'} ++;
+ next;
+ }
+ } else {
+ $counts{$key}{'othersec'} ++;
+ next;
+ }
+ }
+ }
+ }
$counts{$key}{'found'} ++;
}
$counts{$key}{'total'} ++;
@@ -9040,7 +9548,7 @@ sub validate_uploaded_scantron_file {
}
}
}
- if (ref($unique_formats{$max_match_format}) eq 'ARRAY') {
+ if ((ref($unique_formats{$max_match_format}) eq 'ARRAY') && ($context ne 'download')) {
my $format_descs;
my $numwithformat = @{$unique_formats{$max_match_format}};
for (my $i=0; $i<$numwithformat; $i++) {
@@ -9085,13 +9593,179 @@ sub validate_uploaded_scantron_file {
'
'.&mt('The course roster is not up to date.').'
'.
'';
}
+ if (($checksec ne '') && (ref($counts{$max_match_format}) eq 'HASH')) {
+ if ($counts{$max_match_format}{'othersec'}) {
+ my $percent_nongrade = (100*$counts{$max_match_format}{'othersec'})/($counts{$max_match_format}{'totalanysec'});
+ my $showpct = sprintf("%.0f",$percent_nongrade).'%';
+ my $confirmdel = &mt('Are you sure you want to permanently delete this file?');
+ &js_escape(\$confirmdel);
+ $output .= '
'.
+ &mt('Comparison of student IDs in the uploaded file with the course roster found [_1][quant,_2,match,matches][_3] for students in section(s) for which none of your role(s) have privileges to modify grades',
+ '',$counts{$max_match_format}{'othersec'},'').
+ ' '.
+ &mt('Unless you are assigned role(s) which allow modification of grades in additional sections, [_1] of the records in this file will be automatically excluded when you perform bubblesheet grading.',''.$showpct.'').
+ '
'.
+ &mt('If you prefer to delete the file now, use: [_1]').
+ '
';
}
return $output;
}
+sub gradable_sections {
+ my $checksec = $env{'request.course.sec'};
+ my @oksecs;
+ if ($checksec) {
+ my %availablesecs = §ions_grade_privs();
+ if (ref($availablesecs{'mgr'}) eq 'ARRAY') {
+ foreach my $sec (@{$availablesecs{'mgr'}}) {
+ unless (grep(/^\Q$sec\E$/,@oksecs)) {
+ push(@oksecs,$sec);
+ }
+ }
+ if (grep(/^all$/,@oksecs)) {
+ undef($checksec);
+ }
+ }
+ }
+ return($checksec,@oksecs);
+}
+
+sub sections_grade_privs {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my %availablesecs = (
+ mgr => [],
+ vgr => [],
+ usc => [],
+ );
+ my $ccrole = 'cc';
+ if ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Community') {
+ $ccrole = 'co';
+ }
+ my %crsroleshash = &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},
+ 'userroles',['active'],
+ [$ccrole,'in','cr'],$cdom,1);
+ my $crsid = $cnum.':'.$cdom;
+ foreach my $item (keys(%crsroleshash)) {
+ next unless ($item =~ /^$crsid\:/);
+ my ($crsnum,$crsdom,$role,$sec) = split(/\:/,$item);
+ my $suffix = "/$cdom/$cnum./$cdom/$cnum";
+ if ($sec ne '') {
+ $suffix = "/$cdom/$cnum/$sec./$cdom/$cnum/$sec";
+ }
+ if (($role eq $ccrole) || ($role eq 'in')) {
+ foreach my $priv ('mgr','vgr','usc') {
+ unless (grep(/^all$/,@{$availablesecs{$priv}})) {
+ if ($sec eq '') {
+ $availablesecs{$priv} = ['all'];
+ } elsif ($sec ne $env{'request.course.sec'}) {
+ unless (grep(/^\Q$sec\E$/,@{$availablesecs{$priv}})) {
+ push(@{$availablesecs{$priv}},$sec);
+ }
+ }
+ }
+ }
+ } elsif ($role =~ m{^cr/}) {
+ foreach my $priv ('mgr','vgr','usc') {
+ unless (grep(/^all$/,@{$availablesecs{$priv}})) {
+ if ($env{"user.priv.$role.$suffix"} =~ /:$priv&/) {
+ if ($sec eq '') {
+ $availablesecs{$priv} = ['all'];
+ } elsif ($sec ne $env{'request.course.sec'}) {
+ unless (grep(/^\Q$sec\E$/,@{$availablesecs{$priv}})) {
+ push(@{$availablesecs{$priv}},$sec);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return %availablesecs;
+}
+
+sub scantron_upload_delete {
+ my ($r,$symb) = @_;
+ my $filename = $env{'form.uploadedfile'};
+ if ($filename =~ /^scantron_orig_/) {
+ if (&Apache::lonnet::allowed('usc',$env{'form.domainid'}) ||
+ &Apache::lonnet::allowed('usc',
+ $env{'form.domainid'}.'_'.$env{'form.courseid'}) ||
+ &Apache::lonnet::allowed('usc',
+ $env{'form.domainid'}.'_'.$env{'form.courseid'}.'/'.$env{'form.coursesec'})) {
+ my $uploadurl = '/uploaded/'.$env{'form.domainid'}.'/'.$env{'form.courseid'}.'/'.$env{'form.uploadedfile'};
+ my $retrieval = &Apache::lonnet::getfile($uploadurl);
+ if ($retrieval eq '-1') {
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).' '.
+ &mt('File requested for deletion not found.'));
+ } else {
+ $filename =~ s/^scantron_orig_//;
+ if ($filename ne '') {
+ my ($is_valid,$numleft);
+ my %info = &Apache::lonnet::get('scantronupload',[$filename],$env{'form.domainid'},$env{'form.courseid'});
+ if (keys(%info)) {
+ if (ref($info{$filename}) eq 'HASH') {
+ foreach my $timestamp (sort(keys(%{$info{$filename}}))) {
+ if ($info{$filename}{$timestamp} eq $env{'user.name'}.':'.$env{'user.domain'}) {
+ $is_valid = 1;
+ delete($info{$filename}{$timestamp});
+ }
+ }
+ $numleft = scalar(keys(%{$info{$filename}}));
+ }
+ }
+ if ($is_valid) {
+ my $result = &Apache::lonnet::removeuploadedurl($uploadurl);
+ if ($result eq 'ok') {
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion successful')).' ');
+ if ($numleft) {
+ &Apache::lonnet::put('scantronupload',\%info,$env{'form.domainid'},$env{'form.courseid'});
+ } else {
+ &Apache::lonnet::del('scantronupload',[$filename],$env{'form.domainid'},$env{'form.courseid'});
+ }
+ } else {
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).' '.
+ &mt('Result was [_1]',$result));
+ }
+ } else {
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).' '.
+ &mt('File requested for deletion was uploaded by a different user.'));
+ }
+ } else {
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).' '.
+ &mt('Filename of bubblesheet data file requested for deletion is invalid.'));
+ }
+ }
+ } else {
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).' '.
+ &mt('You are not permitted to delete bubblesheet data files from the requested course.'));
+ }
+ } else {
+ $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('File deletion failed'),1).' '.
+ &mt('Filename of bubblesheet data file requested for deletion is invalid.'));
+ }
+ return;
+}
+
sub valid_file {
my ($requested_file)=@_;
foreach my $filename (sort(&scantron_filenames())) {
@@ -9101,7 +9775,7 @@ sub valid_file {
}
sub scantron_download_scantron_data {
- my ($r,$symb)=@_;
+ my ($r,$symb) = @_;
my $default_form_data=&defaultFormData($symb);
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
@@ -9114,6 +9788,29 @@ sub scantron_download_scantron_data {
');
return;
}
+ my (%uploader,$is_owner,%counts,$percent);
+ my %uploader = &Apache::lonnet::get('scantronupload',[$file],$cdom,$cname);
+ if (ref($uploader{$file}) eq 'HASH') {
+ foreach my $timestamp (sort { $a <=> $b } keys(%{$uploader{$file}})) {
+ if ($uploader{$file}{$timestamp} eq $env{'user.name'}.':'.$env{'user.domain'}) {
+ $is_owner = 1;
+ last;
+ }
+ }
+ }
+ unless ($is_owner) {
+ &validate_uploaded_scantron_file($cdom,$cname,$symb,'scantron_orig_'.$file,'download',\%counts);
+ if ($counts{'totalanysec'}) {
+ my $percent_othersec = (100*$counts{'othersec'})/($counts{'totalanysec'});
+ if ($percent_othersec >= 10) {
+ my $showpct = sprintf("%.0f",$percent_othersec).'%';
+ $r->print('
'.
+ &mt('The original uploaded file includes [_1] or more of records for students for which none of your roles have rights to modify grades, so files are unavailable for download.',$showpct).
+ '
');
+ return;
+ }
+ }
+ }
my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;
my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file;
my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file;
@@ -9141,16 +9838,16 @@ sub checkscantron_results {
my ($r,$symb) = @_;
if (!$symb) {return '';}
my $cid = $env{'request.course.id'};
- my %lettdig = &letter_to_digits();
+ my %lettdig = &Apache::lonnet::letter_to_digits();
my $numletts = scalar(keys(%lettdig));
my $cnum = $env{'course.'.$cid.'.num'};
my $cdom = $env{'course.'.$cid.'.domain'};
my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'});
my %record;
my %scantron_config =
- &Apache::grades::get_scantron_config($env{'form.scantron_format'});
+ &Apache::lonnet::get_scantron_config($env{'form.scantron_format'});
my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
- my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
+ my ($scanlines,$scan_data)=&scantron_getfile();
my $classlist=&Apache::loncoursedata::get_classlist();
my %idmap=&Apache::grades::username_to_idmap($classlist);
my $navmap=Apache::lonnavmaps::navmap->new();
@@ -9258,10 +9955,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};
}
@@ -9468,23 +10169,6 @@ sub verify_scantron_grading {
return ($counter,$record);
}
-sub letter_to_digits {
- my %lettdig = (
- A => 1,
- B => 2,
- C => 3,
- D => 4,
- E => 5,
- F => 6,
- G => 7,
- H => 8,
- I => 9,
- J => 0,
- );
- return %lettdig;
-}
-
-
#-------- end of section for handling grading scantron forms -------
#
#-------------------------------------------------------------------
@@ -9539,7 +10223,7 @@ sub grading_menu {
icon => 'grade_students.png',
linktitle => 'Grade current resource for a selection of students.'
},
- { linktext => 'Grade ungraded submissions.',
+ { linktext => 'Grade ungraded submissions',
url => $url1b,
permission => 'F',
icon => 'ungrade_sub.png',
@@ -9605,7 +10289,6 @@ sub grading_menu {
return $Str;
}
-
sub ungraded {
my ($request)=@_;
&submit_options($request);
@@ -9633,12 +10316,13 @@ sub submit_options_table {
my ($request,$symb) = @_;
if (!$symb) {return '';}
&commonJSfunctions($request);
+ my $is_tool = ($symb =~ /ext\.tool$/);
my $result;
$result.='