'."\n";
if (scalar(%$fullname) eq 0) {
my $colspan=3+scalar(@parts);
- $result=''.
+ ' '.
+ "\n".$ctr.' '.
''.$fullname.' '.
- '('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).') '."\n";
+ '('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).') '."\n";
+ $student=~s/:/_/; # colon doen't work in javascript for names
foreach my $apart (@$parts) {
my ($part,$type) = &split_part_type($apart);
my $score=$record{"resource.$part.$type"};
+ $result.='';
+ my ($aggtries,$totaltries);
+ unless (exists($aggregates{$part})) {
+ $totaltries = $record{'resource.'.$part.'.tries'};
+
+ $aggtries = $totaltries;
+ if ($$last_resets{$part}) {
+ $aggtries = &get_num_tries(\%record,$$last_resets{$part},
+ $part);
+ }
+ $result.=' '."\n";
+ $result.=' '."\n";
+ $aggregates{$part} = 1;
+ }
if ($type eq 'awarded') {
- my $pts = $score eq '' ? '' : $score*$$weight{$part};
+ my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part});
$result.=' '."\n";
- $result.=' '."\n";
@@ -2427,7 +2904,7 @@ sub viewstudentgrade {
$status = 'nothing' if ($status eq '');
$result.=' '."\n";
- $result.=' '."\n";
$result.= (($status eq 'excused') ? ' excused '
@@ -2438,7 +2915,7 @@ sub viewstudentgrade {
$result.=' '.
"\n";
- $result.=' '."\n";
}
@@ -2452,11 +2929,11 @@ sub viewstudentgrade {
sub editgrades {
my ($request) = @_;
- my $symb=$ENV{'form.symb'};
- my $url =$ENV{'form.url'};
+ my $symb=$env{'form.symb'};
+ my $url =$env{'form.url'};
my $title='Current Grade Status ';
- $title.='Current Resource: '.$ENV{'form.probTitle'}.' '."\n";
- $title.='Section: '.$ENV{'form.section'}.' '."\n";
+ $title.='Current Resource: '.$env{'form.probTitle'}.' '."\n";
+ $title.='Section: '.$env{'form.section'}.' '."\n";
my $result= ''."\n";
$result.= ''.
@@ -2470,7 +2947,7 @@ sub editgrades {
'ungraded' =>'ungraded_attempted',
'nothing' => '',
);
- my ($classlist,undef,$fullname) = &getclasslist($ENV{'form.section'},'0');
+ my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0');
my (@partid);
my %weight = ();
@@ -2479,10 +2956,10 @@ sub editgrades {
my (@parts) = sort(&getpartlist($url,$symb));
my $header;
- while ($ctr < $ENV{'form.totalparts'}) {
- my $partid = $ENV{'form.partid_'.$ctr};
+ while ($ctr < $env{'form.totalparts'}) {
+ my $partid = $env{'form.partid_'.$ctr};
push @partid,$partid;
- $weight{$partid} = $ENV{'form.weight_'.$partid};
+ $weight{$partid} = $env{'form.weight_'.$partid};
$ctr++;
}
foreach my $partid (@partid) {
@@ -2502,9 +2979,10 @@ sub editgrades {
}
}
foreach my $partid (@partid) {
+ my $display_part=&get_display_part($partid,$url,$symb);
$result .= 'Part '.$partid.
- ' (Weight = '.$weight{$partid}.') ';
+ '" align="center">Part: '.$display_part.
+ ' (Weight = '.$weight{$partid}.')';
}
$result .= ' ';
@@ -2512,49 +2990,57 @@ sub editgrades {
$result .= ' '."\n";
my $noupdate;
my ($updateCtr,$noupdateCtr) = (1,1);
- for ($i=0; $i<$ENV{'form.total'}; $i++) {
+ for ($i=0; $i<$env{'form.total'}; $i++) {
my $line;
- my $user = $ENV{'form.ctr'.$i};
- my $usercolon = $user;
- $usercolon =~s/_/:/;
- my ($uname,$udom)=split(/_/,$user);
+ my $user = $env{'form.ctr'.$i};
+ my ($uname,$udom)=split(/:/,$user);
my %newrecord;
my $updateflag = 0;
- $line .= ''.&nameUserString(undef,$$fullname{$usercolon},$uname,$udom).' ';
+ $line .= ''.&nameUserString(undef,$$fullname{$user},$uname,$udom).' ';
my $usec=$classlist->{"$uname:$udom"}[5];
if (!&canmodify($usec)) {
my $numcols=scalar(@partid)*4+2;
$noupdate.=$line."Not allowed to modify student ";
next;
}
+ my %aggregate = ();
+ my $aggregateflag = 0;
+ $user=~s/:/_/; # colon doen't work in javascript for names
foreach (@partid) {
- my $old_aw = $ENV{'form.GD_'.$user.'_'.$_.'_awarded_s'};
+ my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
my $old_part = $old_aw eq '' ? '' : $old_part_pcr;
- my $old_score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}};
-
- my $awarded = $ENV{'form.GD_'.$user.'_'.$_.'_awarded'};
+ my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
+ my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
my $partial = $awarded eq '' ? '' : $pcr;
my $score;
if ($partial eq '') {
- $score = $scoreptr{$ENV{'form.GD_'.$user.'_'.$_.'_solved_s'}};
+ $score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
} elsif ($partial > 0) {
$score = 'correct_by_override';
} elsif ($partial == 0) {
$score = 'incorrect_by_override';
}
- my $dropMenu = $ENV{'form.GD_'.$user.'_'.$_.'_solved'};
+ my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'};
$score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused'));
+ $newrecord{'resource.'.$_.'.regrader'}=
+ "$env{'user.name'}:$env{'user.domain'}";
if ($dropMenu eq 'reset status' &&
$old_score ne '') { # ignore if no previous attempts => nothing to reset
- $newrecord{'resource.'.$_.'.tries'} = 0;
+ $newrecord{'resource.'.$_.'.tries'} = '';
$newrecord{'resource.'.$_.'.solved'} = '';
$newrecord{'resource.'.$_.'.award'} = '';
- $newrecord{'resource.'.$_.'.awarded'} = 0;
- $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
+ $newrecord{'resource.'.$_.'.awarded'} = '';
$updateflag = 1;
+ if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) {
+ my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'};
+ my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'};
+ my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'};
+ &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus);
+ $aggregateflag = 1;
+ }
} elsif (!($old_part eq $partial && $old_score eq $score)) {
$updateflag = 1;
$newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne '';
@@ -2572,11 +3058,11 @@ 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 $old_aw = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'};
- my $awarded = $ENV{'form.GD_'.$user.'_'.$part.'_'.$type};
+ my $old_aw = $env{'form.GD_'.$user.'_'.$part.'_'.$type.'_s'};
+ my $awarded = $env{'form.GD_'.$user.'_'.$part.'_'.$type};
if ($awarded ne '' && $awarded ne $old_aw) {
$newrecord{'resource.'.$part.'.'.$type}= $awarded;
- $newrecord{'resource.'.$part.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
+ $newrecord{'resource.'.$part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
$updateflag=1;
}
$line .= ''.$old_aw.' '.
@@ -2584,27 +3070,59 @@ sub editgrades {
}
}
$line.=''."\n";
+
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+
if ($updateflag) {
$count++;
- &Apache::lonnet::cstore(\%newrecord,$symb,$ENV{'request.course.id'},
+ &Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'},
$udom,$uname);
+
+ if (&Apache::bridgetask::in_queue('gradingqueue',$symb,$cdom,
+ $cnum,$udom,$uname)) {
+ # need to figure out if should be in queue.
+ my %record =
+ &Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $udom,$uname);
+ my $all_graded = 1;
+ my $none_graded = 1;
+ foreach my $part (@parts) {
+ if ( $record{'resource.'.$part.'.awarded'} eq '' ) {
+ $all_graded = 0;
+ } else {
+ $none_graded = 0;
+ }
+ }
+
+ if ($all_graded || $none_graded) {
+ &Apache::bridgetask::remove_from_queue('gradingqueue',
+ $symb,$cdom,$cnum,
+ $udom,$uname);
+ }
+ }
+
$result.=' '.$updateCtr.' '.$line;
$updateCtr++;
} else {
$noupdate.=' '.$noupdateCtr.' '.$line;
$noupdateCtr++;
}
+ if ($aggregateflag) {
+ &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
+ $cdom,$cnum);
+ }
}
if ($noupdate) {
# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
my $numcols=scalar(@partid)*4+2;
- $result .= 'No Changes Occurred For the Students Below '.$noupdate;
+ $result .= 'No Changes Occurred For the Students Below '.$noupdate;
}
$result .= '
'."\n".
&show_grading_menu_form ($symb,$url);
my $msg = 'Number of records updated = '.$rec_update.
' for '.$count.' student'.($count <= 1 ? '' : 's').'. '.
- 'Total number of students = '.$ENV{'form.total'}.' ';
+ 'Total number of students = '.$env{'form.total'}.' ';
return $title.$msg.$result;
}
@@ -2627,24 +3145,26 @@ sub split_part_type {
#
#--- Javascript to handle csv upload
sub csvupload_javascript_reverse_associate {
+ my $error1=&mt('You need to specify the username or ID');
+ my $error2=&mt('You need to specify at least one grading field');
return(<2) { foundsomething=1; }
- }
- if (founduname==0 || founddomain==0) {
- alert('You need to specify at both the username and domain');
- return;
+ if (tw==1) { foundID=1; }
+ if (tw==2) { founduname=1; }
+ if (tw>3) { foundsomething=1; }
+ }
+ if (founduname==0 && foundID==0) {
+ alert('$error1');
+ return;
}
if (foundsomething==0) {
- alert('You need to specify at least one grading field');
- return;
+ alert('$error2');
+ return;
}
vf.submit();
}
@@ -2702,14 +3224,15 @@ ENDPICK
sub csvuploadmap_header {
my ($request,$symb,$url,$datatoken,$distotal)= @_;
my $javascript;
- if ($ENV{'form.upfile_associate'} eq 'reverse') {
+ if ($env{'form.upfile_associate'} eq 'reverse') {
$javascript=&csvupload_javascript_reverse_associate();
} else {
$javascript=&csvupload_javascript_forward_associate();
}
- my ($result) = &showResourceInfo($url,$ENV{'form.probTitle'});
-
+ my ($result) = &showResourceInfo($url,$env{'form.probTitle'});
+ my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
+ my $ignore=&mt('Ignore First Line');
$request->print(<
Uploading Class Grades
@@ -2720,18 +3243,19 @@ Total number of records found in file: $
Enter as many fields as you can. The system will inform you and bring you back
to this page if the data selected is insufficient to run your class.
+ $ignore
-
-
+
+
+ value="$env{'form.upfile_associate'}" />
-
-
-
+
+
+
CSVFORMJS
- $ENV{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
- my ($table) = &showResourceInfo($url,$ENV{'form.probTitle'});
+ return $result;
+}
+
+sub upcsvScores_form {
+ my ($request) = shift;
+ my ($symb,$url)=&get_symb_and_url($request);
+ if (!$symb) {return '';}
+ my $result=&checkforfile_js();
+ $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb);
+ my ($table) = &showResourceInfo($url,$env{'form.probTitle'});
$result.=$table;
$result.=''."\n";
$result.=''."\n";
@@ -2816,19 +3351,20 @@ sub csvuploadmap {
if (!$symb) {return '';}
my $datatoken;
- if (!$ENV{'form.datatoken'}) {
+ if (!$env{'form.datatoken'}) {
$datatoken=&Apache::loncommon::upfile_store($request);
} else {
- $datatoken=$ENV{'form.datatoken'};
+ $datatoken=$env{'form.datatoken'};
&Apache::loncommon::load_tmp_file($request);
}
my @records=&Apache::loncommon::upfile_record_sep();
+ if ($env{'form.noFirstLine'}) { shift(@records); }
&csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);
my ($i,$keyfields);
if (@records) {
my @fields=&csvupload_fields($url,$symb);
- if ($ENV{'form.upfile_associate'} eq 'reverse') {
+ if ($env{'form.upfile_associate'} eq 'reverse') {
&Apache::loncommon::csv_print_samples($request,\@records);
$i=&Apache::loncommon::csv_print_select_table($request,\@records,
\@fields);
@@ -2838,8 +3374,13 @@ sub csvuploadmap {
unshift(@fields,['none','']);
$i=&Apache::loncommon::csv_samples_select_table($request,\@records,
\@fields);
- my %sone=&Apache::loncommon::record_sep($records[0]);
- $keyfields=join(',',sort(keys(%sone)));
+ foreach my $rec (@records) {
+ my %temp = &Apache::loncommon::record_sep($rec);
+ if (%temp) {
+ $keyfields=join(',',sort(keys(%temp)));
+ last;
+ }
+ }
}
}
&csvuploadmap_footer($request,$i,$keyfields);
@@ -2848,39 +3389,106 @@ sub csvuploadmap {
return '';
}
-sub csvuploadassign {
+sub csvuploadoptions {
my ($request)= @_;
my ($symb,$url)=&get_symb_and_url($request);
- if (!$symb) {return '';}
- &Apache::loncommon::load_tmp_file($request);
- my @gradedata = &Apache::loncommon::upfile_record_sep();
- my @keyfields = split(/\,/,$ENV{'form.keyfields'});
- my %fields=();
- for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) {
- if ($ENV{'form.upfile_associate'} eq 'reverse') {
- if ($ENV{'form.f'.$i} ne 'none') {
- $fields{$keyfields[$i]}=$ENV{'form.f'.$i};
+ my $checked=(($env{'form.noFirstLine'})?'1':'0');
+ my $ignore=&mt('Ignore First Line');
+ $request->print(<
+Uploading Class Grade Options
+
+
+
+
+
+ Overwrite any existing score
+
+
+ENDPICK
+ my %fields=&get_fields();
+ if (!defined($fields{'domain'})) {
+ my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain');
+ $request->print("\n Users are in domain: ".$domform."
\n");
+ }
+ foreach my $key (sort(keys(%env))) {
+ if ($key !~ /^form\.(.*)$/) { next; }
+ my $cleankey=$1;
+ if ($cleankey eq 'command') { next; }
+ $request->print(' '."\n");
+ }
+ # FIXME do a check for any duplicated user ids...
+ # FIXME do a check for any invalid user ids?...
+ $request->print('
+ '."\n");
+ $request->print(&show_grading_menu_form($symb,$url));
+ return '';
+}
+
+sub get_fields {
+ my %fields;
+ my @keyfields = split(/\,/,$env{'form.keyfields'});
+ for (my $i=0; $i<=$env{'form.nfields'}; $i++) {
+ if ($env{'form.upfile_associate'} eq 'reverse') {
+ if ($env{'form.f'.$i} ne 'none') {
+ $fields{$keyfields[$i]}=$env{'form.f'.$i};
}
} else {
- if ($ENV{'form.f'.$i} ne 'none') {
- $fields{$ENV{'form.f'.$i}}=$keyfields[$i];
+ if ($env{'form.f'.$i} ne 'none') {
+ $fields{$env{'form.f'.$i}}=$keyfields[$i];
}
}
}
+ return %fields;
+}
+
+sub csvuploadassign {
+ my ($request)= @_;
+ my ($symb,$url)=&get_symb_and_url($request);
+ if (!$symb) {return '';}
+ &Apache::loncommon::load_tmp_file($request);
+ my @gradedata = &Apache::loncommon::upfile_record_sep();
+ if ($env{'form.noFirstLine'}) { shift(@gradedata); }
+ my %fields=&get_fields();
$request->print('Assigning Grades ');
- my $courseid=$ENV{'request.course.id'};
+ my $courseid=$env{'request.course.id'};
my ($classlist) = &getclasslist('all',0);
my @notallowed;
my @skipped;
my $countdone=0;
foreach my $grade (@gradedata) {
my %entries=&Apache::loncommon::record_sep($grade);
+ my $domain;
+ if ($entries{$fields{'domain'}}) {
+ $domain=$entries{$fields{'domain'}};
+ } else {
+ $domain=$env{'form.default_domain'};
+ }
+ $domain=~s/\s//g;
my $username=$entries{$fields{'username'}};
$username=~s/\s//g;
- my $domain=$entries{$fields{'domain'}};
- $domain=~s/\s//g;
+ if (!$username) {
+ my $id=$entries{$fields{'ID'}};
+ $id=~s/\s//g;
+ my %ids=&Apache::lonnet::idget($domain,$id);
+ $username=$ids{$id};
+ }
if (!exists($$classlist{"$username:$domain"})) {
- push(@skipped,"$username:$domain");
+ my $id=$entries{$fields{'ID'}};
+ $id=~s/\s//g;
+ if ($id) {
+ push(@skipped,"$id:$domain");
+ } else {
+ push(@skipped,"$username:$domain");
+ }
next;
}
my $usec=$classlist->{"$username:$domain"}[5];
@@ -2888,19 +3496,47 @@ sub csvuploadassign {
push(@notallowed,"$username:$domain");
next;
}
+ my %points;
my %grades;
foreach my $dest (keys(%fields)) {
- if ($dest eq 'username' || $dest eq 'domain') { next; }
- if ($entries{$fields{$dest}} eq '') { next; }
- my $store_key=$dest;
- $store_key=~s/^stores/resource/;
- $store_key=~s/_/\./g;
- $grades{$store_key}=$entries{$fields{$dest}};
- }
- $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
- &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'},
- $domain,$username);
- $request->print('.');
+ if ($dest eq 'ID' || $dest eq 'username' ||
+ $dest eq 'domain') { next; }
+ if ($entries{$fields{$dest}} =~ /^\s*$/) { next; }
+ if ($dest=~/stores_(.*)_points/) {
+ my $part=$1;
+ my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
+ $symb,$domain,$username);
+ $entries{$fields{$dest}}=~s/\s//g;
+ my $pcr=$entries{$fields{$dest}} / $wgt;
+ my $award='correct_by_override';
+ $grades{"resource.$part.awarded"}=$pcr;
+ $grades{"resource.$part.solved"}=$award;
+ $points{$part}=1;
+ } else {
+ if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
+ if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} }
+ my $store_key=$dest;
+ $store_key=~s/^stores/resource/;
+ $store_key=~s/_/\./g;
+ $grades{$store_key}=$entries{$fields{$dest}};
+ }
+ }
+ if (! %grades) { push(@skipped,"$username:$domain no data to store"); }
+ $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
+# &Apache::lonnet::logthis(" storing ".(join('-',%grades)));
+ my $result=&Apache::lonnet::cstore(\%grades,$symb,
+ $env{'request.course.id'},
+ $domain,$username);
+ if ($result eq 'ok') {
+ $request->print('.');
+ } else {
+ $request->print("
+
+ Failed to store student $username\@$domain.
+ Message when trying to store was ($result)
+
+
" );
+ }
$request->rflush();
$countdone++;
}
@@ -2945,9 +3581,9 @@ function checkPickOne(formname) {
LISTJAVASCRIPT
&commonJSfunctions($request);
my ($symb,$url) = &get_symb_and_url($request);
- 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 $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 $result=' '.
'Manual Grading by Page or Sequence ';
@@ -2977,20 +3613,20 @@ LISTJAVASCRIPT
$result.=' '."\n".
' '."\n";
- $result.=' View Problems Text: no '."\n".
- ' yes '." \n";
+ $result.=' View Problems Text: no '."\n".
+ ' yes '." \n";
$result.=' Submission Details: '.
- ' none'."\n".
- ' by dates and submissions'."\n".
- ' all details'."\n";
+ ' none '."\n".
+ ' by dates and submissions '."\n".
+ ' all details '."\n";
$result.=' '."\n".
- ' '."\n".
+ ' '."\n".
' '."\n".
' '."\n".
' '."\n".
- ' '." \n";
+ ' '." \n";
$result.=' " /> '."\n";
@@ -3007,12 +3643,18 @@ LISTJAVASCRIPT
my (undef,undef,$fullname) = &getclasslist($getsec,'1');
my $ptr = 1;
- foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
+ 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))) {
my ($uname,$udom) = split(/:/,$student);
$studentTable.=($ptr%2 == 1 ? '' : '');
$studentTable.=''.$ptr.' ';
- $studentTable.=' '
- .&nameUserString(undef,$$fullname{$student},$uname,$udom)."\n";
+ $studentTable.=' '
+ .&nameUserString(undef,$$fullname{$student},$uname,$udom)." \n";
$studentTable.=($ptr%2 == 0 ? ' ' : '');
$ptr++;
}
@@ -3036,7 +3678,8 @@ sub getSymbMap {
my $minder = 0;
# Gather every sequence that has problems.
- my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1);
+ 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) ) {
my $title = $minder.'.'.$sequence->compTitle();
@@ -3045,8 +3688,6 @@ sub getSymbMap {
$minder++;
}
}
-
- $navmap->untieHashes();
return \@titles,\%symbx;
}
@@ -3056,49 +3697,53 @@ sub displayPage {
my ($request) = shift;
my ($symb,$url) = &get_symb_and_url($request);
- 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 $pageTitle = $ENV{'form.page'};
+ 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 $pageTitle = $env{'form.page'};
my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
- my ($uname,$udom) = split(/:/,$ENV{'form.student'});
- my $usec=$classlist->{$ENV{'form.student'}}[5];
+ my ($uname,$udom) = split(/:/,$env{'form.student'});
+ my $usec=$classlist->{$env{'form.student'}}[5];
#need to make sure we have the correct data for later EXT calls,
#thus invalidate the cache
&Apache::lonnet::devalidatecourseresdata(
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'});
+ $env{'course.'.$env{'request.course.id'}.'.num'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'});
&Apache::lonnet::clear_EXT_cache_status();
if (!&canview($usec)) {
- $request->print('Unable to view requested student.('.$ENV{'form.student'}.') ');
+ $request->print('Unable to view requested student.('.$env{'form.student'}.') ');
$request->print(&show_grading_menu_form($symb,$url));
return;
}
- my $result=' '.$ENV{'form.title'}.' ';
- $result.=' Student: '.&nameUserString(undef,$$fullname{$ENV{'form.student'}},$uname,$udom).
+ my $result=' '.$env{'form.title'}.' ';
+ $result.=' Student: '.&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom).
' '."\n";
&sub_page_js($request);
$request->print($result);
my $navmap = Apache::lonnavmaps::navmap->new();
- my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($ENV{'form.page'});
+ my ($mapUrl, $id, $resUrl)=&Apache::lonnet::decode_symb($env{'form.page'});
my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
-
+ if (!$map) {
+ $request->print('Unable to view requested sequence. ('.$resUrl.') ');
+ $request->print(&show_grading_menu_form($symb,$url));
+ return;
+ }
my $iterator = $navmap->getIterator($map->map_start(),
$map->map_finish());
my $studentTable=' '."\n".
' '."\n".
- ' '."\n".
- ' '."\n".
+ ' '."\n".
+ ' '."\n".
' '."\n".
- ' '."\n".
+ ' '."\n".
' '."\n".
' '."\n".
' '."\n".
- ' '."\n";
+ ' '."\n";
my $checkIcon = ' ';
@@ -3108,7 +3753,7 @@ sub displayPage {
''.
''.
' Prob. '.
- ' '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade ';
+ ' '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade ';
my ($depth,$question,$prob) = (1,1,1);
$iterator->next(); # skip the first BEGIN_MAP
@@ -3117,18 +3762,18 @@ 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_problem() && !$curRes->randomout) {
my $parts = $curRes->parts();
my $title = $curRes->compTitle();
my $symbx = $curRes->symb();
$studentTable.=''.$prob.
(scalar(@{$parts}) == 1 ? '' : ' ('.scalar(@{$parts}).' parts)').' ';
$studentTable.='';
- if ($ENV{'form.vProb'} eq 'yes' ) {
+ if ($env{'form.vProb'} eq 'yes' ) {
$studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
undef,'both');
} else {
- my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'});
+ my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'});
$companswer =~ s|||g;
$companswer =~ s| ||g;
# while ($companswer =~ /()/s) { # No recorded submission for this problem ';
} else {
@@ -3158,10 +3803,10 @@ sub displayPage {
$studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
}
- } elsif ($ENV{'form.lastSub'} eq 'all') {
- my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
+ } elsif ($env{'form.lastSub'} eq 'all') {
+ my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : '');
$studentTable.=&Apache::loncommon::get_previous_attempt($symbx,$uname,$udom,
- $ENV{'request.course.id'},
+ $env{'request.course.id'},
'','.submission');
}
@@ -3179,8 +3824,6 @@ sub displayPage {
$curRes = $iterator->next();
}
- $navmap->untieHashes();
-
$studentTable.='
'."\n".
' '.
@@ -3193,9 +3836,12 @@ sub displayPage {
sub displaySubByDates {
my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
+ my $isCODE=0;
+ if (exists($record->{'resource.CODE'})) { $isCODE=1; }
my $studentTable=''.
''.
'Date/Time '.
+ ($isCODE?'CODE ':'').
'Submission '.
'Status ';
my ($version);
@@ -3208,18 +3854,22 @@ sub displaySubByDates {
for ($version=1;$version<=$$record{'version'};$version++) {
my $timestamp = scalar(localtime($$record{$version.':timestamp'}));
$studentTable.=''.$timestamp.' ';
+ if ($isCODE) {
+ $studentTable.=''.$record->{$version.':resource.CODE'}.' ';
+ }
my @versionKeys = split(/\:/,$$record{$version.':keys'});
my @displaySub = ();
foreach my $partid (@{$parts}) {
my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys);
# next if ($$record{"$version:resource.$partid.solved"} eq '');
+ my $display_part=&get_display_part($partid,undef,$symb);
foreach my $matchKey (@matchKey) {
if (exists($$record{$version.':'.$matchKey}) &&
$$record{$version.':'.$matchKey} ne '') {
my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);
- $displaySub[0].='Part '.$partid.' ';
+ $displaySub[0].='Part: '.$display_part.' ';
$displaySub[0].='(ID '.
- $responseId.') ';
+ $responseId.') ';
if ($$record{"$version:resource.$partid.tries"} eq '') {
$displaySub[0].='Trial not counted';
} else {
@@ -3237,14 +3887,14 @@ sub displaySubByDates {
}
}
if (exists $$record{"$version:resource.$partid.award"}) {
- $displaySub[1].='Part '.$partid.' '.
+ $displaySub[1].='Part: '.$display_part.' '.
lc($$record{"$version:resource.$partid.award"}).' '.
$mark{$$record{"$version:resource.$partid.solved"}}.
' ';
}
if (exists $$record{"$version:resource.$partid.regrader"}) {
$displaySub[2].=$$record{"$version:resource.$partid.regrader"}.
- ' ('.&mt('Part').': '.$partid.')';
+ ' ('.&mt('Part').': '.$display_part.')';
}
}
# needed because old essay regrader has not parts info
@@ -3265,28 +3915,33 @@ sub displaySubByDates {
sub updateGradeByPage {
my ($request) = shift;
- 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 $pageTitle = $ENV{'form.page'};
+ 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 $pageTitle = $env{'form.page'};
my ($classlist,undef,$fullname) = &getclasslist($getsec,'1');
- my ($uname,$udom) = split(/:/,$ENV{'form.student'});
- my $usec=$classlist->{$ENV{'form.student'}}[5];
+ my ($uname,$udom) = split(/:/,$env{'form.student'});
+ my $usec=$classlist->{$env{'form.student'}}[5];
if (!&canmodify($usec)) {
- $request->print('Unable to modify requested student.('.$ENV{'form.student'}.' ');
- $request->print(&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'}));
+ $request->print('Unable to modify requested student.('.$env{'form.student'}.' ');
+ $request->print(&show_grading_menu_form($env{'form.symb'},$env{'form.url'}));
return;
}
- my $result=' '.$ENV{'form.title'}.' ';
- $result.=' Student: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom).
+ my $result=' '.$env{'form.title'}.' ';
+ $result.=' Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
' '."\n";
$request->print($result);
my $navmap = Apache::lonnavmaps::navmap->new();
- my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $ENV{'form.page'});
+ my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'});
my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps
-
+ if (!$map) {
+ $request->print('Unable to grade requested sequence. ('.$resUrl.') ');
+ my ($symb,$url)=&get_symb_and_url($request);
+ $request->print(&show_grading_menu_form($symb,$url));
+ return;
+ }
my $iterator = $navmap->getIterator($map->map_start(),
$map->map_finish());
@@ -3314,12 +3969,14 @@ sub updateGradeByPage {
my %newrecord=();
my @displayPts=();
+ my %aggregate = ();
+ my $aggregateflag = 0;
foreach my $partid (@{$parts}) {
- my $newpts = $ENV{'form.GD_BOX'.$question.'_'.$partid};
- my $oldpts = $ENV{'form.oldpts'.$question.'_'.$partid};
+ my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};
+ my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};
- my $wgt = $ENV{'form.WGT'.$question.'_'.$partid} != 0 ?
- $ENV{'form.WGT'.$question.'_'.$partid} : 1;
+ my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ?
+ $env{'form.WGT'.$question.'_'.$partid} : 1;
my $partial = $newpts/$wgt;
my $score;
if ($partial > 0) {
@@ -3327,26 +3984,35 @@ sub updateGradeByPage {
} elsif ($newpts ne '') { #empty is taken as 0
$score = 'incorrect_by_override';
}
- my $dropMenu = $ENV{'form.GD_SEL'.$question.'_'.$partid};
+ my $dropMenu = $env{'form.GD_SEL'.$question.'_'.$partid};
if ($dropMenu eq 'excused') {
$partial = '';
$score = 'excused';
} elsif ($dropMenu eq 'reset status'
- && $ENV{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists
+ && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists
$newrecord{'resource.'.$partid.'.tries'} = 0;
$newrecord{'resource.'.$partid.'.solved'} = '';
$newrecord{'resource.'.$partid.'.award'} = '';
$newrecord{'resource.'.$partid.'.awarded'} = 0;
- $newrecord{'resource.'.$partid.'.regrader'} = "$ENV{'user.name'}:$ENV{'user.domain'}";
+ $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";
$changeflag++;
$newpts = '';
- }
-
- my $oldstatus = $ENV{'form.solved'.$question.'_'.$partid};
- $displayPts[0].=' Part '.$partid.' = '.
+
+ my $aggtries = $env{'form.aggtries'.$question.'_'.$partid};
+ my $totaltries = $env{'form.totaltries'.$question.'_'.$partid};
+ my $solvedstatus = $env{'form.solved'.$question.'_'.$partid};
+ if ($aggtries > 0) {
+ &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus);
+ $aggregateflag = 1;
+ }
+ }
+ my $display_part=&get_display_part($partid,undef,
+ $curRes->symb());
+ my $oldstatus = $env{'form.solved'.$question.'_'.$partid};
+ $displayPts[0].=' Part: '.$display_part.' = '.
(($oldstatus eq 'excused') ? 'excused' : $oldpts).
' ';
- $displayPts[1].=' Part '.$partid.' = '.
+ $displayPts[1].=' Part: '.$display_part.' = '.
(($score eq 'excused') ? 'excused' : $newpts).
' ';
@@ -3355,15 +4021,20 @@ sub updateGradeByPage {
$newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne '';
$newrecord{'resource.'.$partid.'.solved'} = $score if $score ne '';
- $newrecord{'resource.'.$partid.'.regrader'} = "$ENV{'user.name'}:$ENV{'user.domain'}"
+ $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}"
if (scalar(keys(%newrecord)) > 0);
$changeflag++;
}
if (scalar(keys(%newrecord)) > 0) {
- &Apache::lonnet::cstore(\%newrecord,$symbx,$ENV{'request.course.id'},
+ &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'},
$udom,$uname);
}
+ if ($aggregateflag) {
+ &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ }
$studentTable.=''.$displayPts[0].' '.
''.$displayPts[1].' '.
@@ -3374,10 +4045,8 @@ sub updateGradeByPage {
$curRes = $iterator->next();
}
- $navmap->untieHashes();
-
$studentTable.='
';
- $studentTable.=&show_grading_menu_form($ENV{'form.symb'},$ENV{'form.url'});
+ $studentTable.=&show_grading_menu_form($env{'form.symb'},$env{'form.url'});
my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' :
'The scores were changed for '.
$changeflag.' problem'.($changeflag == 1 ? '.' : 's.'));
@@ -3399,8 +4068,8 @@ sub defaultFormData {
return '
'."\n".
' '."\n".
- ' '."\n".
- ' '."\n";
+ ' '."\n".
+ ' '."\n";
}
sub getSequenceDropDown {
@@ -3420,19 +4089,27 @@ sub getSequenceDropDown {
return $result;
}
-sub scantron_uploads {
- if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''};
- my $result= '';
- my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
- my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+sub scantron_filenames {
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,
&Apache::loncommon::propath($cdom,$cname));
- $result.=" ";
- foreach my $filename (@files) {
+ my @possiblenames;
+ foreach my $filename (sort(@files)) {
($filename)=split(/&/,$filename);
if ($filename!~/^scantron_orig_/) { next ; }
$filename=~s/^scantron_orig_//;
- $result.="$filename \n";
+ push(@possiblenames,$filename);
+ }
+ return @possiblenames;
+}
+
+sub scantron_uploads {
+ my ($file2grade) = @_;
+ my $result= '';
+ $result.=" ";
+ foreach my $filename (sort(&scantron_filenames())) {
+ $result.="$filename \n";
}
$result.=" ";
return $result;
@@ -3453,12 +4130,13 @@ sub scantron_scantab {
}
sub scantron_CODElist {
- my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
- my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my @names=&Apache::lonnet::getkeys('CODEs',$cdom,$cnum);
my $namechoice=' ';
- foreach my $name (@names) {
+ foreach my $name (sort {uc($a) cmp uc($b)} @names) {
if ($name =~ /^error: 2 /) { next; }
+ if ($name =~ /^type\0/) { next; }
$namechoice.=''.$name.' ';
}
$namechoice=''.$namechoice.' ';
@@ -3467,24 +4145,24 @@ sub scantron_CODElist {
sub scantron_CODEunique {
my $result='
- Yes
+ Yes
- No
+ No
';
return $result;
}
sub scantron_selectphase {
- my ($r) = @_;
+ my ($r,$file2grade) = @_;
my ($symb,$url)=&get_symb_and_url($r);
if (!$symb) {return '';}
my $sequence_selector=&getSequenceDropDown($r,$symb);
my $default_form_data=&defaultFormData($symb,$url);
my $grading_menu_button=&show_grading_menu_form($symb,$url);
- my $file_selector=&scantron_uploads();
+ my $file_selector=&scantron_uploads($file2grade);
my $format_selector=&scantron_scantab();
my $CODE_selector=&scantron_CODElist();
my $CODE_unique=&scantron_CODEunique();
@@ -3494,9 +4172,9 @@ sub scantron_selectphase {
$result.= <
+
-
-
+
$default_form_data
-
-
+
+
SCANTRONFORM
$r->print($result);
- if (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'}) ||
- &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) {
+ if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
$r->print(<
@@ -3555,8 +4233,8 @@ SCANTRONFORM
SCANTRONFORM
my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
- my $cdom= $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
- my $cnum= $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'};
$r->print(<
function checkUpload(formname) {
@@ -3589,8 +4267,8 @@ SCANTRONFORM
}
$r->print(<
-
-
+
+
-
-
+
+
SCANTRONFORM
$r->print(<
-
$grading_menu_button
SCANTRONFORM
@@ -3713,7 +4380,14 @@ sub scantron_fixup_scanline {
&scan_data($scan_data,
"$whichline.no_bubble.".$args->{'question'},'1');
} else {
- substr($answer,$args->{'response'},1)=$on;
+ if ($on eq 'letter') {
+ my @alphabet=('A'..'Z');
+ $answer=$alphabet[$args->{'response'}];
+ } elsif ($on eq 'number') {
+ $answer=$args->{'response'}+1;
+ } else {
+ substr($answer,$args->{'response'},1)=$on;
+ }
&scan_data($scan_data,
"$whichline.no_bubble.".$args->{'question'},undef,'1');
}
@@ -3725,7 +4399,7 @@ sub scantron_fixup_scanline {
sub scan_data {
my ($scan_data,$key,$value,$delete)=@_;
- my $filename=$ENV{'form.scantron_selectfile'};
+ my $filename=$env{'form.scantron_selectfile'};
if (defined($value)) {
$scan_data->{$filename.'_'.$key} = $value;
}
@@ -3738,8 +4412,11 @@ sub scantron_parse_scanline {
my %record;
my $questions=substr($line,$$scantron_config{'Qstart'}-1);
my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
- if ($$scantron_config{'CODElocation'} ne 0) {
- if ($$scantron_config{'CODElocation'} < 0) {
+ if (!($$scantron_config{'CODElocation'} eq 0 ||
+ $$scantron_config{'CODElocation'} eq 'none')) {
+ if ($$scantron_config{'CODElocation'} < 0 ||
+ $$scantron_config{'CODElocation'} eq 'letter' ||
+ $$scantron_config{'CODElocation'} eq 'number') {
$record{'scantron.CODE'}=substr($data,
$$scantron_config{'CODEstart'}-1,
$$scantron_config{'CODElength'});
@@ -3773,25 +4450,57 @@ sub scantron_parse_scanline {
my $currentquest=substr($questions,0,$$scantron_config{'Qlength'});
substr($questions,0,$$scantron_config{'Qlength'})='';
if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }
- my @array=split($$scantron_config{'Qon'},$currentquest,-1);
- if (length($array[0]) eq $$scantron_config{'Qlength'}) {
- $record{"scantron.$questnum.answer"}='';
- if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
- push(@{$record{"scantron.missingerror"}},$questnum);
- }
+ if ($$scantron_config{'Qon'} eq 'letter') {
+ if ($currentquest eq '?') {
+ push(@{$record{'scantron.doubleerror'}},$questnum);
+ $record{"scantron.$questnum.answer"}='';
+ } elsif (!$currentquest
+ || $currentquest eq $$scantron_config{'Qoff'}
+ || $currentquest !~ /^[A-Z]$/) {
+ $record{"scantron.$questnum.answer"}='';
+ if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ push(@{$record{"scantron.missingerror"}},$questnum);
+ }
+ } else {
+ $record{"scantron.$questnum.answer"}=$currentquest;
+ }
+ } elsif ($$scantron_config{'Qon'} eq 'number') {
+ if ($currentquest eq '?') {
+ push(@{$record{'scantron.doubleerror'}},$questnum);
+ $record{"scantron.$questnum.answer"}='';
+ } elsif (!$currentquest
+ || $currentquest eq $$scantron_config{'Qoff'}
+ || $currentquest !~ /^\d$/) {
+ $record{"scantron.$questnum.answer"}='';
+ if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ push(@{$record{"scantron.missingerror"}},$questnum);
+ }
+ } else {
+ $record{"scantron.$questnum.answer"}=
+ $alphabet[$currentquest-1];
+ }
} else {
- $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
+ my @array=split($$scantron_config{'Qon'},$currentquest,-1);
+ if (length($array[0]) eq $$scantron_config{'Qlength'}) {
+ $record{"scantron.$questnum.answer"}='';
+ if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ push(@{$record{"scantron.missingerror"}},$questnum);
+ }
+ } else {
+ $record{"scantron.$questnum.answer"}=
+ $alphabet[length($array[0])];
+ }
+ if (scalar(@array) gt 2) {
+ push(@{$record{'scantron.doubleerror'}},$questnum);
+ my @ans=@array;
+ my $i=length($ans[0]);shift(@ans);
+ while ($#ans) {
+ $i+=length($ans[0])+1;
+ $record{"scantron.$questnum.answer"}.=$alphabet[$i];
+ shift(@ans);
+ }
+ }
}
- if (scalar(@array) gt 2) {
- push(@{$record{'scantron.doubleerror'}},$questnum);
- my @ans=@array;
- my $i=length($ans[0]);shift(@ans);
- while ($#ans) {
- $i+=length($ans[0])+1;
- $record{"scantron.$questnum.answer"}.=$alphabet[$i];
- shift(@ans);
- }
- }
}
$record{'scantron.maxquest'}=$questnum;
return \%record;
@@ -3821,7 +4530,8 @@ sub scantron_find_student {
sub scantron_filter {
my ($curres)=@_;
- if (ref($curres) && $curres->is_problem() && !$curres->randomout) {
+ # randomout is dysfunctional at best for this purpose
+ if (ref($curres) && $curres->is_problem()) { #&& !$curres->randomout) {
return 1;
}
return 0;
@@ -3829,103 +4539,227 @@ sub scantron_filter {
sub scantron_process_corrections {
my ($r) = @_;
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
my $classlist=&Apache::loncoursedata::get_classlist();
- my $which=$ENV{'form.scantron_line'};
- my $line=&scantron_get_line($scanlines,$which);
+ my $which=$env{'form.scantron_line'};
+ my $line=&scantron_get_line($scanlines,$scan_data,$which);
my ($skip,$err,$errmsg);
- if ($ENV{'form.scantron_skip_record'}) {
+ if ($env{'form.scantron_skip_record'}) {
$skip=1;
- } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
- my $newstudent=$ENV{'form.scantron_username'}.':'.
- $ENV{'form.scantron_domain'};
+ } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
+ my $newstudent=$env{'form.scantron_username'}.':'.
+ $env{'form.scantron_domain'};
my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
($line,$err,$errmsg)=
&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
'ID',{'newid'=>$newid,
- 'username'=>$ENV{'form.scantron_username'},
- 'domain'=>$ENV{'form.scantron_domain'}});
- } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) {
- my $resolution=$ENV{'form.scantron_CODE_resolution'};
+ 'username'=>$env{'form.scantron_username'},
+ 'domain'=>$env{'form.scantron_domain'}});
+ } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) {
+ my $resolution=$env{'form.scantron_CODE_resolution'};
my $newCODE;
my %args;
if ($resolution eq 'use_unfound') {
$newCODE='use_unfound';
} elsif ($resolution eq 'use_found') {
- $newCODE=$ENV{'form.scantron_CODE_selectedvalue'};
+ $newCODE=$env{'form.scantron_CODE_selectedvalue'};
} elsif ($resolution eq 'use_typed') {
- $newCODE=$ENV{'form.scantron_CODE_newvalue'};
+ $newCODE=$env{'form.scantron_CODE_newvalue'};
} elsif ($resolution =~ /^use_closest_(\d+)/) {
- $newCODE=$ENV{"form.scantron_CODE_closest_$1"};
+ $newCODE=$env{"form.scantron_CODE_closest_$1"};
}
- if ($ENV{'form.scantron_corrections'} eq 'duplicateCODE') {
+ if ($env{'form.scantron_corrections'} eq 'duplicateCODE') {
$args{'CODE_ignore_dup'}=1;
}
$args{'CODE'}=$newCODE;
($line,$err,$errmsg)=
&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which,
'CODE',\%args);
- } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
- foreach my $question (split(',',$ENV{'form.scantron_questions'})) {
+ } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) {
+ foreach my $question (split(',',$env{'form.scantron_questions'})) {
($line,$err,$errmsg)=
&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
$which,'answer',
{ 'question'=>$question,
- 'response'=>$ENV{"form.scantron_correct_Q_$question"}});
+ 'response'=>$env{"form.scantron_correct_Q_$question"}});
if ($err) { last; }
}
}
if ($err) {
- $r->print("Unable to accept last correction, an error occurred :$errmsg:");
+ $r->print("Unable to accept last correction, an error occurred :$errmsg: ");
} else {
- &scantron_put_line($scanlines,$which,$line,$skip);
+ &scantron_put_line($scanlines,$scan_data,$which,$line,$skip);
&scantron_putfile($scanlines,$scan_data);
}
}
+sub reset_skipping_status {
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ &scan_data($scan_data,'remember_skipping',undef,1);
+ &scantron_putfile(undef,$scan_data);
+}
+
+sub allow_skipping {
+ my ($scan_data,$i)=@_;
+ my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
+ delete($remembered{$i});
+ &scan_data($scan_data,'remember_skipping',join(':',%remembered));
+}
+
+sub should_be_skipped {
+ my ($scan_data,$i)=@_;
+ if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
+ # not redoing old skips
+ return 0;
+ }
+ my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
+ if (exists($remembered{$i})) { return 0; }
+ return 1;
+}
+
+sub remember_current_skipped {
+ my ($scanlines,$scan_data)=&scantron_getfile();
+ my %to_remember;
+ for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ if ($scanlines->{'skipped'}[$i]) {
+ $to_remember{$i}=1;
+ }
+ }
+ &Apache::lonnet::logthis('remembering '.join(':',%to_remember));
+ &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
+ &scantron_putfile(undef,$scan_data);
+}
+
+sub check_for_error {
+ my ($r,$result)=@_;
+ if ($result ne 'ok' && $result ne 'not_found' ) {
+ $r->print("An error occured ($result) when trying to Remove the existing corrections.");
+ }
+}
+
+sub scantron_warning_screen {
+ my ($button_text)=@_;
+ my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
+ my $CODElist="a";
+ if ($scantron_config{'CODElocation'} &&
+ $scantron_config{'CODEstart'} &&
+ $scantron_config{'CODElength'}) {
+ $CODElist=$env{'form.scantron_CODElist'};
+ if ($CODElist eq '') { $CODElist='None '; }
+ $CODElist=
+ 'List of CODES to validate against: '.
+ $CODElist.' ';
+ }
+ return (<
+Please double check the information
+ below before clicking on '$button_text'
+
+
+Sequence to be Graded: $title
+Data File that will be used: $env{'form.scantron_selectfile'}
+$CODElist
+
+
+
+ If this information is correct, please click on '$button_text'.
+ If something is incorrect, please click the 'Grading Menu' button to start over.
+
+
+STUFF
+}
+
+sub scantron_do_warning {
+ my ($r)=@_;
+ my ($symb,$url)=&get_symb_and_url($r);
+ if (!$symb) {return '';}
+ my $default_form_data=&defaultFormData($symb,$url);
+ $r->print(&scantron_form_start().$default_form_data);
+ if ( $env{'form.selectpage'} eq '' ||
+ $env{'form.scantron_selectfile'} eq '' ||
+ $env{'form.scantron_format'} eq '' ) {
+ $r->print("You have forgetten to specify some information. Please go Back and try again.
");
+ if ( $env{'form.selectpage'} eq '') {
+ $r->print('You have not selected a Sequence to grade
');
+ }
+ if ( $env{'form.scantron_selectfile'} eq '') {
+ $r->print('You have not selected a file that contains the student\'s response data.
');
+ }
+ if ( $env{'form.scantron_format'} eq '') {
+ $r->print('You have not selected a the format of the student\'s response data.
');
+ }
+ } else {
+ my $warning=&scantron_warning_screen('Grading: Validate Records');
+ $r->print(<
+
+STUFF
+ }
+ $r->print(" ".&show_grading_menu_form($symb,$url)."");
+ return '';
+}
+
+sub scantron_form_start {
+ my ($max_bubble)=@_;
+ my $result= <
+
+
+
+
+
+
+
+
+SCANTRONFORM
+ return $result;
+}
sub scantron_validate_file {
my ($r) = @_;
my ($symb,$url)=&get_symb_and_url($r);
if (!$symb) {return '';}
my $default_form_data=&defaultFormData($symb,$url);
- if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') {
- my $result=&scantron_remove('corrected');
- if ($result ne 'ok' && $result ne 'not_found' ) {
- $r->print("An error occured ($result) when trying to Remove the existing corrections.");
- }
- $ENV{'form.scantron_options_ignore'}='done';
+
+ # do the detection of only doing skipped records first befroe we delete
+ # them when doing the corrections reset
+ if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
+ &reset_skipping_status();
+ }
+ if ($env{'form.scantron_options_redo'} eq 'redo_skipped') {
+ &remember_current_skipped();
+ &scantron_remove_file('skipped');
+ $env{'form.scantron_options_redo'}='redo_skipped_ready';
+ }
+
+ if ($env{'form.scantron_options_ignore'} eq 'ignore_corrections') {
+ &check_for_error($r,&scantron_remove_file('corrected'));
+ &check_for_error($r,&scantron_remove_file('skipped'));
+ &check_for_error($r,&scantron_remove_scan_data());
+ $env{'form.scantron_options_ignore'}='done';
}
- if ($ENV{'form.scantron_corrections'}) {
+
+ if ($env{'form.scantron_corrections'}) {
&scantron_process_corrections($r);
}
$r->print("Gathering neccessary info.
");$r->rflush();
- my $max_bubble=&scantron_get_maxbubble($r);
#get the student pick code ready
$r->print(&Apache::loncommon::studentbrowser_javascript());
- my $result= <
-
-
-
-
-
-
-
-
- $default_form_data
-SCANTRONFORM
+ my $max_bubble=&scantron_get_maxbubble($r);
+ my $result=&scantron_form_start($max_bubble).$default_form_data;
$r->print($result);
my @validate_phases=( 'ID',
'CODE',
'doublebubble',
'missingbubbles');
- if (!$ENV{'form.validatepass'}) {
- $ENV{'form.validatepass'} = 0;
+ if (!$env{'form.validatepass'}) {
+ $env{'form.validatepass'} = 0;
}
- my $currentphase=$ENV{'form.validatepass'};
+ my $currentphase=$env{'form.validatepass'};
my $stop=0;
while (!$stop && $currentphase < scalar(@validate_phases)) {
@@ -3938,9 +4772,14 @@ SCANTRONFORM
}
}
if (!$stop) {
- $r->print("Validation process complete. ");
- $r->print(' ');
- $r->print(' ');
+ my $warning=&scantron_warning_screen('Start Grading');
+ $r->print(<
+$warning
+
+
+STUFF
+
} else {
$r->print(' ');
$r->print(" ");
@@ -3956,54 +4795,63 @@ SCANTRONFORM
return '';
}
-sub scantron_remove {
+sub scantron_remove_file {
my ($which)=@_;
- my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
- my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $file='scantron_';
- if ($which eq 'corrected') {
- $file.='corrected_';
+ if ($which eq 'corrected' || $which eq 'skipped') {
+ $file.=$which.'_';
} else {
return 'refused';
}
- $file.=$ENV{'form.scantron_selectfile'};
- my $result=&Apache::lonnet::removeuserfile($cname,$cdom,$file);
+ $file.=$env{'form.scantron_selectfile'};
+ return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
+}
+
+sub scantron_remove_scan_data {
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname);
my @todelete;
- my $filename=$ENV{'form.scantron_selectfile'};
+ my $filename=$env{'form.scantron_selectfile'};
foreach my $key (@keys) {
if ($key=~/^\Q$filename\E_/) {
+ if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
+ $key=~/remember_skipping/) {
+ next;
+ }
push(@todelete,$key);
}
}
+ my $result;
if (@todelete) {
- &Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname);
+ $result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname);
}
return $result;
}
sub scantron_getfile {
- #FIXME really would prefer a scantron directory but tokenwrapper
- # doesn't allow access to subdirs of userfiles
- my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
- my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ #FIXME really would prefer a scantron directory
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $lines;
$lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
- 'scantron_orig_'.$ENV{'form.scantron_selectfile'});
+ 'scantron_orig_'.$env{'form.scantron_selectfile'});
my %scanlines;
$scanlines{'orig'}=[(split("\n",$lines,-1))];
my $temp=$scanlines{'orig'};
$scanlines{'count'}=$#$temp;
$lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
- 'scantron_corrected_'.$ENV{'form.scantron_selectfile'});
+ 'scantron_corrected_'.$env{'form.scantron_selectfile'});
if ($lines eq '-1') {
$scanlines{'corrected'}=[];
} else {
$scanlines{'corrected'}=[(split("\n",$lines,-1))];
}
$lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
- 'scantron_skipped_'.$ENV{'form.scantron_selectfile'});
+ 'scantron_skipped_'.$env{'form.scantron_selectfile'});
if ($lines eq '-1') {
$scanlines{'skipped'}=[];
} else {
@@ -4017,44 +4865,57 @@ sub scantron_getfile {
sub lonnet_putfile {
my ($contents,$filename)=@_;
- my $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
- my $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
- my $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
- $ENV{'form.sillywaytopassafilearound'}=$contents;
- &Apache::lonnet::finishuserfileupload($docuname,$docudom,$docuhome,'sillywaytopassafilearound',$filename);
+ my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ $env{'form.sillywaytopassafilearound'}=$contents;
+ &Apache::lonnet::finishuserfileupload($docuname,$docudom,'sillywaytopassafilearound',$filename);
}
sub scantron_putfile {
my ($scanlines,$scan_data) = @_;
- #FIXME really would prefer a scantron directory but tokenwrapper
- # doesn't allow access to subdirs of userfiles
- my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
- my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
- my $prefix='scantron_';
+ #FIXME really would prefer a scantron directory
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ if ($scanlines) {
+ my $prefix='scantron_';
# no need to update orig, shouldn't change
# &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
-# $ENV{'form.scantron_selectfile'});
- &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
- $prefix.'corrected_'.
- $ENV{'form.scantron_selectfile'});
- &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
- $prefix.'skipped_'.
- $ENV{'form.scantron_selectfile'});
+# $env{'form.scantron_selectfile'});
+ &lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
+ $prefix.'corrected_'.
+ $env{'form.scantron_selectfile'});
+ &lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
+ $prefix.'skipped_'.
+ $env{'form.scantron_selectfile'});
+ }
&Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
}
sub scantron_get_line {
- my ($scanlines,$i)=@_;
- if ($scanlines->{'skipped'}[$i]) {return undef;}
+ my ($scanlines,$scan_data,$i)=@_;
+ if (&should_be_skipped($scan_data,$i)) { return undef; }
+ if ($scanlines->{'skipped'}[$i]) { return undef; }
if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
return $scanlines->{'orig'}[$i];
}
+sub get_todo_count {
+ my ($scanlines,$scan_data)=@_;
+ my $count=0;
+ for (my $i=0;$i<=$scanlines->{'count'};$i++) {
+ my $line=&scantron_get_line($scanlines,$scan_data,$i);
+ if ($line=~/^[\s\cz]*$/) { next; }
+ $count++;
+ }
+ return $count;
+}
+
sub scantron_put_line {
- my ($scanlines,$i,$newline,$skip)=@_;
+ my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
if ($skip) {
$scanlines->{'skipped'}[$i]=$newline;
+ &allow_skipping($scan_data,$i);
return;
}
$scanlines->{'corrected'}[$i]=$newline;
@@ -4068,12 +4929,12 @@ sub scantron_validate_ID {
my %idmap=&username_to_idmap($classlist);
#get scantron line setup
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
my %found=('ids'=>{},'usernames'=>{});
for (my $i=0;$i<=$scanlines->{'count'};$i++) {
- my $line=&scantron_get_line($scanlines,$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);
@@ -4137,6 +4998,12 @@ sub scantron_get_correction {
$r->print(" in scanline $i ".
$line." \n");
}
+ my $message="The ID on the form is ".
+ $$scan_record{'scantron.ID'}." \n".
+ "The name on the paper is ".
+ $$scan_record{'scantron.LastName'}.",".
+ $$scan_record{'scantron.FirstName'}."
";
+
$r->print(' '."\n");
$r->print(' '."\n");
if ($error =~ /ID$/) {
@@ -4145,11 +5012,7 @@ sub scantron_get_correction {
} elsif ($error eq 'duplicateID') {
$r->print("The encoded ID has also been used by a previous paper $arg\n");
}
- $r->print("The ID on the form is ".
- $$scan_record{'scantron.ID'}." \n");
- $r->print("The name on the paper is ".
- $$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."
");
+ $r->print($message);
$r->print("How should I handle this? \n");
$r->print("\n
");
#FIXME it would be nice if this sent back the user ID and
@@ -4158,7 +5021,7 @@ sub scantron_get_correction {
'scantron_username','scantron_domain'));
$r->print(": ");
$r->print("\n@".
- &Apache::loncommon::select_dom_form($ENV{'request.role.domain'},'scantron_domain'));
+ &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));
$r->print(' ');
} elsif ($error =~ /CODE$/) {
@@ -4167,29 +5030,30 @@ sub scantron_get_correction {
} elsif ($error eq 'duplicateCODE') {
$r->print("The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique
\n");
}
- $r->print("The CODE on the form is ".
- $$scan_record{'scantron.CODE'}." \n");
- $r->print("
The ID on the form is ".
- $$scan_record{'scantron.ID'}." \n");
- $r->print("The name on the paper is ".
- $$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."
");
+ $r->print("The CODE on the form is '".
+ $$scan_record{'scantron.CODE'}."' \n");
+ $r->print($message);
$r->print("
How should I handle this? \n");
$r->print("\n ");
my $i=0;
- if ($error eq 'incorrectCODE') {
+ if ($error eq 'incorrectCODE'
+ && $$scan_record{'scantron.CODE'}=~/\S/ ) {
my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'});
- foreach my $testcode (@{$closest}) {
- my $checked='';
- if (!$i) { $checked=' checked="on" '; }
- $r->print(" Use the similar CODE ".$testcode." instead. ");
- $r->print("\n ");
- $i++;
+ if ($closest > 0) {
+ foreach my $testcode (@{$closest}) {
+ my $checked='';
+ if (!$i) { $checked=' checked="on" '; }
+ $r->print(" Use the similar CODE ".$testcode." instead. ");
+ $r->print("\n ");
+ $i++;
+ }
}
}
- my $checked; if (!$i) { $checked=' checked="on" '; }
- $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error.");
- $r->print("\n ");
+ if ($$scan_record{'scantron.CODE'}=~/\S/ ) {
+ my $checked; if (!$i) { $checked=' checked="on" '; }
+ $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error. ");
+ $r->print("\n ");
+ }
$r->print(<
@@ -4204,18 +5068,19 @@ function change_radio(field) {
ENDSCRIPT
my $href="/adm/pickcode?".
"form=".&Apache::lonnet::escape("scantronupload").
- "&scantron_format=".&Apache::lonnet::escape($ENV{'form.scantron_format'}).
- "&scantron_CODElist=".&Apache::lonnet::escape($ENV{'form.scantron_CODElist'}).
+ "&scantron_format=".&Apache::lonnet::escape($env{'form.scantron_format'}).
+ "&scantron_CODElist=".&Apache::lonnet::escape($env{'form.scantron_CODElist'}).
"&curCODE=".&Apache::lonnet::escape($$scan_record{'scantron.CODE'}).
- "&scantron_selectfile=".&Apache::lonnet::escape($ENV{'form.scantron_selectfile'});
- $r->print(" Select a CODE from the list of all CODEs and use it. Selected CODE is ");
+ "&scantron_selectfile=".&Apache::lonnet::escape($env{'form.scantron_selectfile'});
+ $r->print(" Select a CODE from the list of all CODEs and use it. Selected CODE is ");
$r->print("\n ");
- $r->print(" Use as the CODE.");
+ $r->print(" Use as the CODE.");
$r->print("\n ");
} elsif ($error eq 'doublebubble') {
$r->print("There have been multiple bubbles scanned for a some question(s)
\n");
$r->print(' ');
+ $r->print($message);
$r->print("Please indicate which bubble should be used for grading
");
foreach my $question (@{$arg}) {
my $selected=$$scan_record{"scantron.$question.answer"};
@@ -4223,6 +5088,7 @@ ENDSCRIPT
}
} elsif ($error eq 'missingbubble') {
$r->print("There have been no bubbles scanned for some question(s)
\n");
+ $r->print($message);
$r->print("Please indicate which bubble should be used for grading
");
$r->print("Some questions have no scanned bubbles\n");
$r->print('$quest ");
for (my $i=0;$i<$max+1;$i++) {
- $r->print('');
+ $r->print("\n".' ');
if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
else { $r->print(' '); }
$r->print(' ');
}
- $r->print('');
+ $r->print(' ');
for (my $i=0;$i<$max;$i++) {
- $r->print(' '.$alphabet[$i]." ");
+ $r->print("\n".
+ ' '.$alphabet[$i]." ");
}
- $r->print(' No bubble ');
+ $r->print(' No bubble ');
$r->print('
');
}
@@ -4281,21 +5152,34 @@ sub scantron_get_closely_matching_CODEs
}
sub get_codes {
- my $old_name=$ENV{'form.scantron_CODElist'};
- my $cdom =$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
- my $cnum =$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
- my %result=&Apache::lonnet::get('CODEs',[$old_name],$cdom,$cnum);
- my %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
+ my ($old_name, $cdom, $cnum) = @_;
+ if (!$old_name) {
+ $old_name=$env{'form.scantron_CODElist'};
+ }
+ if (!$cdom) {
+ $cdom =$env{'course.'.$env{'request.course.id'}.'.domain'};
+ }
+ if (!$cnum) {
+ $cnum =$env{'course.'.$env{'request.course.id'}.'.num'};
+ }
+ my %result=&Apache::lonnet::get('CODEs',[$old_name,"type\0$old_name"],
+ $cdom,$cnum);
+ my %allcodes;
+ if ($result{"type\0$old_name"} eq 'number') {
+ %allcodes=map {($_,1)} split(',',$result{$old_name});
+ } else {
+ %allcodes=map {(&Apache::lonprintout::num_to_letters($_),1)} split(',',$result{$old_name});
+ }
return %allcodes;
}
sub scantron_validate_CODE {
my ($r,$currentphase) = @_;
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
if ($scantron_config{'CODElocation'} &&
$scantron_config{'CODEstart'} &&
$scantron_config{'CODElength'}) {
- if (!defined($ENV{'form.scantron_CODElist'})) {
+ if (!defined($env{'form.scantron_CODElist'})) {
&FIXME_blow_up()
}
} else {
@@ -4308,19 +5192,27 @@ sub scantron_validate_CODE {
my ($scanlines,$scan_data)=&scantron_getfile();
for (my $i=0;$i<=$scanlines->{'count'};$i++) {
- my $line=&scantron_get_line($scanlines,$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 $CODE=$$scan_record{'scantron.CODE'};
my $error=0;
- if (!exists($allcodes{$CODE}) && !$$scan_record{'scantron.useCODE'}) {
+ if (!&Apache::lonnet::validCODE($CODE)) {
&scantron_get_correction($r,$i,$scan_record,
\%scantron_config,
$line,'incorrectCODE',\%allcodes);
return(1,$currentphase);
}
- if (exists($usedCODEs{$CODE}) && $ENV{'form.scantron_CODEunique'}
+ if (%allcodes && !exists($allcodes{$CODE})
+ && !$$scan_record{'scantron.useCODE'}) {
+ &scantron_get_correction($r,$i,$scan_record,
+ \%scantron_config,
+ $line,'incorrectCODE',\%allcodes);
+ return(1,$currentphase);
+ }
+ if (exists($usedCODEs{$CODE})
+ && $env{'form.scantron_CODEunique'} eq 'yes'
&& !$$scan_record{'scantron.CODE_ignore_dup'}) {
&scantron_get_correction($r,$i,$scan_record,
\%scantron_config,
@@ -4339,10 +5231,10 @@ sub scantron_validate_doublebubble {
my %idmap=&username_to_idmap($classlist);
#get scantron line setup
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
for (my $i=0;$i<=$scanlines->{'count'};$i++) {
- my $line=&scantron_get_line($scanlines,$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);
@@ -4357,27 +5249,27 @@ sub scantron_validate_doublebubble {
sub scantron_get_maxbubble {
my ($r)=@_;
- if (defined($ENV{'form.scantron_maxbubble'}) &&
- $ENV{'form.scantron_maxbubble'}) {
- return $ENV{'form.scantron_maxbubble'};
+ if (defined($env{'form.scantron_maxbubble'}) &&
+ $env{'form.scantron_maxbubble'}) {
+ return $env{'form.scantron_maxbubble'};
}
my $navmap=Apache::lonnavmaps::navmap->new();
my (undef,undef,$sequence)=
- &Apache::lonnet::decode_symb($ENV{'form.selectpage'});
+ &Apache::lonnet::decode_symb($env{'form.selectpage'});
my $map=$navmap->getResourceByUrl($sequence);
my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
&Apache::lonnet::delenv('form.counter');
foreach my $resource (@resources) {
- my $result=&Apache::lonnet::ssi($resource->src());
+ my $result=&Apache::lonnet::ssi($resource->src().'?symb='.&Apache::lonnet::escape($resource->symb()));
}
&Apache::lonnet::delenv('scantron\.');
- my $envfile=$ENV{'user.environment'};
+ my $envfile=$env{'user.environment'};
$envfile=~/\/([^\/]+)\.id$/;
$envfile=$1;
&Apache::lonnet::transfer_profile_to_env($r->dir_config('lonIDsDir'),
$envfile);
- $ENV{'form.scantron_maxbubble'}=$ENV{'form.counter'}-1;
- return $ENV{'form.scantron_maxbubble'};
+ $env{'form.scantron_maxbubble'}=$env{'form.counter'}-1;
+ return $env{'form.scantron_maxbubble'};
}
sub scantron_validate_missingbubbles {
@@ -4387,12 +5279,12 @@ sub scantron_validate_missingbubbles {
my %idmap=&username_to_idmap($classlist);
#get scantron line setup
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
my $max_bubble=&scantron_get_maxbubble();
if (!$max_bubble) { $max_bubble=2**31; }
for (my $i=0;$i<=$scanlines->{'count'};$i++) {
- my $line=&scantron_get_line($scanlines,$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);
@@ -4414,12 +5306,12 @@ sub scantron_validate_missingbubbles {
sub scantron_process_students {
my ($r) = @_;
- my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'});
+ my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
my ($symb,$url)=&get_symb_and_url($r);
if (!$symb) {return '';}
my $default_form_data=&defaultFormData($symb,$url);
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ my %scantron_config=&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);
@@ -4437,19 +5329,25 @@ SCANTRONFORM
my @delayqueue;
my %completedstudents;
+ my $count=&get_todo_count($scanlines,$scan_data);
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status',
- 'Scantron Progress',$scanlines->{'count'},
+ 'Scantron Progress',$count,
'inline',undef,'scantronupload');
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
'Processing first student');
my $start=&Time::HiRes::time();
my $i=-1;
- my ($uname,$udom);
+ my ($uname,$udom,$started);
while ($i<$scanlines->{'count'}) {
($uname,$udom)=('','');
$i++;
- my $line=&scantron_get_line($scanlines,$i);
+ my $line=&scantron_get_line($scanlines,$scan_data,$i);
if ($line=~/^[\s\cz]*$/) { next; }
+ if ($started) {
+ &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
+ 'last student');
+ }
+ $started=1;
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
$scan_data);
unless ($uname=&scantron_find_student($scan_record,$scan_data,
@@ -4474,39 +5372,43 @@ SCANTRONFORM
'grade_target' =>'grade',
'grade_username'=>$uname,
'grade_domain' =>$udom,
- 'grade_courseid'=>$ENV{'request.course.id'},
+ 'grade_courseid'=>$env{'request.course.id'},
'grade_symb' =>$resource->symb());
if (exists($scan_record->{'scantron.CODE'}) &&
$scan_record->{'scantron.CODE'}) {
$form{'CODE'}=$scan_record->{'scantron.CODE'};
+ } else {
+ $form{'CODE'}='';
}
my $result=&Apache::lonnet::ssi($resource->src(),%form);
-
+ if ($result ne '') {
+ &Apache::lonnet::logthis("scantron grading error -> $result");
+ &Apache::lonnet::logthis("scantron grading error info name $uname domain $udom course $env{'request.course.id'} url ".$resource->src());
+ }
+ if (&Apache::loncommon::connection_aborted($r)) { last; }
}
$completedstudents{$uname}={'line'=>$line};
+ if (&Apache::loncommon::connection_aborted($r)) { last; }
} continue {
&Apache::lonnet::delenv('form.counter');
&Apache::lonnet::delenv('scantron\.');
- &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
- 'last student');
}
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
# my $lasttime = &Time::HiRes::time()-$start;
# $r->print("took $lasttime
");
- $navmap->untieHashes();
- $r->print("Done
");
+ $r->print("");
$r->print(&show_grading_menu_form($symb,$url));
return '';
}
sub scantron_upload_scantron_data {
my ($r)=@_;
- $r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'}));
+ $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));
my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid',
'domainid',
'coursename');
- my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'},
+ my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'},
'domainid');
my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
$r->print(< '."\n".
' '."\n".
''."\n";
- if (!&Apache::lonnet::allowed('usc',$ENV{'form.domainid'}) &&
+ if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) &&
!&Apache::lonnet::allowed('usc',
- $ENV{'form.domainid'}.'_'.$ENV{'form.courseid'})) {
+ $env{'form.domainid'}.'_'.$env{'form.courseid'})) {
$r->print("You are not allowed to upload Scantron data to the requested course. ");
if ($symb) {
$r->print(&show_grading_menu_form($symb,$url));
@@ -4555,10 +5457,9 @@ sub scantron_upload_scantron_data_save {
}
return '';
}
- $r->print("Doing upload to ".$ENV{'form.courseid'}." ");
- my $home=&Apache::lonnet::homeserver($ENV{'form.courseid'},
- $ENV{'form.domainid'});
- my $fname=$ENV{'form.upfile.filename'};
+ my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'});
+ $r->print("Doing upload to ".$coursedata{'description'}." ");
+ my $fname=$env{'form.upfile.filename'};
#FIXME
#copied from lonnet::userfileupload()
#make that function able to target a specified course
@@ -4572,31 +5473,75 @@ sub scantron_upload_scantron_data_save {
$fname=~s/[^\w\.\-]//g;
# See if there is anything left
unless ($fname) { return 'error: no uploaded file'; }
+ my $uploadedfile=$fname;
$fname='scantron_orig_'.$fname;
- if (length($ENV{'form.upfile'}) < 2) {
- $r->print("Error: The file you attempted to upload, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"')." , contained no information. Please check that you entered the correct filename.");
+ if (length($env{'form.upfile'}) < 2) {
+ $r->print("Error: The file you attempted to upload, ".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')." , contained no information. Please check that you entered the correct filename.");
} else {
- my $result=&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'},$ENV{'form.domainid'},$home,'upfile',$fname);
+ my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname);
if ($result =~ m|^/uploaded/|) {
- $r->print("Success: Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location ".$result." ");
+ $r->print("Success: Successfully uploaded ".(length($env{'form.upfile'})-1)." bytes of data into location ".$result." ");
} else {
- $r->print("Error: An error (".$result.") occured when attempting to upload the file, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"')." ");
+ $r->print("Error: An error (".$result.") occurred when attempting to upload the file, ".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')." ");
}
}
if ($symb) {
- $r->print(&show_grading_menu_form($symb,$url));
+ $r->print(&scantron_selectphase($r,$uploadedfile));
} else {
$r->print($doanotherupload);
}
return '';
}
+sub valid_file {
+ my ($requested_file)=@_;
+ foreach my $filename (sort(&scantron_filenames())) {
+ &Apache::lonnet::logthis("$requested_file $filename");
+ if ($requested_file eq $filename) { return 1; }
+ }
+ return 0;
+}
+
+sub scantron_download_scantron_data {
+ my ($r)=@_;
+ my $default_form_data=&defaultFormData(&get_symb_and_url($r,1));
+ my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $file=$env{'form.scantron_selectfile'};
+ if (! &valid_file($file)) {
+ $r->print(<
+ The requested file name was invalid.
+
+ERROR
+ $r->print(&show_grading_menu_form(&get_symb_and_url($r,1)));
+ 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;
+ &Apache::lonnet::allowuploaded('/adm/grades',$orig);
+ &Apache::lonnet::allowuploaded('/adm/grades',$corrected);
+ &Apache::lonnet::allowuploaded('/adm/grades',$skipped);
+ $r->print(<
+ Original file as uploaded by the scantron office.
+
+
+ Corrections , a file of corrected records that were used in grading.
+
+
+ Skipped , a file of records that were skipped.
+
+DOWNLOAD
+ $r->print(&show_grading_menu_form(&get_symb_and_url($r,1)));
+ return '';
+}
#-------- end of section for handling grading scantron forms -------
#
#-------------------------------------------------------------------
-
#-------------------------- Menu interface -------------------------
#
#--- Show a Grading Menu button - Calls the next routine ---
@@ -4605,7 +5550,7 @@ sub show_grading_menu_form {
my $result.=''."\n".
' '."\n".
' '."\n".
- ' '."\n".
+ ' '."\n".
' '."\n".
' '."\n".
' '."\n";
@@ -4615,8 +5560,8 @@ sub show_grading_menu_form {
# -- Retrieve choices for grading form
sub savedState {
my %savedState = ();
- if ($ENV{'form.saveState'}) {
- foreach (split(/:/,$ENV{'form.saveState'})) {
+ if ($env{'form.saveState'}) {
+ foreach (split(/:/,$env{'form.saveState'})) {
my ($key,$value) = split(/=/,$_,2);
$savedState{$key} = $value;
}
@@ -4649,6 +5594,7 @@ sub gradingmenu {
if (!checkReceiptNo(formname,'notOK')) { return false;}
formname.submit();
}
+ if (val < 7) formname.submit();
}
function checkReceiptNo(formname,nospace) {
@@ -4701,37 +5647,36 @@ GRADINGMENUJS
($saveSec eq $_ ? 'selected="on"':'').'>'.$_.''."\n";
}
}
- $result.= 'all ';
+ $result.= 'all ';
$result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef);
- if (ref($sections) && (grep /no/,@$sections)) {
- $result.=' (Section "no" implies the students were not assigned a section.) ';
- }
$result.=' ';
- $result.='