--- loncom/homework/grades.pm 2004/09/14 13:30:09 1.209
+++ loncom/homework/grades.pm 2006/01/31 17:49:01 1.302.2.2
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.209 2004/09/14 13:30:09 ng Exp $
+# $Id: grades.pm,v 1.302.2.2 2006/01/31 17:49:01 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,16 +25,6 @@
#
# http://www.lon-capa.org/
#
-# 2/9,2/13 Guy Albertelli
-# 6/8 Gerd Kortemeyer
-# 7/26 H.K. Ng
-# 8/20 Gerd Kortemeyer
-# Year 2002
-# June-August H.K. Ng
-# Year 2003
-# February, March H.K. Ng
-# July, H. K. Ng
-#
package Apache::grades;
use strict;
@@ -90,8 +80,8 @@ sub getpartlist {
# --- Get the symbolic name of a problem and the url
sub get_symb_and_url {
my ($request,$silent) = @_;
- (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
- my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
+ (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
+ my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
if ($symb eq '') {
if (!$silent) {
$request->print("Unable to handle ambiguous references:$url:.");
@@ -101,34 +91,15 @@ sub get_symb_and_url {
return ($symb,$url);
}
-# --- Retrieve the fullname for a user. Return lastname, first middle ---
-# --- Generation is attached next to the lastname if it exists. ---
-sub get_fullname {
- my ($uname,$udom) = @_;
- my %name=&Apache::lonnet::get('environment', ['lastname','generation',
- 'firstname','middlename'],
- $udom,$uname);
- my $fullname;
- my ($tmp) = keys(%name);
- if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- $fullname = &Apache::loncoursedata::ProcessFullName
- (@name{qw/lastname generation firstname middlename/});
- } else {
- &Apache::lonnet::logthis('grades.pm: no name data for '.$uname.
- '@'.$udom.':'.$tmp);
- }
- return $fullname;
-}
-
#--- Format fullname, username:domain if different for display
#--- Use anywhere where the student names are listed
sub nameUserString {
my ($type,$fullname,$uname,$udom) = @_;
if ($type eq 'header') {
- return ' Fullname (Username) ';
+ return ' Fullname (Username) ';
} else {
return ' '.$fullname.' ('.$uname.
- ($ENV{'user.domain'} eq $udom ? '' : ' ('.$udom.')').') ';
+ ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')';
}
}
@@ -136,7 +107,7 @@ sub nameUserString {
#--- Indicate if a response type is coded handgraded or not. ---
sub response_type {
my ($url,$symb) = shift;
- $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');
+ $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');
my $allkeys = &Apache::lonnet::metadata($url,'keys');
my %vPart;
foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) {
@@ -170,7 +141,7 @@ sub response_type {
sub get_display_part {
my ($partID,$url,$symb)=@_;
if (!defined($symb) || $symb eq '') {
- $symb=$ENV{'form.symb'};
+ $symb=$env{'form.symb'};
if ($symb eq '') { $symb=&Apache::lonnet::symbread($url) }
}
my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb);
@@ -181,6 +152,7 @@ sub get_display_part {
}
return $display;
}
+
#--- Show resource title
#--- and parts and response type
sub showResourceInfo {
@@ -228,7 +200,7 @@ sub get_order {
('grade_domain' => $udom),
('grade_symb' => $symb),
('grade_courseid' =>
- $ENV{'request.course.id'}),
+ $env{'request.course.id'}),
('grade_username' => $uname));
(undef,$subresult)=split(/_HASH_REF__/,$subresult,2);
my %analyze=&Apache::lonnet::str2hash($subresult);
@@ -299,20 +271,25 @@ sub cleanRecord {
'
'.
+ ' '.
+ "\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};
$result.=' '."\n";
- $result.=' '."\n";
@@ -2460,7 +2821,7 @@ sub viewstudentgrade {
$status = 'nothing' if ($status eq '');
$result.=' '."\n";
- $result.=' '."\n";
$result.= (($status eq 'excused') ? ' excused '
@@ -2471,7 +2832,7 @@ sub viewstudentgrade {
$result.=' '.
"\n";
- $result.=' '."\n";
}
@@ -2485,11 +2846,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.= ''.
@@ -2503,7 +2864,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 = ();
@@ -2512,10 +2873,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) {
@@ -2546,49 +2907,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 '';
@@ -2606,11 +2975,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.' '.
@@ -2618,16 +2987,48 @@ 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;
@@ -2638,7 +3039,7 @@ sub editgrades {
&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;
}
@@ -2661,24 +3062,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();
}
@@ -2736,14 +3141,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
@@ -2754,18 +3160,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";
@@ -2850,19 +3268,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);
@@ -2882,39 +3301,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];
@@ -2922,19 +3408,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++;
}
@@ -2979,9 +3493,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 ';
@@ -3011,20 +3525,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";
@@ -3041,12 +3555,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++;
}
@@ -3070,7 +3590,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();
@@ -3079,8 +3600,6 @@ sub getSymbMap {
$minder++;
}
}
-
- $navmap->untieHashes();
return \@titles,\%symbx;
}
@@ -3090,49 +3609,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='
SCANTRONFORM
$r->print(<
-
$grading_menu_button
SCANTRONFORM
@@ -3747,7 +4292,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');
}
@@ -3759,7 +4311,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;
}
@@ -3772,8 +4324,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'});
@@ -3807,25 +4362,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;
@@ -3855,7 +4442,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;
@@ -3863,55 +4451,55 @@ 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 $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,$scan_data,$which,$line,$skip);
&scantron_putfile($scanlines,$scan_data);
@@ -3933,7 +4521,7 @@ sub allow_skipping {
sub should_be_skipped {
my ($scan_data,$i)=@_;
- if ($ENV{'form.scantron_options_redo'} !~ /^redo_/) {
+ if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
# not redoing old skips
return 0;
}
@@ -3964,15 +4552,27 @@ sub check_for_error {
sub scantron_warning_screen {
my ($button_text)=@_;
- my $title=&Apache::lonnet::gettitle($ENV{'form.selectpage'});
+ 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'}
+Sequence to be Graded: $title
+Data File that will be used: $env{'form.scantron_selectfile'}
+$CODElist
@@ -3989,14 +4589,28 @@ sub scantron_do_warning {
if (!$symb) {return '';}
my $default_form_data=&defaultFormData($symb,$url);
$r->print(&scantron_form_start().$default_form_data);
- my $warning=&scantron_warning_screen('Validate Records');
- $r->print(<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)."");
+ }
+ $r->print(" ".&show_grading_menu_form($symb,$url)."");
return '';
}
@@ -4004,14 +4618,14 @@ sub scantron_form_start {
my ($max_bubble)=@_;
my $result= <
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
SCANTRONFORM
return $result;
}
@@ -4024,23 +4638,23 @@ sub scantron_validate_file {
# 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') {
+ if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') {
&reset_skipping_status();
}
- if ($ENV{'form.scantron_options_redo'} eq 'redo_skipped') {
+ if ($env{'form.scantron_options_redo'} eq 'redo_skipped') {
&remember_current_skipped();
&scantron_remove_file('skipped');
- $ENV{'form.scantron_options_redo'}='redo_skipped_ready';
+ $env{'form.scantron_options_redo'}='redo_skipped_ready';
}
- if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') {
+ 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';
+ $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();
@@ -4054,10 +4668,10 @@ sub scantron_validate_file {
'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)) {
@@ -4095,27 +4709,27 @@ STUFF
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' || $which eq 'skipped') {
$file.=$which.'_';
} else {
return 'refused';
}
- $file.=$ENV{'form.scantron_selectfile'};
+ $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 $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' &&
+ if ($env{'form.scantron_options_redo'} eq 'redo_skipped_ready' &&
$key=~/remember_skipping/) {
next;
}
@@ -4131,25 +4745,25 @@ sub scantron_remove_scan_data {
sub scantron_getfile {
#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 $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 {
@@ -4163,30 +4777,29 @@ 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
- 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'};
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'});
+# $env{'form.scantron_selectfile'});
&lonnet_putfile(join("\n",@{$scanlines->{'corrected'}}),
$prefix.'corrected_'.
- $ENV{'form.scantron_selectfile'});
+ $env{'form.scantron_selectfile'});
&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
$prefix.'skipped_'.
- $ENV{'form.scantron_selectfile'});
+ $env{'form.scantron_selectfile'});
}
&Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
}
@@ -4228,7 +4841,7 @@ 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'=>{});
@@ -4297,6 +4910,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$/) {
@@ -4305,11 +4924,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
@@ -4318,7 +4933,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$/) {
@@ -4327,29 +4942,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(<
@@ -4364,18 +4980,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"};
@@ -4383,6 +5000,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('
');
}
@@ -4441,21 +5064,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 {
@@ -4474,13 +5110,21 @@ sub scantron_validate_CODE {
$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 (%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'}
+ 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,
@@ -4499,7 +5143,7 @@ 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,$scan_data,$i);
@@ -4517,27 +5161,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 {
@@ -4547,7 +5191,7 @@ 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; }
@@ -4574,12 +5218,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);
@@ -4640,16 +5284,23 @@ 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\.');
@@ -4658,7 +5309,6 @@ SCANTRONFORM
# my $lasttime = &Time::HiRes::time()-$start;
# $r->print("took $lasttime
");
- $navmap->untieHashes();
$r->print("");
$r->print(&show_grading_menu_form($symb,$url));
return '';
@@ -4666,11 +5316,11 @@ SCANTRONFORM
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));
@@ -4719,10 +5369,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
@@ -4738,21 +5387,18 @@ sub scantron_upload_scantron_data_save {
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);
-# if ($result =~ m|^/uploaded/|) {
- if ($result !~ m|^/uploaded/|) {
-# $r->print("Success: Successfully uploaded ".(length($ENV{'form.upfile'})-1)." bytes of data into location ".$result." ");
-# } else {
- $r->print("Error: An error (".$result.") occurred when attempting to upload the file, ".&HTML::Entities::encode($ENV{'form.upfile.filename'},'<>&"')." ");
+ 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." ");
+ } else {
+ $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);
}
@@ -4771,9 +5417,9 @@ sub valid_file {
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'};
+ 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(<
@@ -4808,7 +5454,6 @@ DOWNLOAD
#
#-------------------------------------------------------------------
-
#-------------------------- Menu interface -------------------------
#
#--- Show a Grading Menu button - Calls the next routine ---
@@ -4817,7 +5462,7 @@ sub show_grading_menu_form {
my $result.=''."\n".
' '."\n".
' '."\n".
- ' '."\n".
+ ' '."\n".
' '."\n".
' '."\n".
' '."\n";
@@ -4827,8 +5472,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;
}
@@ -4861,6 +5506,7 @@ sub gradingmenu {
if (!checkReceiptNo(formname,'notOK')) { return false;}
formname.submit();
}
+ if (val < 7) formname.submit();
}
function checkReceiptNo(formname,nospace) {
@@ -4913,34 +5559,36 @@ GRADINGMENUJS
($saveSec eq $_ ? 'selected="on"':'').'>'.$_.''."\n";
}
}
- $result.= 'all ';
+ $result.= ' all ';
$result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef);
$result.=' ';
- $result.=''.
+ $result.=' '.
' '.''.&mt('Current Resource').': '.&mt('For one or more students').
- ' '.
+ ' '.
'with submissions '.
+ ($saveSub eq 'yes' ? 'selected="on"' : '').'>'.&mt('with submissions').''.
+ ''.&mt('in grading queue').' '.
'with ungraded submissions '.
+ ($saveSub eq 'graded' ? 'selected="on"' : '').'>'.&mt('with ungraded submissions').''.
'with incorrect submissions '.
+ ($saveSub eq 'incorrect' ? 'selected="on"' : '').'>'.&mt('with incorrect submissions').''.
'with any status '."\n";
+ ($saveSub eq 'all' ? 'selected="on"' : '').'>'.&mt('with any status').''."\n";
$result.=''.
- ' '.
- 'Current Resource: For all students in selected section or course '."\n";
+ 'Current Resource: For all students in selected section or course'."\n";
$result.=''.
- ' '.
- 'The complete set/page/sequence: For one student '."\n";
+ 'The complete set/page/sequence: For one student'."\n";
$result.=' '.
' '.
@@ -4957,14 +5605,20 @@ GRADINGMENUJS
' scantron forms '."\n";
- if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) {
+ if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) {
$result.=''.
' '.
' '.&mt('receipt').': '.
- &Apache::lonnet::recprefix($ENV{'request.course.id'}).
+ &Apache::lonnet::recprefix($env{'request.course.id'}).
'- '.
' '."\n";
}
+ $result.=''.
+ ' access times. '."\n";
+ $result.=''.
+ ' saved CODEs. '."\n";
$result.='
'."\n".
'
'."\n".
@@ -4972,11 +5626,33 @@ GRADINGMENUJS
return $result;
}
+sub reset_perm {
+ undef(%perm);
+}
+
+sub init_perm {
+ &reset_perm();
+ foreach my $test_perm ('vgr','mgr','opa') {
+
+ my $scope = $env{'request.course.id'};
+ if (!($perm{$test_perm}=&Apache::lonnet::allowed($test_perm,$scope))) {
+
+ $scope .= '/'.$env{'request.course.sec'};
+ if ( $perm{$test_perm}=
+ &Apache::lonnet::allowed($test_perm,$scope)) {
+ $perm{$test_perm.'_section'}=$env{'request.course.sec'};
+ } else {
+ delete($perm{$test_perm});
+ }
+ }
+ }
+}
+
sub handler {
my $request=$_[0];
- undef(%perm);
- if ($ENV{'browser.mathml'}) {
+ &reset_perm();
+ if ($env{'browser.mathml'}) {
&Apache::loncommon::content_type($request,'text/xml');
} else {
&Apache::loncommon::content_type($request,'text/html');
@@ -4984,8 +5660,8 @@ sub handler {
$request->send_http_header;
return '' if $request->header_only;
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
- my $url=$ENV{'form.url'};
- my $symb=$ENV{'form.symb'};
+ my $url=$env{'form.url'};
+ my $symb=$env{'form.symb'};
my @commands=&Apache::loncommon::get_env_multiple('form.command');
my $command=$commands[0];
if ($#commands > 0) {
@@ -4993,16 +5669,16 @@ sub handler {
}
if (!$url) {
my ($temp1,$temp2);
- ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb);
- $url = $ENV{'form.url'};
+ ($temp1,$temp2,$env{'form.url'})=&Apache::lonnet::decode_symb($symb);
+ $url = $env{'form.url'};
}
&send_header($request);
if ($url eq '' && $symb eq '' && $command eq '') {
- if ($ENV{'user.adv'}) {
- if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
- ($ENV{'form.codethree'})) {
- my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'.
- $ENV{'form.codethree'};
+ if ($env{'user.adv'}) {
+ if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&
+ ($env{'form.codethree'})) {
+ my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'.
+ $env{'form.codethree'};
my ($tsymb,$tuname,$tudom,$tcrsid)=
&Apache::lonnet::checkin($token);
if ($tsymb) {
@@ -5024,22 +5700,9 @@ sub handler {
}
}
} else {
- if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}))) {
- if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
- $perm{'vgr_section'}=$ENV{'request.course.sec'};
- } else {
- delete($perm{'vgr'});
- }
- }
- if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}))) {
- if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
- $perm{'mgr_section'}=$ENV{'request.course.sec'};
- } else {
- delete($perm{'mgr'});
- }
- }
+ &init_perm();
if ($command eq 'submission' && $perm{'vgr'}) {
- ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
+ ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
&pickStudentPage($request);
} elsif ($command eq 'displayPage' && $perm{'vgr'}) {
@@ -5064,17 +5727,19 @@ sub handler {
$request->print(&csvupload($request));
} elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
$request->print(&csvuploadmap($request));
- } elsif ($command eq 'csvuploadassign' && $perm{'mgr'}) {
- if ($ENV{'form.associate'} ne 'Reverse Association') {
- $request->print(&csvuploadassign($request));
+ } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) {
+ if ($env{'form.associate'} ne 'Reverse Association') {
+ $request->print(&csvuploadoptions($request));
} else {
- if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {
- $ENV{'form.upfile_associate'} = 'reverse';
+ if ( $env{'form.upfile_associate'} ne 'reverse' ) {
+ $env{'form.upfile_associate'} = 'reverse';
} else {
- $ENV{'form.upfile_associate'} = 'forward';
+ $env{'form.upfile_associate'} = 'forward';
}
$request->print(&csvuploadmap($request));
}
+ } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
+ $request->print(&csvuploadassign($request));
} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
$request->print(&scantron_selectphase($request));
} elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
@@ -5084,15 +5749,15 @@ sub handler {
} elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
$request->print(&scantron_process_students($request));
} elsif ($command eq 'scantronupload' &&
- (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||
- &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {
+ (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
$request->print(&scantron_upload_scantron_data($request));
} elsif ($command eq 'scantronupload_save' &&
- (&Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})||
- &Apache::lonnet::allowed('usc',$ENV{'request.course.id'}))) {
+ (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
$request->print(&scantron_upload_scantron_data_save($request));
} elsif ($command eq 'scantron_download' &&
- &Apache::lonnet::allowed('usc',$ENV{'request.course.id'})) {
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
$request->print(&scantron_download_scantron_data($request));
} elsif ($command) {
$request->print("Access Denied ($command)");
@@ -5116,8 +5781,7 @@ sub send_header {
sub send_footer {
my ($request)= @_;
- $request->print('