--- loncom/homework/grades.pm 2003/10/16 03:51:52 1.130.2.1.2.11 +++ loncom/homework/grades.pm 2007/06/15 22:12:49 1.408 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.130.2.1.2.11 2003/10/16 03:51:52 albertel Exp $ +# $Id: grades.pm,v 1.408 2007/06/15 22:12:49 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; @@ -46,54 +36,64 @@ use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; use Apache::loncoursedata; -use Apache::lonmsg qw(:user_normal_msg); +use Apache::lonmsg(); use Apache::Constants qw(:common); +use Apache::lonlocal; +use Apache::lonenc; use String::Similarity; +use LONCAPA; + +use POSIX qw(floor); my %oldessays=(); my %perm=(); # ----- These first few routines are general use routines.---- # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_(\w+)_.*/) { - push(@parts,$key); + my ($symb) = @_; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + my $partorder = &Apache::lonnet::metadata($url, 'partorder'); + my @parts; + if ($partorder) { + for my $part (split (/,/,$partorder)) { + if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { + push(@parts, $part); + } + } + } else { + my $metadata = &Apache::lonnet::metadata($url, 'packages'); + foreach (split(/\,/,$metadata)) { + if ($_ =~ /^part_(.*)$/) { + if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { + push(@parts, $1); + } + } } } - return @parts; + my @stores; + foreach my $part (@parts) { + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } + } + } + return @stores; } # --- Get the symbolic name of a problem and the url -sub get_symb_and_url { - my ($request) = @_; - (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 '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } - 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); +sub get_symb { + 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))); + if ($symb eq '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } } - return $fullname; + return ($symb); } #--- Format fullname, username:domain if different for display @@ -101,91 +101,232 @@ sub get_fullname { 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.')').')'; + return ' '.$fullname.' ('.$uname. + ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; } } #--- Get the partlist and the response type for a given problem. --- #--- 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 ''); - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my %seen = (); - my (@partlist,%handgrade); - foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_\w+.*/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! - my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); - $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no'); - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; - } + my ($symb) = shift; + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my %vPart = + map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + next if (%vPart && !exists($vPart{$part})); + + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $response_types{$part}{$ids[$i]} = $types[$i]; + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types); +} + +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; +} + +sub get_display_part { + my ($partID,$symb)=@_; + my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= " (id $partID)"; + } else { + $display=$partID; } - return \@partlist,\%handgrade; + return $display; } #--- Show resource title #--- and parts and response type sub showResourceInfo { - my ($url,$probTitle) = @_; - my $result =''. - ''."\n"; - my ($partlist,$handgrade) = &response_type($url); + my ($symb,$probTitle,$checkboxes) = @_; + my $col=3; + if ($checkboxes) { $col=4; } + my $result = '

'.&mt('Current Resource').': '.$probTitle.'

'."\n"; + $result .='
Current Resource: '.$probTitle.'
'; + my ($partlist,$handgrade,$responseType) = &response_type($symb); my %resptype = (); my $hdgrade='no'; - for (sort keys(%$handgrade)) { - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); - my $partID = (split(/_/))[0]; - $resptype{$partID} = $responsetype; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''. - ''; + my %partsseen; + foreach my $partID (sort keys(%$responseType)) { + foreach my $resID (sort keys(%{ $responseType->{$partID} })) { + my $handgrade=$$handgrade{$partID.'_'.$resID}; + my $responsetype = $responseType->{$partID}->{$resID}; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=""; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$symb); + $result.=''. + ''; # ''; + } } $result.='
Part '.$partID.'Type: '.$responsetype.'
 Part: '.$display_part.' '. + $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'."\n"; - return $result,\%resptype,$hdgrade,$partlist,$handgrade; + return $result,$responseType,$hdgrade,$partlist,$handgrade; } + +sub get_order { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); + $url=&Apache::lonnet::clutter($url); + my $subresult=&Apache::lonnet::ssi($url, + ('grade_target' => 'analyze'), + ('grade_domain' => $udom), + ('grade_symb' => $symb), + ('grade_courseid' => + $env{'request.course.id'}), + ('grade_username' => $uname)); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + return ($analyze{"$partid.$respid.shown"}); +} #--- Clean response type for display -#--- Currently filters option response type only. +#--- Currently filters option/rank/radiobutton/match/essay/Task +# response types only. sub cleanRecord { - my ($answer,$response,$symb) = @_; - if ($response eq 'option') { - my (@IDs,@ans); - foreach (split(/\&/,&Apache::lonnet::unescape($answer))) { - my ($optionID,$ans) = split(/=/); - push @IDs,$optionID.''; - push @ans,$ans; + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, + $uname,$udom) = @_; + my $grayFont = ''; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my ($toprow,$bottomrow); + foreach my $foil (@$order) { + if ($grading{$foil} == 1) { + $toprow.=''.$answer{$foil}.' '; + } else { + $toprow.=''.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; } - my $grayFont = ''; return '
'. - ''. - ''. - '
Answer'. - (join '',@ans).'
'.$grayFont.'Option ID'.$grayFont. - (join ''.$grayFont,@IDs).'
'; - } - if ($response eq 'essay') { - if (! exists ($ENV{'form.'.$symb})) { + 'Answer'.$toprow.''. + ''.$grayFont.'Option ID'. + $grayFont.$bottomrow.''.''; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } else { + $toprow.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $middlerow.''. + ''. + $bottomrow.''.'
Answer
'.$grayFont.'Item ID
'.$grayFont.'Option ID
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct=($order->[0])+1; + for (my $i=1;$i<=$#$order;$i++) { + my $foil=$order->[$i]; + if (exists($answer{$foil})) { + if ($i == $correct) { + $toprow.='true'; + } else { + $toprow.='true'; + } + } else { + $toprow.='false'; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; - $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; - $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; - $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; - $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + } + $answer =~ s-\n-
-g; + return '

'.&keywords_highlight($answer).'
'; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
',($version,@matches)); + + + } else { + my $result = + '

' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'

'; + + $result .= ''; + return $result; } - return '

'.&keywords_highlight($answer).'
'; + } return $answer; } @@ -218,7 +359,8 @@ sub commonJSfunctions { } } } else { - if (selectOne.selected) return selectOne.value; + // only one value it must be the selected one + return selectOne.value; } } @@ -229,34 +371,52 @@ COMMONJSFUNCTIONS #--- section, ids and fullnames for each user. sub getclasslist { my ($getsec,$filterlist) = @_; - $getsec = $getsec eq '' ? 'all' : $getsec; + my @getsec; + if (!ref($getsec)) { + if ($getsec ne '' && $getsec ne 'all') { + @getsec=($getsec); + } + } else { + @getsec=@{$getsec}; + } + if (grep(/^all$/,@getsec)) { undef(@getsec); } + my $classlist=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); # my %sections; my %fullnames; - foreach (keys(%$classlist)) { - # the following undefs are for 'domain', and 'username' respectively. - my (undef,undef,$end,$start,$id,$section,$fullname,$status)= - @{$classlist->{$_}}; + foreach my $student (keys(%$classlist)) { + my $end = + $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; + my $start = + $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; + my $id = + $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; + my $section = + $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $fullname = + $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; + my $status = + $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; # filter students according to status selected - if ($filterlist && $ENV{'form.Status'} ne 'Any') { - if ($ENV{'form.Status'} ne $status) { - delete ($classlist->{$_}); + if ($filterlist && $env{'form.Status'} ne 'Any') { + if ($env{'form.Status'} ne $status) { + delete ($classlist->{$student}); next; } } - $section = ($section ne '' ? $section : 'no'); + $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { - if ($getsec eq 'all' || $getsec eq $section) { + if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { $sections{$section}++; - $fullnames{$_}=$fullname; + $fullnames{$student}=$fullname; } else { - delete($classlist->{$_}); + delete($classlist->{$student}); } } else { - delete($classlist->{$_}); + delete($classlist->{$student}); } } my %seen = (); @@ -306,8 +466,8 @@ sub canview { #--- Retrieve the grade status of a student for all the parts sub student_gradeStatus { - my ($url,$symb,$udom,$uname,$partlist) = @_; - my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my ($symb,$udom,$uname,$partlist) = @_; + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); my %partstatus = (); foreach (@$partlist) { my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); @@ -323,7 +483,7 @@ sub student_gradeStatus { # Use by verifyscript and viewgrades # Shows a student's view of problem and submission sub jscriptNform { - my ($url,$symb) = @_; + my ($symb) = @_; my $jscript=''."\n"; $jscript.= '
'."\n". ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -344,6 +503,33 @@ sub jscriptNform { return $jscript; } +# Given the score (as a number [0-1] and the weight) what is the final +# point value? This function will round to the nearest tenth, third, +# or quarter if one of those is within the tolerance of .00001. +sub compute_points { + my ($score, $weight) = @_; + + my $tolerance = .00001; + my $points = $score * $weight; + + # Check for nearness to 1/x. + my $check_for_nearness = sub { + my ($factor) = @_; + my $num = ($points * $factor) + $tolerance; + my $floored_num = floor($num); + if ($num - $floored_num < 2 * $tolerance * $factor) { + return $floored_num / $factor; + } + return $points; + }; + + $points = $check_for_nearness->(10); + $points = $check_for_nearness->(3); + $points = $check_for_nearness->(4); + + return $points; +} + #------------------ End of general use routines -------------------- # @@ -357,6 +543,10 @@ sub most_similar { $uessay=~s/\W+/ /gs; +# ignore empty submissions (occuring when only files are sent) + + unless ($uessay=~/\w+/) { return ''; } + # these will be returned. Do not care if not at least 50 percent similar my $limit=0.6; my $sname=''; @@ -397,51 +587,66 @@ sub most_similar { sub verifyreceipt { my $request = shift; - my $courseid = $ENV{'request.course.id'}; - my $receipt = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. - $ENV{'form.receipt'}; + my $courseid = $env{'request.course.id'}; + my $receipt = &Apache::lonnet::recprefix($courseid).'-'. + $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $url = $ENV{'form.url'}; - my $symb = $ENV{'form.symb'}; - unless ($symb) { - $symb = &Apache::lonnet::symbread($url); - } + my ($symb) = &get_symb($request); - my $title.='

Verifying Submission Receipt '. - $receipt.'

'."\n". - 'Resource: '.$ENV{'form.probTitle'}.'

'."\n"; + my $title.='

Verifying Submission Receipt '. + $receipt.'

'."\n". + '

Resource: '.$env{'form.probTitle'}.'



'."\n"; my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); - - foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + + my $receiptparts=0; + if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || + $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } + my $parts=['0']; + if ($receiptparts) { ($parts)=&response_type($symb); } + foreach (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(/\:/); - if ($receipt eq - &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { - $contents.=' '."\n". - ''.$$fullname{$_}.' '."\n". - ' '.$uname.' '. - ' '.$udom.' '."\n"; - - $matches++; + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.=' '."\n". + ''.$$fullname{$_}.' '."\n". + ' '.$uname.' '. + ' '.$udom.' '; + if ($receiptparts) { + $contents.=' '.$part.' '; + } + $contents.=''."\n"; + + $matches++; + } } } if ($matches == 0) { $string = $title.'No match found for the above receipt.'; } else { - $string = &jscriptNform($url,$symb).$title. + $string = &jscriptNform($symb).$title. 'The above receipt matches the following student'. ($matches <= 1 ? '.' : 's.')."\n". '
'."\n". ''."\n". ''."\n". ''."\n". - ''."\n". - $contents. + ''; + if ($receiptparts) { + $string.=''; + } + $string.=''."\n".$contents. '
 Fullname  Username  Domain 
 Domain  Problem Part 
'."\n"; } - return $string.&show_grading_menu_form($symb,$url); + return $string.&show_grading_menu_form($symb); } #--- This is called by a number of programs. @@ -451,21 +656,20 @@ sub verifyreceipt { sub listStudents { 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 $submitonly= $ENV{'form.submitonly'} eq '' ? 'all' : $ENV{'form.submitonly'}; - - my $viewgrade = $ENV{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; - $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? - &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; + my ($symb) = &get_symb($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 $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + + my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; + $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? + &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; - my $result='

 '.$viewgrade. - ' Submissions for a Student or a Group of Students

'; + my $result='

 '.$viewgrade. + ' Submissions for a Student or a Group of Students

'; - my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'}); - $result.=$table; + my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); $request->print(< @@ -503,36 +707,46 @@ LISTJAVASCRIPT &commonJSfunctions($request); $request->print($result); - my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; - my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; - my $gradeTable=''."\n". - ' View Problem Text: no '."\n". - ' one student '."\n". - ' all students
'."\n". + my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked="checked"' : ''; + my $checklastsub = $checkhdgrade eq '' ? 'checked="checked"' : ''; + my $gradeTable=''. + "\n".$table. + ' View Problem Text: '."\n". + ''."\n". + '
'."\n". + ' View Answer: '."\n". + ''."\n". + '
'."\n". ' Submissions: '."\n"; - if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { - $gradeTable.=' essay part only'."\n"; + if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { + $gradeTable.=''."\n"; } - my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'}; - $ENV{'form.Status'} = $saveStatus; + my $saveStatus = $env{'form.Status'} eq '' ? 'Active' : $env{'form.Status'}; + $env{'form.Status'} = $saveStatus; + + $gradeTable.=''."\n". + ''."\n". + ''."\n". + '
'."\n". + ' Grading Increments: '. - $gradeTable.=' last sub only'."\n". - ' last sub & parts info'."\n". - ' by dates and submissions'."\n". - ' all details'."\n". ''."\n". ''."\n". - '
'."\n". - '
'."\n". - ''."\n". - ''."\n". - ''."\n". + '
'."\n". + '
'."\n". + ''."\n". + ''."\n". ''."\n". ''."\n"; - if (exists($ENV{'form.gradingMenu'}) && exists($ENV{'form.Status'})) { - $gradeTable.=''."\n"; + if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { + $gradeTable.=''."\n"; } else { $gradeTable.='Student Status: '. &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'
'; @@ -541,21 +755,31 @@ LISTJAVASCRIPT $gradeTable.='To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '. 'next to the student\'s name(s). Then click on the Next button.
'."\n". ''."\n"; + +# checkall buttons + $gradeTable.=&check_script('gradesub', 'stuinfo'); $gradeTable.=''."\n"; - - my (undef, undef, $fullname) = &getclasslist($getsec,'1'); + 'value="Next->" />
'."\n"; + $gradeTable.=&check_buttons(); + $gradeTable.=''; + my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. ''; my $loop = 0; while ($loop < 2) { $gradeTable.=''. - ''; - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + ''; + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { foreach (sort(@$partlist)) { - $gradeTable.=''; + my $display_part=&get_display_part((split(/_/))[0],$symb); + $gradeTable.=''; } + } elsif ($submitonly eq 'queued') { + $gradeTable.=''; } $loop++; # $gradeTable.='' if ($loop%2 ==1); @@ -563,37 +787,71 @@ LISTJAVASCRIPT $gradeTable.=''."\n"; my $ctr = 0; - 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); + my %status = (); - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { - (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); - my $statusflg = ''; + + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + next if (!defined($queue_status{'gradingqueue'})); + $status{'gradingqueue'} = $queue_status{'gradingqueue'}; + } + + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { + (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); + my $submitted = 0; + my $graded = 0; + my $incorrect = 0; foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); + my ($foo,$partid,$foo1) = split(/\./,$_); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { - $statusflg = ''; + $submitted = 0; + my ($part)=split(/\./,$partid); $gradeTable.=''; } } - next if ($statusflg eq '' && $submitonly eq 'yes'); + + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$graded && ($submitonly eq 'graded')); + next if (!$incorrect && $submitonly eq 'incorrect'); } $ctr++; + my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + if ( $perm{'vgr'} eq 'F' ) { $gradeTable.='' if ($ctr%2 ==1); $gradeTable.=''. - ''."\n". - ''."\n"; + ''."\n".''."\n"; - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { foreach (sort keys(%status)) { next if (/^resource.*?submitted_by$/); - $gradeTable.=''."\n"; + $gradeTable.=''."\n"; } } # $gradeTable.='' if ($ctr%2 ==1); @@ -602,49 +860,102 @@ LISTJAVASCRIPT } if ($ctr%2 ==1) { $gradeTable.=''; - if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { foreach (@$partlist) { $gradeTable.=''; } + } elsif ($submitonly eq 'queued') { + $gradeTable.=''; } $gradeTable.=''; } - $gradeTable.='
 No.  Select '.&nameUserString('header').''.&nameUserString('header').' Section/Group Part '.(split(/_/))[0].' Status  Part: '.$display_part. + ' Status  '.&mt('Queue Status').' 
'.$ctr.' '.&nameUserString(undef,$$fullname{$student},$uname,$udom).''. + &nameUserString(undef,$$fullname{$student},$uname,$udom). + ' '.$section.' '.$status{$_}.'  '.$status{$_}.'      
'. + $gradeTable.=''."\n". ''."\n"; if ($ctr == 0) { my $num_students=(scalar(keys(%$fullname))); if ($num_students eq 0) { - $gradeTable='
 There are no students currently enrolled.'; + $gradeTable='
 There are no students currently enrolled.'; } else { - $gradeTable='
 '. - 'No submissions found for this resource for any students. ('.$num_students. - ' checked for submissions
'; + my $submissions='submissions'; + if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } + if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } + if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } + $gradeTable='
 '. + 'No '.$submissions.' found for this resource for any students. ('.$num_students. + ' students checked for '.$submissions.')
'; } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; } - $gradeTable.=&show_grading_menu_form($symb,$url); + $gradeTable.=&show_grading_menu_form($symb); $request->print($gradeTable); return ''; } #---- Called from the listStudents routine + +sub check_script { + my ($form, $type)=@_; + my $chkallscript=''."\n"; + return $chkallscript; +} + +sub check_buttons { + my $buttons.=''; + $buttons.=' '; + $buttons.=''; + $buttons.=' '; + return $buttons; +} + # Displays the submissions for one student or a group of students sub processGroup { my ($request) = shift; my $ctr = 0; - my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} - : ($ENV{'form.stuinfo'})); + my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); my $total = scalar(@stuchecked)-1; - foreach (@stuchecked) { - my ($uname,$udom,$fullname) = split(/:/); - $ENV{'form.student'} = $uname; - $ENV{'form.userdom'} = $udom; - $ENV{'form.fullname'} = $fullname; + foreach my $student (@stuchecked) { + my ($uname,$udom,$fullname) = split(/:/,$student); + $env{'form.student'} = $uname; + $env{'form.userdom'} = $udom; + $env{'form.fullname'} = $fullname; &submission($request,$ctr,$total); $ctr++; } @@ -837,6 +1148,83 @@ sub sub_page_kw_js { my $request = shift; my $iconpath = $request->dir_config('lonIconsURL'); &commonJSfunctions($request); + + my $inner_js_msg_central=< + function checkInput() { + opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); + var nmsg = opener.document.SCORE.savemsgN.value; + var usrctr = document.msgcenter.usrctr.value; + var newval = opener.document.SCORE["newmsg"+usrctr]; + newval.value = opener.checkEntities(document.msgcenter.newmsg.value); + + var msgchk = ""; + if (document.msgcenter.subchk.checked) { + msgchk = "msgsub,"; + } + var includemsg = 0; + for (var i=1; i<=nmsg; i++) { + var opnmsg = opener.document.SCORE["savemsg"+i]; + var frmmsg = document.msgcenter["msg"+i]; + opnmsg.value = opener.checkEntities(frmmsg.value); + var showflg = opener.document.SCORE["shownOnce"+i]; + showflg.value = "1"; + var chkbox = document.msgcenter["msgn"+i]; + if (chkbox.checked) { + msgchk += "savemsg"+i+","; + includemsg = 1; + } + } + if (document.msgcenter.newmsgchk.checked) { + msgchk += "newmsg"+usrctr; + includemsg = 1; + } + imgformname = opener.document.SCORE["mailicon"+usrctr]; + imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); + var includemsg = opener.document.SCORE["includemsg"+usrctr]; + includemsg.value = msgchk; + + self.close() + + } + +INNERJS + + my $inner_js_highlight_central=< + function updateChoice(flag) { + opener.document.SCORE.kwclr.value = opener.radioSelection(document.hlCenter.kwdclr); + opener.document.SCORE.kwsize.value = opener.radioSelection(document.hlCenter.kwdsize); + opener.document.SCORE.kwstyle.value = opener.radioSelection(document.hlCenter.kwdstyle); + opener.document.SCORE.refresh.value = "on"; + if (opener.document.SCORE.keywords.value!=""){ + opener.document.SCORE.submit(); + } + self.close() + } + +INNERJS + + my $start_page_msg_central = + &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, + {'js_ready' => 1, + 'only_body' => 1, + 'bgcolor' =>'#FFFFFF',}); + my $end_page_msg_central = + &Apache::loncommon::end_page({'js_ready' => 1}); + + + my $start_page_highlight_central = + &Apache::loncommon::start_page('Highlight Central', + $inner_js_highlight_central, + {'js_ready' => 1, + 'only_body' => 1, + 'bgcolor' =>'#FFFFFF',}); + my $end_page_highlight_central = + &Apache::loncommon::end_page({'js_ready' => 1}); + + my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); + $docopen=~s/^document\.//; $request->print(< @@ -946,59 +1334,15 @@ sub sub_page_kw_js { var ypos = (screen.height-height)/2-30; ypos = (ypos < 0) ? '0' : ypos; - pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); + pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); pWin.focus(); pDoc = pWin.document; - pDoc.open('text/html','replace'); - pDoc.write(""); - pDoc.write("Message Central"); - - pDoc.write(" 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)=&get_symb($request); + if (!$symb) {return '';} + my $result=&checkforfile_js(); + $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); + my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); $result.=$table; - $result.='
' if ($ptr%2 == 0); + $studentTable.='
'."\n"; - $result.='
'."\n"; - $result.=' Specify a file containing the class scores for current resource'. + $result.='
'."\n"; + $result.=''."\n"; $result.='
'."\n"; + $result.=' '.&mt('Specify a file containing the class scores for current resource'). '.
'."\n"; + my $upload=&mt("Upload Scores"); my $upfile_select=&Apache::loncommon::upfile_select_html(); + my $ignore=&mt('Ignore First Line'); $result.=< - - - + + $upfile_select -
- +
+ ENDUPFORM - $result.='
'."\n"; + $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", + &mt("How do I create a CSV file from a spreadsheet")) + .'
'."\n"; $result.='


'."\n"; - $result.=&show_grading_menu_form($symb,$url); + $result.=&show_grading_menu_form($symb); return $result; } sub csvuploadmap { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); 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(); - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); + if ($env{'form.noFirstLine'}) { shift(@records); } + &csvuploadmap_header($request,$symb,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url); + my @fields=&csvupload_fields($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); @@ -2611,47 +3614,122 @@ 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); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(&show_grading_menu_form($symb)); 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 ($symb)=&get_symb($request); + my $checked=(($env{'form.noFirstLine'})?'1':'0'); + my $ignore=&mt('Ignore First Line'); + $request->print(< +

Uploading Class Grade Options

+ + +

+ +

+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)); + 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)=&get_symb($request); + if (!$symb) {return '';} + my $error_msg = ''; + &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'}}; - my $domain=$entries{$fields{'domain'}}; + $username=~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]; @@ -2659,34 +3737,70 @@ 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); + if ($wgt) { + $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 { + $error_msg = "
" . + &mt("Some point values were assigned" + ." for problems with a weight " + ."of zero. These values were " + ."ignored."); + } + } 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 save"); } + $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 save student $username:$domain. + Message when trying to save was ($result) + +

" ); + } $request->rflush(); $countdone++; } - $request->print("
Stored $countdone students\n"); + $request->print("
Saved $countdone students\n"); if (@skipped) { - $request->print('Skipped Students

'); + $request->print('

Skipped Students

'); foreach my $student (@skipped) { $request->print("$student
\n"); } } if (@notallowed) { - $request->print('

Students Not Allowed to Modify

'); + $request->print('

Students Not Allowed to Modify

'); foreach my $student (@notallowed) { $request->print("$student
\n"); } } $request->print("
\n"); - $request->print(&show_grading_menu_form($symb,$url)); - return ''; + $request->print(&show_grading_menu_form($symb)); + return $error_msg; } #------------- end of section for handling csv file upload --------- # @@ -2715,27 +3829,29 @@ 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 ($symb) = &get_symb($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 $result='

 '. - 'Manual Grading by Page or Sequence

'; + my $result='

 '. + 'Manual Grading by Page or Sequence

'; $result.='
'."\n"; $result.=' Problems from: '."
\n"; + $result.= ''."
\n"; $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -2746,27 +3862,29 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n"; - $result.=' View Problems Text: no '."\n". - ' yes '."
\n"; + $result.=' View Problems Text: '."\n". + ''."
\n"; $result.=' Submission Details: '. - ' none'."\n". - ' by dates and submissions'."\n". - ' all details'."\n"; + ''."\n". + ''."\n". + ''."\n"; $result.=''."\n". - ''."\n". + ''."\n". ''."\n". - ''."\n". ''."\n". - ''."
\n"; + ''."
\n"; + + $result.=' '.&mt('Use CODE:').' '. + '
'."\n"; $result.=' 
'."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. + my $studentTable.=' Select a student you wish to grade and then click on the Next button.
'. '
'. ''. ''. @@ -2776,21 +3894,27 @@ 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.=''; - $studentTable.='' : ''); $ptr++; } - $studentTable.='
 No.
'.$ptr.'   ' - .&nameUserString(undef,$$fullname{$student},$uname,$udom)."\n"; + $studentTable.=' \n"; $studentTable.=($ptr%2 == 0 ? '
  ' if ($ptr%2 == 0); - $studentTable.='
'."\n"; + $studentTable.='
  
'."\n"; $studentTable.=''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; @@ -2798,26 +3922,24 @@ LISTJAVASCRIPT sub getSymbMap { my ($request) = @_; - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db'); -# $navmap->init(); + my $navmap = Apache::lonnavmaps::navmap->new(); my %symbx = (); my @titles = (); 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(); - push @titles, $title; # minder in case two titles are identical - $symbx{$title} = $sequence->symb(); + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); $minder++; } } - - $navmap->untieHashes(); return \@titles,\%symbx; } @@ -2826,45 +3948,65 @@ sub getSymbMap { 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 ($symb) = &get_symb($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 ($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'}); + &Apache::lonnet::clear_EXT_cache_status(); + if (!&canview($usec)) { - $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print('Unable to view requested student.('.$env{'form.student'}.')'); + $request->print(&show_grading_menu_form($symb)); 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"; + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $result.='

 CODE: '.$env{'form.CODE'}.'

'."\n"; + } else { + delete($env{'form.CODE'}); + } &sub_page_js($request); $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + 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)); + 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 = ''."\n"; + } + my $checkIcon = ''.&mt('Check Mark'). + ''; $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. @@ -2872,9 +4014,10 @@ sub displayPage { '
'. ''. ''. - ''; + ''; - my ($depth,$question) = (1,1); + &Apache::lonxml::clear_problem_counter(); + my ($depth,$question,$prob) = (1,1,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" while ($depth > 0) { @@ -2885,39 +4028,48 @@ sub displayPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''; + $studentTable.=''; $studentTable.='
 Prob.  '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade
 '.($env{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade
'.$question. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'
'.$prob. + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').'		'; - if ($ENV{'form.vProb'} eq 'yes') { - $studentTable.=&show_problem($request,$symbx,$uname,$udom,1); + my %form = ('CODE' => $env{'form.CODE'},); + if ($env{'form.vProb'} eq 'yes' ) { + $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, + undef,'both',\%form); } 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'},%form); $companswer =~ s|||g; $companswer =~ s|||g; # while ($companswer =~ /()/s) { #\n"); +# $request->print('match='.$1."
\n"); # } # $companswer =~ s||
|g; - $studentTable.=' '.$title.' 
 Correct answer:
'.$companswer; + $studentTable.=' '.$title.' 
 Correct answer:
'.$companswer; } - my %record = &Apache::lonnet::restore($symbx,$ENV{'request.course.id'},$udom,$uname); + my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); - if ($ENV{'form.lastSub'} eq 'datesub') { + if ($env{'form.lastSub'} eq 'datesub') { if ($record{'version'} eq '') { - $studentTable.='
 No recorded submission for this problem
'; + $studentTable.='
 No recorded submission for this problem
'; } else { my %responseType = (); foreach my $partid (@{$parts}) { - $responseType{$partid} = $curRes->responseType($partid); + my @responseIds =$curRes->responseIds($partid); + my @responseType =$curRes->responseType($partid); + my %responseIds; + for (my $i=0;$i<=$#responseIds;$i++) { + $responseIds{$responseIds[$i]}=$responseType[$i]; + } + $responseType{$partid} = \%responseIds; } - $studentTable.= &displaySubByDates(\$symbx,\%record,$parts,\%responseType,$checkIcon); + $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'); } @@ -2927,6 +4079,7 @@ sub displayPage { $studentTable.=''."\n"; $question++; } + $prob++; } $studentTable.=''; @@ -2934,54 +4087,116 @@ sub displayPage { $curRes = $iterator->next(); } - $navmap->untieHashes(); - - $studentTable.='
'."\n". + $studentTable.='
'."\n". ''. + 'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'. ''."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; } sub displaySubByDates { - my ($symbx,$record,$parts,$responseType,$checkIcon) = @_; + my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; + my $isCODE=0; + my $isTask = ($symb =~/\.task$/); + if (exists($record->{'resource.CODE'})) { $isCODE=1; } my $studentTable='
'. ''. ''. + ($isCODE?'':''). ''. ''; my ($version); my %mark; + my %orders; $mark{'correct_by_student'} = $checkIcon; - return '
 Nothing submitted - no attempts
' - if (!exists($$record{'1:timestamp'})); + if (!exists($$record{'1:timestamp'})) { + return '
 Nothing submitted - no attempts
'; + } + + my $interaction; for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = scalar(localtime($$record{$version.':timestamp'})); + if (exists($$record{$version.':resource.0.version'})) { + $interaction = $$record{$version.':resource.0.version'}; + } + + my $where = ($isTask ? "$version:resource.$interaction" + : "$version:resource"); + #&Apache::lonnet::logthis(" got $where"); $studentTable.=''; + if ($isCODE) { + $studentTable.=''; + } my @versionKeys = split(/\:/,$$record{$version.':keys'}); my @displaySub = (); foreach my $partid (@{$parts}) { - my @matchKey = grep /^resource\.$partid\..*?\.submission$/,@versionKeys; + my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) + : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); + + # next if ($$record{"$version:resource.$partid.solved"} eq ''); - $displaySub[0].=(exists $$record{$version.':'.$matchKey[0]}) ? - 'Part '.$partid.' '. - ($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial not counted' : - 'Trial '.$$record{"$version:resource.$partid.tries"}).'  '. - &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid},$$symbx).'
' : ''; - $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ? - 'Part '.$partid.'  '. - lc($$record{"$version:resource.$partid.award"}).' '. - $mark{$$record{"$version:resource.$partid.solved"}}.'
' : ''; - $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ? - $$record{"$version:resource.$partid.regrader"}.' (Part: '.$partid.')' : ''; - } - $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ? - $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info - $studentTable.=''; + my $display_part=&get_display_part($partid,$symb); + foreach my $matchKey (@matchKey) { + if (exists($$record{$version.':'.$matchKey}) && + $$record{$version.':'.$matchKey} ne '') { + + my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) + : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); + #&Apache::lonnet::logthis("match $matchKey $responseId (".$$record{$version.':'.$matchKey}); + $displaySub[0].='Part: '.$display_part.' '; + $displaySub[0].='(ID '. + $responseId.') '; + if ($$record{"$where.$partid.tries"} eq '') { + $displaySub[0].='Trial not counted'; + } else { + $displaySub[0].='Trial '. + $$record{"$where.$partid.tries"}; + } + my $responseType=($isTask ? 'Task' + : $responseType->{$partid}->{$responseId}); + if (!exists($orders{$partid})) { $orders{$partid}={}; } + if (!exists($orders{$partid}->{$responseId})) { + $orders{$partid}->{$responseId}= + &get_order($partid,$responseId,$symb,$uname,$udom); + } + $displaySub[0].='  '. + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'
'; + } + } + if (exists($$record{"$where.$partid.checkedin"})) { + $displaySub[1].='Checked in by '. + $$record{"$where.$partid.checkedin"}.' into slot '. + $$record{"$where.$partid.checkedin.slot"}. + '
'; + } + if (exists $$record{"$where.$partid.award"}) { + $displaySub[1].='Part: '.$display_part.'  '. + lc($$record{"$where.$partid.award"}).' '. + $mark{$$record{"$where.$partid.solved"}}. + '
'; + } + if (exists $$record{"$where.$partid.regrader"}) { + $displaySub[2].=$$record{"$where.$partid.regrader"}. + ' ('.&mt('Part').': '.$display_part.')'; + } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { + $displaySub[2].= + $$record{"$version:resource.$partid.regrader"}. + ' ('.&mt('Part').': '.$display_part.')'; + } + } + # needed because old essay regrader has not parts info + if (exists $$record{"$version:resource.regrader"}) { + $displaySub[2].=$$record{"$version:resource.regrader"}; + } + $studentTable.=''; + } $studentTable.='
Date/TimeCODESubmissionStatus 
'.$timestamp.''.$record->{$version.':resource.CODE'}.''.$displaySub[0].' '.$displaySub[1]. - ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).' 
'.$displaySub[0].' '.$displaySub[1]; + if ($displaySub[2]) { + $studentTable.='Manually graded by '.$displaySub[2]; + } + $studentTable.=' 
'; return $studentTable; @@ -2990,29 +4205,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'})); 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($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); + my $navmap = Apache::lonnavmaps::navmap->new(); + 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)=&get_symb($request); + $request->print(&show_grading_menu_form($symb)); + return; + } my $iterator = $navmap->getIterator($map->map_start(), $map->map_finish()); @@ -3025,27 +4244,29 @@ sub updateGradeByPage { $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" - my ($depth,$question,$changeflag)= (1,1,0); + my ($depth,$question,$prob,$changeflag)= (1,1,1,0); while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''.$question. - (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; + $studentTable.=''.$prob. + (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=' '.$title.' '; 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) { @@ -3053,56 +4274,82 @@ 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 $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 $oldstatus = $ENV{'form.solved'.$question.'_'.$partid}; - $displayPts[0].=' Part '.$partid.' = '. + my $display_part=&get_display_part($partid,$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). - ' 
'; - + ' 
'; $question++; - next if ($dropMenu eq 'reset status' || ($newpts == $oldpts && $score ne 'excused')); + next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); $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'}, + my %record = + &Apache::lonnet::restore($symbx,$env{'request.course.id'}, + $udom,$uname); + + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $newrecord{'resource.CODE'} = $env{'form.CODE'}; + } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { + $newrecord{'resource.CODE'} = ''; + } + &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, $udom,$uname); + %record = &Apache::lonnet::restore($symbx, + $env{'request.course.id'}, + $udom,$uname); + &check_and_remove_from_queue($parts,\%record,undef,$symbx, + $cdom,$cnum,$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].''. ''; + $prob++; } $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'}); my $grademsg=($changeflag == 0 ? 'No score was changed or updated.' : 'The scores were changed for '. $changeflag.' problem'.($changeflag == 1 ? '.' : 's.')); @@ -3120,24 +4367,23 @@ sub updateGradeByPage { #------ start of section for handling grading by page/sequence --------- sub defaultFormData { - my ($symb,$url)=@_; + my ($symb)=@_; return ' '."\n". - ''."\n". - ''."\n". - ''."\n"; + ''."\n". + ''."\n"; } sub getSequenceDropDown { my ($request,$symb)=@_; 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, - &propath($cdom,$cname)); - foreach my $filename (@files) { + &propath($cdom,$cname)); + my @possiblenames; + foreach my $filename (sort(@files)) { ($filename)=split(/&/,$filename); if ($filename!~/^scantron_orig_/) { next ; } $filename=~s/^scantron_orig_//; - $result.="\n"; + push(@possiblenames,$filename); + } + return @possiblenames; +} + +sub scantron_uploads { + my ($file2grade) = @_; + my $result= '"; return $result; @@ -3176,6 +4420,7 @@ sub scantron_uploads { sub scantron_scantab { my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); my $result=''.$namechoice.''; + return $namechoice; +} + +sub scantron_CODEunique { + my $result=' + + + + + '; + return $result; +} + sub scantron_selectphase { - my ($r) = @_; - my ($symb,$url)=&get_symb_and_url($r); + my ($r,$file2grade) = @_; + my ($symb)=&get_symb($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 $default_form_data=&defaultFormData($symb); + my $grading_menu_button=&show_grading_menu_form($symb); + my $file_selector=&scantron_uploads($file2grade); my $format_selector=&scantron_scantab(); + my $CODE_selector=&scantron_CODElist(); + my $CODE_unique=&scantron_CODEunique(); my $result; #FIXME allow instructor to be able to download the scantron file # and to upload it, $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'})) { + + $r->print(< + +SCANTRONFORM + } + $r->print(< +
+ + + +SCANTRONFORM + + $r->print(< - - $grading_menu_button SCANTRONFORM - return $result; + return } sub get_scantron_config { @@ -3291,7 +4648,7 @@ sub scantron_fixup_scanline { my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; if ($field eq 'ID') { if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { - return ($line,1,'New value to large'); + return ($line,1,'New value too large'); } if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', @@ -3303,6 +4660,21 @@ sub scantron_fixup_scanline { &scan_data($scan_data,"$whichline.user", $args->{'username'}.':'.$args->{'domain'}); } + } elsif ($field eq 'CODE') { + if ($args->{'CODE_ignore_dup'}) { + &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); + } + &scan_data($scan_data,"$whichline.useCODE",'1'); + if ($args->{'CODE'} ne 'use_unfound') { + if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { + return ($line,1,'New CODE value too large'); + } + if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { + $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); + } + substr($line,$$scantron_config{'CODEstart'}-1, + $$scantron_config{'CODElength'})=$args->{'CODE'}; + } } elsif ($field eq 'answer') { my $length=$scantron_config->{'Qlength'}; my $off=$scantron_config->{'Qoff'}; @@ -3312,7 +4684,15 @@ 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; + if ($answer == 10) { $answer = '0'; } + } else { + substr($answer,$args->{'response'},1)=$on; + } &scan_data($scan_data, "$whichline.no_bubble.".$args->{'question'},undef,'1'); } @@ -3324,7 +4704,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; } @@ -3333,14 +4713,24 @@ sub scan_data { } sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data)=@_; + my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_; 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) { - $record{'scantron.CODE'}=substr($data,$$scantron_config{'CODEstart'}-1, + 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'}); + if (&scan_data($scan_data,"$whichline.useCODE")) { + $record{'scantron.useCODE'}=1; + } + if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { + $record{'scantron.CODE_ignore_dup'}=1; + } } else { #FIXME interpret first N questions } @@ -3356,6 +4746,8 @@ sub scantron_parse_scanline { $record{'scantron.LastName'}= substr($data,$$scantron_config{'LastName'}-1, $$scantron_config{'LastNamelength'}); + if ($justHeader) { return \%record; } + my @alphabet=('A'..'Z'); my $questnum=0; while ($questions) { @@ -3363,23 +4755,63 @@ 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 '?' + || $currentquest eq '*') { + push(@{$record{'scantron.doubleerror'}},$questnum); + $record{"scantron.$questnum.answer"}=''; + } elsif (!defined($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 '?' + || $currentquest eq '*') { + push(@{$record{'scantron.doubleerror'}},$questnum); + $record{"scantron.$questnum.answer"}=''; + } elsif (!defined($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 { + # wrap zero back to J + if ($currentquest eq '0') { + $record{"scantron.$questnum.answer"}= + $alphabet[9]; + } else { + $record{"scantron.$questnum.answer"}= + $alphabet[$currentquest-1]; + } } } 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); + 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); + } } } } @@ -3399,19 +4831,27 @@ sub scantron_find_student { my ($scantron_record,$scan_data,$idmap,$line)=@_; my $scanID=$$scantron_record{'scantron.ID'}; if ($scanID =~ /^\s*$/) { - return &scan_data($scan_data,"$line.user"); + return &scan_data($scan_data,"$line.user"); } foreach my $id (keys(%$idmap)) { - if (lc($id) eq lc($scanID)) { - return $$idmap{$id}; - } + if (lc($id) eq lc($scanID)) { + return $$idmap{$id}; + } } return undef; } sub scantron_filter { my ($curres)=@_; - if (ref($curres) && $curres->is_problem() && !$curres->randomout) { + + if (ref($curres) && $curres->is_problem()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } return 1; } return 0; @@ -3419,76 +4859,236 @@ 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'} =~ /^(missing|double)bubble$/) { - foreach my $question (split(',',$ENV{'form.scantron_questions'})) { + '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'}; + } elsif ($resolution eq 'use_typed') { + $newCODE=$env{'form.scantron_CODE_newvalue'}; + } elsif ($resolution =~ /^use_closest_(\d+)/) { + $newCODE=$env{"form.scantron_CODE_closest_$1"}; + } + 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'})) { ($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 start_skipping { + my ($scan_data,$i)=@_; + my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); + if ($env{'form.scantron_options_redo'} =~ /^redo_/) { + $remembered{$i}=2; + } else { + $remembered{$i}=1; + } + &scan_data($scan_data,'remember_skipping',join(':',%remembered)); +} + +sub should_be_skipped { + my ($scanlines,$scan_data,$i)=@_; + if ($env{'form.scantron_options_redo'} !~ /^redo_/) { + # not redoing old skips + if ($scanlines->{'skipped'}[$i]) { return 1; } + return 0; + } + my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); + + if (exists($remembered{$i}) && $remembered{$i} != 2 ) { + 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; + } + } + + &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 occurred ($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; + if ($scantron_config{'CODElocation'} && + $scantron_config{'CODEstart'} && + $scantron_config{'CODElength'}) { + $CODElist=$env{'form.scantron_CODElist'}; + if ($env{'form.scantron_CODElist'} eq '') { $CODElist='None'; } + $CODElist= + ''; + } + return (< +Please double check the information + below before clicking on '$button_text' +

+
+ + $default_form_data - - + + + + + + + + + + + + + + + + +
-  Specify file location and which Folder/Sequence to grade + +  Specify file and which Folder/Sequence to grade
- Sequence to grade: $sequence_selector - Sequence to grade: $sequence_selector
Filename of scoring office file: $file_selector
Format of data file: $format_selector
Saved CODEs to validate against: $CODE_selector
Each CODE is only to be used once: $CODE_unique
Options: - Filename of scoring office file: $file_selector +
+
+
+ +
+
+ + +  Specify a Scantron data file to upload. + +SCANTRONFORM + my $default_form_data=&defaultFormData(&get_symb($r,1)); + my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'}; + $r->print(< + function checkUpload(formname) { + if (formname.upfile.value == "") { + alert("Please use the browse button to select a file from your local directory."); + return false; + } + formname.submit(); + } + + +
+ $default_form_data + + + + File to upload: +
+ + +UPLOAD + + $r->print(<
- Format of data file: $format_selector -
- - Last line to expect an answer on: - -
+ $default_form_data + + + + + + + + + + + +
+  Download a scoring office file +
Filename of scoring office file: $file_selector
+ +
+
List of CODES to validate against:'. + $env{'form.scantron_CODElist'}.'
+ + +$CODElist +
Sequence to be Graded:$title
Data File that will be used:$env{'form.scantron_selectfile'}
+
+

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)=&get_symb($r); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb); + $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)); + 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); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); + + # 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(); + $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(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= < - - - - - $default_form_data -SCANTRONFORM + my $max_bubble=&scantron_get_maxbubble(); + my $result=&scantron_form_start($max_bubble).$default_form_data; $r->print($result); - my @validate_phases=( 'ID', + my @validate_phases=( 'sequence', + 'ID', 'CODE', 'doublebubble', 'missingbubbles'); - if (!$ENV{'form.validatepass'}) { - $ENV{'form.valiadatepass'} = 0; + if (!$env{'form.validatepass'}) { + $env{'form.validatepass'} = 0; } - my $currentphase=$ENV{'form.valiadatepass'}; + my $currentphase=$env{'form.validatepass'}; - if ($ENV{'form.scantron_selectfile'}=~m-^/-) { - #first pass copy file to classdir - - } my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { $r->print("

Validating ".$validate_phases[$currentphase]."

"); @@ -3500,56 +5100,98 @@ 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(""); } if ($stop) { - $r->print(''); - $r->print(' using corrected info
'); - $r->print(""); - $r->print(" this scanline saving it for later."); + if ($validate_phases[$currentphase] eq 'sequence') { + $r->print(''); + $r->print(' this error
'); + + $r->print("

Or click the 'Grading Menu' button to start over.

"); + } else { + $r->print(''); + $r->print(' using corrected info
'); + $r->print(""); + $r->print(" this scanline saving it for later."); + } } - $r->print("
".&show_grading_menu_form($symb,$url). - ""); + $r->print("
".&show_grading_menu_form($symb)); return ''; } +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 $file='scantron_'; + if ($which eq 'corrected' || $which eq 'skipped') { + $file.=$which.'_'; + } else { + return 'refused'; + } + $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'}; + 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) { + $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'}); - if ($lines eq '-1') { - #FIXME need to actually replicate file to course space - #FIXME when replicating strip CRLF to LF or CR to LF - } + '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 { $scanlines{'skipped'}=[(split("\n",$lines,-1))]; } - my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname); + my @tmp=&Apache::lonnet::dump('nohist_scantrondata',$cdom,$cname); if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } my %scan_data = @tmp; return (\%scanlines,\%scan_data); @@ -3557,49 +5199,110 @@ 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'}); - &Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname); +# $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($scanlines,$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; + &start_skipping($scan_data,$i); return; } $scanlines->{'corrected'}[$i]=$newline; } +sub scantron_clear_skip { + my ($scanlines,$scan_data,$i)=@_; + if (exists($scanlines->{'skipped'}[$i])) { + undef($scanlines->{'skipped'}[$i]); + return 1; + } + return 0; +} + +sub scantron_filter_not_exam { + my ($curres)=@_; + + if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } + return 1; + } + return 0; +} + +sub scantron_validate_sequence { + my ($r,$currentphase) = @_; + + my $navmap=Apache::lonnavmaps::navmap->new(); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($env{'form.selectpage'}); + + my $map=$navmap->getResourceByUrl($sequence); + + $r->print(''); + if ($env{'form.validate_sequence_exam'} ne 'ignore') { + my @resources= + $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); + if (@resources) { + $r->print("

".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."

"); + return (1,$currentphase); + } + } + + return (0,$currentphase+1); +} + sub scantron_validate_ID { my ($r,$currentphase) = @_; @@ -3608,12 +5311,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); @@ -3627,13 +5330,13 @@ sub scantron_validate_ID { if ($found{'ids'}{$found}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$found); - return(1); + return(1,$currentphase); } elsif ($found{'usernames'}{$username}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } - #FIXME store away line we prviously saw the ID on to use above + #FIXME store away line we previously saw the ID on to use above $found{'ids'}{$found}++; $found{'usernames'}{$username}++; } else { @@ -3643,18 +5346,18 @@ sub scantron_validate_ID { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } elsif (!defined($username)) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } $found{'usernames'}{$username}++; } else { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } } } @@ -3669,27 +5372,29 @@ sub scantron_get_correction { #to show both the current line and the previous one and allow skipping #the previous one or the current one - $r->print("

An error was detected ($error) "); - if ( defined($$scan_record{'scantron.PaperID'}) ) { + $r->print("

An error was detected ($error)"); + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { $r->print(" for PaperID ". $$scan_record{'scantron.PaperID'}." \n"); } else { $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$/) { - if ($error eq 'unknownID') { + if ($error eq 'incorrectID') { $r->print("The encoded ID is not in the classlist

\n"); } 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 @@ -3698,14 +5403,68 @@ sub scantron_get_correction { 'scantron_username','scantron_domain')); $r->print(": "); $r->print("\n@". - &Apache::loncommon::select_dom_form(undef,'scantron_domain')); + &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); $r->print('
    • '); + } elsif ($error =~ /CODE$/) { + if ($error eq 'incorrectCODE') { + $r->print("

    The encoded CODE is not in the list of possible CODEs

    \n"); + } 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($message); + $r->print("

    How should I handle this?
    \n"); + $r->print("\n
    "); + my $i=0; + if ($error eq 'incorrectCODE' + && $$scan_record{'scantron.CODE'}=~/\S/ ) { + my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); + if ($closest > 0) { + foreach my $testcode (@{$closest}) { + my $checked=''; + if (!$i) { $checked=' checked="checked" '; } + $r->print(""); + $r->print("\n
    "); + $i++; + } + } + } + if ($$scan_record{'scantron.CODE'}=~/\S/ ) { + my $checked; if (!$i) { $checked=' checked="checked" '; } + $r->print(""); + $r->print("\n
    "); + } + + $r->print(< +function change_radio(field) { + var slct=document.scantronupload.scantron_CODE_resolution; + var i; + for (i=0;i +ENDSCRIPT + my $href="/adm/pickcode?". + "form=".&escape("scantronupload"). + "&scantron_format=".&escape($env{'form.scantron_format'}). + "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). + "&curCODE=".&escape($$scan_record{'scantron.CODE'}). + "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); + if ($env{'form.scantron_CODElist'} =~ /\S/) { + $r->print(" Selected CODE is "); + $r->print("\n
    "); + } + $r->print(" as the CODE."); + $r->print("\n

    "); } elsif ($error eq 'doublebubble') { -#FIXME Need to print out who this is along with the paper info $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"}; @@ -3713,6 +5472,7 @@ sub scantron_get_correction { } } 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". + '"); } - $r->print(' No bubble '); + $r->print(''); $r->print(''); } +sub num_matches { + my ($orig,$code) = @_; + my @code=split(//,$code); + my @orig=split(//,$orig); + my $same=0; + for (my $i=0;$i{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $CODE=$$scan_record{'scantron.CODE'}; + my $error=0; + 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'} eq 'yes' + && !$$scan_record{'scantron.CODE_ignore_dup'}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateCODE',$usedCODEs{$CODE}); + return(1,$currentphase); + } + push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); + } return (0,$currentphase+1); } @@ -3762,10 +5615,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); @@ -3778,6 +5631,32 @@ sub scantron_validate_doublebubble { return (0,$currentphase+1); } +sub scantron_get_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'}); + + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + + &Apache::lonxml::clear_problem_counter(); + + foreach my $resource (@resources) { + my $result=&Apache::lonnet::ssi($resource->src(), + ('symb' => $resource->symb())); + } + &Apache::lonnet::delenv('scantron\.'); + $env{'form.scantron_maxbubble'} = + &Apache::lonxml::get_problem_counter()-1; + + return $env{'form.scantron_maxbubble'}; +} + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -3785,12 +5664,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=$ENV{'form.scantron_maxbubble'}; + 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); @@ -3812,16 +5691,16 @@ sub scantron_validate_missingbubbles { sub scantron_process_students { my ($r) = @_; - my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'}); - my ($symb,$url)=&get_symb_and_url($r); + my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); + my ($symb)=&get_symb($r); if (!$symb) {return '';} - my $default_form_data=&defaultFormData($symb,$url); + my $default_form_data=&defaultFormData($symb); - 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); - my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1); + my $navmap=Apache::lonnavmaps::navmap->new(); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); # $r->print("geto ".scalar(@resources)."
    "); @@ -3835,112 +5714,94 @@ 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); -# $r->print('
    line is'.$line.'
    '); - if ($line=~/^[\s\cz]*$/) { next; } - my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); - unless ($uname=&scantron_find_student($scan_record,$scan_data, - \%idmap,$i)) { - &scantron_add_delay(\@delayqueue,$line, - 'Unable to find a student that matches',1); - next; - } - if (exists $completedstudents{$uname}) { - &scantron_add_delay(\@delayqueue,$line, - 'Student '.$uname.' has multiple sheets',2); - next; + ($uname,$udom)=('',''); + $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, + \%idmap,$i)) { + &scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches',1); + next; + } + if (exists $completedstudents{$uname}) { + &scantron_add_delay(\@delayqueue,$line, + 'Student '.$uname.' has multiple sheets',2); + next; + } + ($uname,$udom)=split(/:/,$uname); + + &Apache::lonxml::clear_problem_counter(); + &Apache::lonnet::appenv(%$scan_record); + + if (&scantron_clear_skip($scanlines,$scan_data,$i)) { + &scantron_putfile($scanlines,$scan_data); } -# $r->print('
    doing studnet'.$uname.'
    '); - ($uname,$udom)=split(/:/,$uname); - &Apache::lonnet::delenv('form.counter'); - &Apache::lonnet::appenv(%$scan_record); -# &Apache::lonhomework::showhash(%ENV); -# $Apache::lonxml::debug=1; -# &Apache::lonxml::debug("line is $line"); - my $i=0; + my $i=0; foreach my $resource (@resources) { $i++; - my $result=&Apache::lonnet::ssi($resource->src(), - ('submitted' =>'scantron', - 'grade_target' =>'grade', - 'grade_username'=>$uname, - 'grade_domain' =>$udom, - 'grade_courseid'=>$ENV{'request.course.id'}, - 'grade_symb' =>$resource->symb())); -# my %score=&Apache::lonnet::restore($resource->symb(), -# $ENV{'request.course.id'}, -# $udom,$uname); -# foreach my $part ($resource->{PARTS}) { -# if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { -# $studentcorrect++; -# $totalcorrect++; -# } else { -# $studentincorrect++; -# $totalincorrect++; -# } -# } -# $r->print('
    '.
-#		      $resource->symb().'-'.
-#		      $resource->src().'-'.'
    result is'.$result); -# &Apache::lonhomework::showhash(%score); - # if ($i eq 3) {last;} + my %form=('submitted' =>'scantron', + 'grade_target' =>'grade', + 'grade_username'=>$uname, + 'grade_domain' =>$udom, + 'grade_courseid'=>$env{'request.course.id'}, + 'grade_symb' =>$resource->symb()); + if (exists($scan_record->{'scantron.CODE'}) + && + &Apache::lonnet::validCODE($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::lonxml::clear_problem_counter(); &Apache::lonnet::delenv('scantron\.'); - &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,$uname); - #last; - #FIXME - #get iterator for $sequence - #foreach question 'submit' the students answer to the server - # through grade target { - # generate data to pass back that includes grade recevied - #} } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); - my $lasttime = &Time::HiRes::time()-$start; - #$r->print("

    took $lasttime

    "); +# my $lasttime = &Time::HiRes::time()-$start; +# $r->print("

    took $lasttime

    "); - #$Apache::lonxml::debug=0; - foreach my $delay (@delayqueue) { - #FIXME - #print out each delayed student with interface to select how - # to repair student provided info - #Expected errors include - # 1 bad/no stuid/username - # 2 invalid bubblings - - } - #FIXME - # if delay queue exists 2 submits one to process delayed students one - # to ignore delayed students, possibly saving the delay queue for later - - $navmap->untieHashes(); - $r->print("

    Done

    "); - $r->print(&show_grading_menu_form($symb,$url)); + $r->print(""); + $r->print(&show_grading_menu_form($symb)); 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'); - my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, + 'domainid', + 'coursename'); + my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, 'domainid'); + my $default_form_data=&defaultFormData(&get_symb($r,1)); $r->print(< function checkUpload(formname) { @@ -3953,12 +5814,15 @@ sub scantron_upload_scantron_data {
    -Course: -Domain: $domsel $select_link -
    +$default_form_data + + + + + + +
    $select_link
    Course ID:
    Course Name:
    Domain: $domsel
    File to upload:
    -File to upload: -
    UPLOAD @@ -3967,10 +5831,26 @@ UPLOAD sub scantron_upload_scantron_data_save { my($r)=@_; - $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 ($symb)=&get_symb($r,1); + my $doanotherupload= + '
    '."\n". + ''."\n". + ''."\n". + '
    '."\n"; + if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && + !&Apache::lonnet::allowed('usc', + $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)); + } else { + $r->print($doanotherupload); + } + return ''; + } + 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 @@ -3984,29 +5864,82 @@ 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; - &Apache::lonnet::logthis("fname is $fname"); - $r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, - $ENV{'form.domainid'}, - $home,'upfile',$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."); + } else { + 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(&scantron_selectphase($r,$uploadedfile)); + } else { + $r->print($doanotherupload); + } return ''; } +sub valid_file { + my ($requested_file)=@_; + foreach my $filename (sort(&scantron_filenames())) { + if ($requested_file eq $filename) { return 1; } + } + return 0; +} + +sub scantron_download_scantron_data { + my ($r)=@_; + my $default_form_data=&defaultFormData(&get_symb($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($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($r,1))); + return ''; +} #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- - #-------------------------- Menu interface ------------------------- # #--- Show a Grading Menu button - Calls the next routine --- sub show_grading_menu_form { - my ($symb,$url)=@_; + my ($symb)=@_; my $result.='
    '."\n". ''."\n". - ''."\n". - ''."\n". + ''."\n". ''."\n". ''."\n". '
    '."\n"; @@ -4016,8 +5949,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; } @@ -4028,7 +5961,7 @@ sub savedState { #--- Displays the main menu page ------- sub gradingmenu { my ($request) = @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $probTitle = &Apache::lonnet::gettitle($symb); @@ -4044,12 +5977,13 @@ sub gradingmenu { } formname.command.value = cmd; formname.saveState.value = "saveCmd="+cmdsave+":saveSec="+pullDownSelection(formname.section)+ - ":saveSub="+radioSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); + ":saveSub="+pullDownSelection(formname.submitonly)+":saveStatus="+pullDownSelection(formname.Status); if (val < 5) formname.submit(); if (val == 5) { if (!checkReceiptNo(formname,'notOK')) { return false;} formname.submit(); } + if (val < 7) formname.submit(); } function checkReceiptNo(formname,nospace) { @@ -4068,8 +6002,8 @@ sub gradingmenu { GRADINGMENUJS &commonJSfunctions($request); - my $result='

     Manual Grading/View Submission

    '; - my ($table,undef,$hdgrade) = &showResourceInfo($url,$probTitle); + my $result='

     Manual Grading/View Submission

    '; + my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); $result.=$table; my (undef,$sections) = &getclasslist('all','0'); my $savedState = &savedState(); @@ -4080,7 +6014,6 @@ GRADINGMENUJS $result.='
    '."\n". ''."\n". - ''."\n". ''."\n". ''."\n". ''."\n". @@ -4088,46 +6021,50 @@ GRADINGMENUJS ''."\n". ''."\n"; - $result.='
    '."\n". - '
    '."\n". + $result.='
    '."\n". + ''."\n". '
    '."\n". ' Select a Grading/Viewing Option
    '."\n"; - $result.=''; + $result.='
    '; $result.=''; - $result.=''."\n"; + ($saveCmd eq 'submission' ? 'checked="checked"' : '').' /> '.''.&mt('Current Resource').': '.&mt('For one or more students'). + ''."\n"; $result.=''."\n"; + ''."\n"; $result.=''."\n"; + ''."\n"; $result.='
    '."\n". - ' Select Section: '."\n"; if (ref($sections)) { - foreach (sort (@$sections)) {$result.=''."\n";} + foreach (sort (@$sections)) { + $result.=''."\n"; + } } - $result.= '   '; - $result.='Student Status:'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); + $result.=&mt('Student Status').':'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); - if (ref($sections)) { - $result.=' (Section "no" implies the students were not assigned a section.)
    ' - if (grep /no/,@$sections); - } $result.='
    '. + $result.='
    '. - ' '. - 'Current Resource: For all students in selected section or course
    '. - ' '. - 'The complete set/page/sequence: For one student

    '. ''. @@ -4135,60 +6072,323 @@ GRADINGMENUJS $result.='    		'; - $result.=''; + $result.='
    '; $result.=''."\n"; + ''. + ' '.&mt('scores from file').' '."\n"; + + $result.=''."\n"; $result.=''."\n"; + '" value="'.&mt('Grade').'" /> scantron forms'."\n"; - if ((&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'})) && ($symb)) { + if ((&Apache::lonnet::allowed('mgr',$env{'request.course.id'})) && ($symb)) { $result.=''."\n"; } + $result.=''."\n"; + $result.=''."\n"; - $result.='
    '. - ''. - ' scores from file
    '. + ''. + ' '.&mt('clicker file').'
    '. ' scantron forms
    '. - ''. - ' submission Receipt no: '.unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}). - '-'. + ''. + ' '.&mt('receipt').': '. + &Apache::lonnet::recprefix($env{'request.course.id'}). + '-'. '
    '. + ' access times.
    '. + ' saved CODEs.
    '."\n". + $result.='
    '."\n". '
    '."\n". - '
    '."\n"; + '
    '."\n"; 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 gather_clicker_ids { + my %clicker_ids; + + my $classlist = &Apache::loncoursedata::get_classlist(); + + # Set up a couple variables. + my $username_idx = &Apache::loncoursedata::CL_SNAME(); + my $domain_idx = &Apache::loncoursedata::CL_SDOM(); + + foreach my $student (keys(%$classlist)) { + + my $username = $classlist->{$student}->[$username_idx]; + my $domain = $classlist->{$student}->[$domain_idx]; + my $clickers = + (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1]; + foreach my $id (split(/\,/,$clickers)) { + $id=~s/^0+//; + if (exists($clicker_ids{$id})) { + $clicker_ids{$id}.=','.$username.':'.$domain; + } else { + $clicker_ids{$id}=$username.':'.$domain; + } + } + } + return %clicker_ids; +} + +sub gather_adv_clicker_ids { + my %clicker_ids; + my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; + my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; + my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum); + foreach my $element (sort keys %coursepersonnel) { + foreach my $person (split(/\,/,$coursepersonnel{$element})) { + my ($puname,$pudom)=split(/\:/,$person); + my $clickers = + (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1]; + foreach my $id (split(/\,/,$clickers)) { + $id=~s/^0+//; + if (exists($clicker_ids{$id})) { + $clicker_ids{$id}.=','.$puname.':'.$pudom; + } else { + $clicker_ids{$id}=$puname.':'.$pudom; + } + } + } + } + return %clicker_ids; +} + +sub process_clicker { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my $result=&checkforfile_js(); + $env{'form.probTitle'} = &Apache::lonnet::gettitle($symb); + my ($table) = &showResourceInfo($symb,$env{'form.probTitle'}); + $result.=$table; + $result.='
    '."\n"; + $result.=''."\n"; + $result.='
    '."\n"; + $result.=' '.&mt('Specify a file containing the clicker information for this resource'). + '.
    '."\n"; + my $upload=&mt("Upload File"); + my $type=&mt("Type"); + my $attendance=&mt("Award points just for participation"); + my $personnel=&mt("Correctness determined from response by course personnel"); + my $specific=&mt("Correctness determined from response with clicker ID"); + my $pcorrect=&mt("Percentage points for correct solution"); + my $pincorrect=&mt("Percentage points for incorrect solution"); + my $selectform=&Apache::loncommon::select_form('iclicker','upfiletype', + ('iclicker' => 'i>clicker')); + + $result.=< +function sanitycheck() { +// Accept only integer percentages + document.forms.gradesupload.pcorrect.value=Math.round(document.forms.gradesupload.pcorrect.value); + document.forms.gradesupload.pincorrect.value=Math.round(document.forms.gradesupload.pincorrect.value); +// Find out grading choice + for (i=0; i +
    + + + + + +
    +
    +
    +
    + + +
    +
    +
    +
    +ENDUPFORM + $result.='
    '."\n". + '


    '."\n"; + $result.=&show_grading_menu_form($symb); + return $result; +} + +sub process_clicker_file { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { + $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; + return $result.&show_grading_menu_form($symb); + } + my %clicker_ids=&gather_clicker_ids(); + my %correct_ids; + if ($env{'form.gradingmechanism'} eq 'personnel') { + %correct_ids=&gather_adv_clicker_ids(); + } + if ($env{'form.gradingmechanism'} eq 'specific') { + my $correct_id=$env{'form.specificid'}; + $correct_id=~tr/a-z/A-Z/; + $correct_id=~s/\s//gs; + $correct_id=~s/^0+//; + $correct_ids{$correct_id}='specified'; + } + if ($env{'form.gradingmechanism'} eq 'attendance') { + $result.=&mt('Score based on attendance only'); + } else { + my $number=0; + $result.='

    '.&mt('Correctness determined by the following IDs').'

    '; + foreach my $id (sort(keys(%correct_ids))) { + $result.=''.$id.' - '; + if ($correct_ids{$id} eq 'specified') { + $result.=&mt('specified'); + } else { + my ($uname,$udom)=split(/\:/,$correct_ids{$id}); + $result.=&Apache::loncommon::plainname($uname,$udom); + } + $result.='
    '; + $number++; + } + if ($number==0) { + $result.=''.&mt('No IDs found to determine correct answer').''; + return $result.&show_grading_menu_form($symb); + } + } + if (length($env{'form.upfile'}) < 2) { + $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.', + '', + '', + ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').''); + return $result.&show_grading_menu_form($symb); + } + my %responses; + my @questiontitles; + my $errormsg=''; + my $number=0; + if ($env{'form.upfiletype'} eq 'iclicker') { + ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses); + } + $result.='
    '.&mt('Found [_1] questions',$number).'
    '; + foreach my $id (keys %responses) { + $result.='
    '.$id.' - '.$responses{$id}; + } + return $result.&show_grading_menu_form($symb); +} + +sub iclicker_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + chomp($line); + foreach my $quoted ($line=~/\,\s*\"([^\"]*)\"\s*\,/g) { + my $replace=$quoted; + $replace=~s/\,//g; + &Apache::lonnet::logthis($quoted.' - '.$replace.'
    '); + $line=~s/\,\s*\"\Q$quoted\E\"\s*\,/,$replace,/gs; + } + my @entries=split(/\,/,$line); + if ($entries[0] eq 'Question') { + for (my $i=3;$i<$#entries;$i+=6) { + $$questiontitles[$number]=$entries[$i]; + $number++; + } + } + if ($entries[0]=~/^\#/) { + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + for (my $i=0;$i<$number;$i++) { + my $idx=3+$i*6; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + } + return ($errormsg,$number); +} + sub handler { my $request=$_[0]; - undef(%perm); - if ($ENV{'browser.mathml'}) { - $request->content_type('text/xml'); + &reset_perm(); + if ($env{'browser.mathml'}) { + &Apache::loncommon::content_type($request,'text/xml'); } else { - $request->content_type('text/html'); + &Apache::loncommon::content_type($request,'text/html'); } $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 $command=$ENV{'form.command'}; - if (!$url) { - my ($temp1,$temp2); - ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$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'}; + my $symb=&get_symb($request,1); + my @commands=&Apache::loncommon::get_env_multiple('form.command'); + my $command=$commands[0]; + if ($#commands > 0) { + &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); + } + $request->print(&Apache::loncommon::start_page('Grading')); + if ($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'}; my ($tsymb,$tuname,$tudom,$tcrsid)= &Apache::lonnet::checkin($token); if ($tsymb) { - my ($map,$id,$url)=split(/\_\_\_/,$tsymb); + my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); if (&Apache::lonnet::allowed('mgr',$tcrsid)) { $request->print(&Apache::lonnet::ssi_body('/res/'.$url, ('grade_username' => $tuname, @@ -4206,22 +6406,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'}) { @@ -4240,62 +6427,56 @@ sub handler { $request->print(&editgrades($request)); } elsif ($command eq 'verify' && $perm{'vgr'}) { $request->print(&verifyreceipt($request)); + } elsif ($command eq 'processclicker' && $perm{'mgr'}) { + $request->print(&process_clicker($request)); + } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) { + $request->print(&process_clicker_file($request)); } elsif ($command eq 'csvform' && $perm{'mgr'}) { $request->print(&upcsvScores_form($request)); } elsif ($command eq 'csvupload' && $perm{'mgr'}) { $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'}) { + $request->print(&scantron_do_warning($request)); } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { $request->print(&scantron_validate_file($request)); } 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'})) { - $request->print(&scantron_upload_scantron_data($request)); - - } elsif ($command eq 'scantronupload_save' && - &Apache::lonnet::allowed('usc',$ENV{'request.role.domain'})) { - $request->print(&scantron_upload_scantron_data_save($request)); + } elsif ($command eq 'scantronupload' && + (&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'}))) { + $request->print(&scantron_upload_scantron_data_save($request)); + } elsif ($command eq 'scantron_download' && + &Apache::lonnet::allowed('usc',$env{'request.course.id'})) { + $request->print(&scantron_download_scantron_data($request)); } elsif ($command) { - $request->print("$command ".join(':',%perm)."Access Denied"); + $request->print("Access Denied ($command)"); } } - &send_footer($request); + $request->print(&Apache::loncommon::end_page()); return ''; } -sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); -# $request->print(" -#"); - $request->print(&Apache::loncommon::bodytag('Grading')); - $request->rflush(); -} - -sub send_footer { - my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); -} - 1; __END__;