--- loncom/homework/grades.pm 2003/09/25 08:30:57 1.130.2.1.2.3
+++ loncom/homework/grades.pm 2003/10/28 23:20:03 1.145
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.3 2003/09/25 08:30:57 albertel Exp $
+# $Id: grades.pm,v 1.145 2003/10/28 23:20:03 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -185,7 +185,7 @@ sub cleanRecord {
$ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : '';
$ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob.
}
- return '<br /><br /><blockquote>'.&keywords_highlight($answer).'</blockquote>';
+ return '<br /><br /><blockquote><pre>'.&keywords_highlight($answer).'</pre></blockquote>';
}
return $answer;
}
@@ -218,7 +218,8 @@ sub commonJSfunctions {
}
}
} else {
- if (selectOne.selected) return selectOne.value;
+ // only one value it must be the selected one
+ return selectOne.value;
}
}
</script>
@@ -506,9 +507,12 @@ LISTJAVASCRIPT
my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : '';
my $checklastsub = $checkhdgrade eq '' ? 'checked' : '';
my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n".
- ' <b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n".
+ ' <b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n".
'<input type="radio" name="vProb" value="yes" /> one student '."\n".
'<input type="radio" name="vProb" value="all" /> all students <br />'."\n".
+ ' <b>View Answer: </b><input type="radio" name="vAns" value="no" /> no '."\n".
+ '<input type="radio" name="vAns" value="yes" /> one student '."\n".
+ '<input type="radio" name="vAns" value="all" checked="on" /> all students <br />'."\n".
' <b>Submissions: </b>'."\n";
if ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) {
$gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> essay part only'."\n";
@@ -517,8 +521,8 @@ LISTJAVASCRIPT
my $saveStatus = $ENV{'form.Status'} eq '' ? 'Active' : $ENV{'form.Status'};
$ENV{'form.Status'} = $saveStatus;
- $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last sub only'."\n".
- '<input type="radio" name="lastSub" value="last" /> last sub & parts info'."\n".
+ $gradeTable.='<input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last submission only'."\n".
+ '<input type="radio" name="lastSub" value="last" /> last submission & parts info'."\n".
'<input type="radio" name="lastSub" value="datesub" /> by dates and submissions'."\n".
'<input type="radio" name="lastSub" value="all" /> all details'."\n".
'<input type="hidden" name="section" value="'.$getsec.'" />'."\n".
@@ -544,7 +548,7 @@ LISTJAVASCRIPT
$gradeTable.='<input type="button" '."\n".
'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".
'value="Next->" />'."\n";
-
+ $gradeTable.='<input type="checkbox" name="checkPlag" checked="on">Check For Plagiarism</input>';
my (undef, undef, $fullname) = &getclasslist($getsec,'1');
$gradeTable.='<table border="0"><tr><td bgcolor="#777777">'.
'<table border="0"><tr bgcolor="#e6ffff">';
@@ -568,18 +572,21 @@ LISTJAVASCRIPT
my %status = ();
if ($ENV{'form.showgrading'} eq 'yes' && $submitonly ne 'all') {
(%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist);
- my $statusflg = '';
+ my $submitted = 0;
+ my $graded = 1;
foreach (keys(%status)) {
- $statusflg = 1 if ($status{$_} ne 'nothing');
+ $submitted = 1 if ($status{$_} ne 'nothing');
+ $graded = 0 if ($status{$_} =~ /^correct/);
my ($foo,$partid,$foo1) = split(/\./,$_);
if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
- $statusflg = '';
+ $submitted = 0;
$gradeTable.='<input type="hidden" name="'.
$student.':submitted_by" value="'.
$status{'resource.'.$partid.'.submitted_by'}.'" />';
}
}
- next if ($statusflg eq '' && $submitonly eq 'yes');
+ next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded'));
+ next if (!$graded && $submitonly eq 'graded');
}
$ctr++;
@@ -621,7 +628,7 @@ LISTJAVASCRIPT
} else {
$gradeTable='<br /> <font color="red">'.
'No submissions found for this resource for any students. ('.$num_students.
- ' checked for submissions</font><br />';
+ ' checked for submissions)</font><br />';
}
} elsif ($ctr == 1) {
$gradeTable =~ s/type=checkbox/type=checkbox checked/;
@@ -1195,27 +1202,46 @@ sub gradeBox {
}
sub show_problem {
- my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_;
- my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
- $ENV{'request.course.id'});
+ my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_;
+ my $rendered;
+ if ($mode eq 'both' or $mode eq 'text') {
+ $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
+ $ENV{'request.course.id'});
+ }
if ($removeform) {
$rendered=~s|<form(.*?)>||g;
$rendered=~s|</form>||g;
$rendered=~s|name="submit"|name="would_have_been_submit"|g;
}
- my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
- $ENV{'request.course.id'});
+ my $companswer;
+ if ($mode eq 'both' or $mode eq 'answer') {
+ $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
+ $ENV{'request.course.id'});
+ }
if ($removeform) {
$companswer=~s|<form(.*?)>||g;
$companswer=~s|</form>||g;
- $rendered=~s|name="submit"|name="would_have_been_submit"|g;
+ $companswer=~s|name="submit"|name="would_have_been_submit"|g;
}
my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">';
$result.='<table border="0" width="100%">';
- $result.='<tr><td bgcolor="#e6ffff"><b> View of the problem - '.$ENV{'form.fullname'}.
- '</b></td></tr>' if ($viewon);
- $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />';
- $result.='<b>Correct answer:</b><br />'.$companswer;
+ if ($viewon) {
+ $result.='<tr><td bgcolor="#e6ffff"><b> ';
+ if ($mode eq 'both' or $mode eq 'text') {
+ $result.='View of the problem - ';
+ } else {
+ $result.='Correct answer: ';
+ }
+ $result.=$ENV{'form.fullname'}.'</b></td></tr>';
+ }
+ if ($mode eq 'both') {
+ $result.='<tr><td bgcolor="#ffffff">'.$rendered.'<br />';
+ $result.='<b>Correct answer:</b><br />'.$companswer;
+ } elsif ($mode eq 'text') {
+ $result.='<tr><td bgcolor="#ffffff">'.$rendered;
+ } elsif ($mode eq 'answer') {
+ $result.='<tr><td bgcolor="#ffffff">'.$companswer;
+ }
$result.='</td></tr></table>';
$result.='</td></tr></table><br />';
return $result;
@@ -1264,8 +1290,16 @@ sub submission {
# option to display problem, only once else it cause problems
# with the form later since the problem has a form.
- if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) {
- $request->print(&show_problem($request,$symb,$uname,$udom,0,1));
+ if ($ENV{'form.vProb'} eq 'yes' or $ENV{'form.vAns'} eq 'yes') {
+ my $mode;
+ if ($ENV{'form.vProb'} eq 'yes' && $ENV{'form.vAns'} eq 'yes') {
+ $mode='both';
+ } elsif ($ENV{'form.vProb'} eq 'yes') {
+ $mode='text';
+ } elsif ($ENV{'form.vAns'} eq 'yes') {
+ $mode='answer';
+ }
+ $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode));
}
# kwclr is the only variable that is guaranteed to be non blank
@@ -1300,6 +1334,7 @@ sub submission {
'<input type="hidden" name="url" value="'.$url.'" />'."\n".
'<input type="hidden" name="showgrading" value="'.$ENV{'form.showgrading'}.'" />'."\n".
'<input type="hidden" name="vProb" value="'.$ENV{'form.vProb'}.'" />'."\n".
+ '<input type="hidden" name="vAns" value="'.$ENV{'form.vAns'}.'" />'."\n".
'<input type="hidden" name="lastSub" value="'.$ENV{'form.lastSub'}.'" />'."\n".
'<input type="hidden" name="section" value="'.$ENV{'form.section'}.'">'."\n".
'<input type="hidden" name="submitonly" value="'.$ENV{'form.submitonly'}.'">'."\n".
@@ -1350,10 +1385,19 @@ KEYWORDS
}
}
- if ($ENV{'form.vProb'} eq 'all') {
+ if ($ENV{'form.vProb'} eq 'all' or $ENV{'form.vAns'} eq 'all') {
$request->print('<br /><br /><br />') if ($counter > 0);
- $request->print(&show_problem($request,$symb,$uname,$udom,1,1));
+ my $mode;
+ if ($ENV{'form.vProb'} eq 'all' && $ENV{'form.vAns'} eq 'all') {
+ $mode='both';
+ } elsif ($ENV{'form.vProb'} eq 'all' ) {
+ $mode='text';
+ } elsif ($ENV{'form.vAns'} eq 'all') {
+ $mode='answer';
+ }
+ $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode));
}
+
my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
my ($partlist,$handgrade) = &response_type($url,$symb);
@@ -1461,13 +1505,20 @@ KEYWORDS
my ($ressub,$subval) = split(/:/,$_,2);
# Similarity check
my $similar='';
- my ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval);
- if ($osim) {
- $osim=int($osim*100.0);
- $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim.
- '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).
- '</font></h3><blockquote><i>'.
- &keywords_highlight($oessay).'</i></blockquote><hr />';
+ my $oname;
+ my $odom;
+ my $ocrsid;
+ my $oessay;
+ my $osim;
+ if($ENV{'form.checkPlag'}){
+ ($oname,$odom,$ocrsid,$oessay,$osim)=&most_similar($uname,$udom,$subval);
+ if ($osim) {
+ $osim=int($osim*100.0);
+ $similar='<hr /><h3><font color="#FF0000">Essay is '.$osim.
+ '% similar to an essay by '.&Apache::loncommon::plainname($oname,$odom).
+ '</font></h3><blockquote><i>'.
+ &keywords_highlight($oessay).'</i></blockquote><hr />';
+ }
}
$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
$partid.'</b> <font color="#999999">( ID '.$respid.
@@ -1480,7 +1531,7 @@ KEYWORDS
'this file may contain virusses</font><br />':'').
'<b>Submitted Answer: </b>'.
&cleanRecord($subval,$responsetype,$symb).
- '<br /><br />'.$similar."\n"
+ '<br /><br />'.$similar."\n"
if ($ENV{'form.lastSub'} eq 'lastonly' ||
($ENV{'form.lastSub'} eq 'hdgrade' &&
$$handgrade{$part} =~ /:yes$/));
@@ -1782,15 +1833,25 @@ sub processHandGrade {
}
$ctr = 0;
@parsedlist = reverse @parsedlist if ($button eq 'Previous');
+ my ($partlist) = &response_type($url);
foreach my $student (@parsedlist) {
+ my $submitonly=$ENV{'form.submitonly'};
my ($uname,$udom) = split(/:/,$student);
- if ($ENV{'form.submitonly'} eq 'yes') {
- my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
- my $statusflg = '';
- foreach (split(/:/,$ENV{'form.gradePartRespid'})){
- $statusflg = 1 if (exists ($record{'resource.'.$_.'.submission'}));
+ if ($submitonly =~ /^(yes|graded)$/) {
+# my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
+ my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist);
+ my $submitted = 0;
+ my $graded = 1;
+ foreach (keys(%status)) {
+ $submitted = 1 if ($status{$_} ne 'nothing');
+ $graded = 0 if ($status{$_} =~ /^correct/);
+ my ($foo,$partid,$foo1) = split(/\./,$_);
+ if ($status{'resource.'.$partid.'.submitted_by'} ne '') {
+ $submitted = 0;
+ }
}
- next if ($statusflg eq '');
+ next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded'));
+ next if (!$graded && $submitonly eq 'graded');
}
push @nextlist,$student if ($ctr < $ntstu);
last if ($ctr == $ntstu);
@@ -2327,18 +2388,17 @@ sub editgrades {
$newrecord{'resource.'.$_.'.awarded'} = 0;
$newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
$updateflag = 1;
+ } elsif (!($old_part eq $partial && $old_score eq $score)) {
+ $updateflag = 1;
+ $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne '';
+ $newrecord{'resource.'.$_.'.solved'} = $score;
+ $rec_update++;
}
$line .= '<td align="center">'.$old_aw.' </td>'.
'<td align="center">'.$awarded.
($score eq 'excused' ? $score : '').' </td>';
- if (!($old_part eq $partial && $old_score eq $score)) {
- $updateflag = 1;
- $newrecord{'resource.'.$_.'.awarded'} = $partial if $partial ne '';
- $newrecord{'resource.'.$_.'.solved'} = $score;
- $rec_update++;
- }
my $partid=$_;
foreach my $stores (@parts) {
@@ -2726,7 +2786,9 @@ LISTJAVASCRIPT
$result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
$result.=' <b>Problems from:</b> <select name="selectpage">'."\n";
my ($titles,$symbx) = &getSymbMap($request);
- my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/);
+ my ($curpage) =&Apache::lonnet::decode_symb($symb);
+# my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb);
+# my $type=($curpage =~ /\.(page|sequence)/);
my $ctr=0;
foreach (@$titles) {
my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
@@ -2746,7 +2808,7 @@ LISTJAVASCRIPT
$result.='<input type="hidden" name="page" />'."\n".
'<input type="hidden" name="title" />'."\n";
- $result.=' <b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked /> no '."\n".
+ $result.=' <b>View Problems Text: </b><input type="radio" name="vProb" value="no" checked="on" /> no '."\n".
'<input type="radio" name="vProb" value="yes" /> yes '."<br>\n";
$result.=' <b>Submission Details: </b>'.
@@ -2798,9 +2860,7 @@ 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 = ();
@@ -2845,9 +2905,8 @@ sub displayPage {
&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
my $iterator = $navmap->getIterator($map->map_start(),
@@ -2888,8 +2947,9 @@ sub displayPage {
$studentTable.='<tr bgcolor="#ffffe6"><td align="center" valign="top" >'.$question.
(scalar(@{$parts}) == 1 ? '' : '<br>('.scalar(@{$parts}).' parts)').'</td>';
$studentTable.='<td valign="top">';
- if ($ENV{'form.vProb'} eq 'yes') {
- $studentTable.=&show_problem($request,$symbx,$uname,$udom,1);
+ if ($ENV{'form.vProb'} eq 'yes' ) {
+ $studentTable.=&show_problem($request,$symbx,$uname,$udom,1,
+ undef,'both');
} else {
my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$ENV{'request.course.id'});
$companswer =~ s|<form(.*?)>||g;
@@ -3008,9 +3068,8 @@ sub updateGradeByPage {
$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
my $iterator = $navmap->getIterator($map->map_start(),
@@ -3132,7 +3191,7 @@ sub getSequenceDropDown {
my ($request,$symb)=@_;
my $result='<select name="selectpage">'."\n";
my ($titles,$symbx) = &getSymbMap($request);
- my ($curpage,$type,$mapId) = ($symb =~ /(.*?\.(page|sequence))___(\d+)___/);
+ my ($curpage)=&Apache::lonnet::decode_symb($symb);
my $ctr=0;
foreach (@$titles) {
my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/);
@@ -3146,8 +3205,6 @@ sub getSequenceDropDown {
}
sub scantron_uploads {
- #FIXME need to support scantron files put in another location,
- # maybe the course directory? a scantron dir in the course directory?
if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''};
my $result= '<select name="scantron_selectfile">';
opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'});
@@ -3184,8 +3241,6 @@ sub scantron_selectphase {
my $file_selector=&scantron_uploads();
my $format_selector=&scantron_scantab();
my $result;
- #FIXME allow instructor to be able to download the scantron file
- # and to upload it,
$result.= <<SCANTRONFORM;
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process">
<input type="hidden" name="command" value="scantron_validate" />
@@ -3230,7 +3285,6 @@ sub get_scantron_config {
my ($which) = @_;
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
my %config;
- #FIXME probably should move to XML it has already gotten a bit much now
foreach my $line (<$fh>) {
my ($name,$descrip)=split(/:/,$line);
if ($name ne $which ) { next; }
@@ -3247,12 +3301,6 @@ sub get_scantron_config {
$config{'Qlength'}=$config[8];
$config{'Qoff'}=$config[9];
$config{'Qon'}=$config[10];
- $config{'PaperID'}=$config[11];
- $config{'PaperIDlength'}=$config[12];
- $config{'FirstName'}=$config[13];
- $config{'FirstNamelength'}=$config[14];
- $config{'LastName'}=$config[15];
- $config{'LastNamelength'}=$config[16];
last;
}
return %config;
@@ -3268,22 +3316,6 @@ sub username_to_idmap {
return %idmap;
}
-sub scantron_fixup_scanline {
- my ($scantron_config,$line,$field,$newvalue) = @_;
- if ($field eq 'ID') {
- if ($newvalue > $$scantron_config{'IDlength'}) {
- return ($line,1,'New value to large');
- }
- if ($newvalue < $$scantron_config{'IDlength'}) {
- $newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
- $newvalue);
- }
- substr($line,$$scantron_config{'IDstart'}-1,
- $$scantron_config{'IDlength'})=$newvalue;
- }
- return $line;
-}
-
sub scantron_parse_scanline {
my ($line,$scantron_config)=@_;
my %record;
@@ -3299,15 +3331,6 @@ sub scantron_parse_scanline {
}
$record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
$$scantron_config{'IDlength'});
- $record{'scantron.paperID'}=
- substr($data,$$scantron_config{'PaperID'}-1,
- $$scantron_config{'PaperIDlength'});
- $record{'scantron.FirstName'}=
- substr($data,$$scantron_config{'FirstName'}-1,
- $$scantron_config{'FirstNamelength'});
- $record{'scantron.LastName'}=
- substr($data,$$scantron_config{'LastName'}-1,
- $$scantron_config{'LastNamelength'});
my @alphabet=('A'..'Z');
my $questnum=0;
while ($questions) {
@@ -3318,7 +3341,6 @@ sub scantron_parse_scanline {
my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest);
if (scalar(@array) gt 2) {
#FIXME do something intelligent with double bubbles
- #actually not a concern right now, should be taking care of later
Apache->request->print("<br ><b>Wha!!!</b> <pre>".scalar(@array).
'-'.$currentquest.'-'.$questnum.'</pre><br />');
}
@@ -3370,233 +3392,13 @@ sub scantron_filter {
#the corrected one, I'll still need to catch error conditions, but
#maybe most will taken care even before we start
-sub scantron_process_corrections {
- my ($r) = @_;
- if ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) {
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- my $scanlines=&scantron_getfile();
- my $classlist=&Apache::loncoursedata::get_classlist();
- my $which=$ENV{'form.scantron_line'};
- my $line=&scantron_get_line($scanlines,$which);
- my $newstudent=$ENV{'form.scantron_username'}.':'.
- $ENV{'form.scantron_domain'};
- my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
- ($line,my $err,my $errmsg)=
- &scantron_fixup_scanline(\%scantron_config,$line,'ID',$newid);
- if ($err) {
- $r->print("Unable to accept last correction, an error occurred :$errmsg:");
- } else {
- &scantron_put_line($scanlines,$which,$line);
- &scantron_putfile($scanlines);
- }
- }
-}
-
sub scantron_validate_file {
my ($r) = @_;
- my ($symb,$url)=&get_symb_and_url($r);
- if (!$symb) {return '';}
- my $default_form_data=&defaultFormData($symb,$url);
-
- if ($ENV{'form.scantron_corrections'}) {
- &scantron_process_corrections($r);
- }
- #get the student pick code ready
- $r->print(&Apache::loncommon::studentbrowser_javascript());
- my $result= <<SCANTRONFORM;
-<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
- <input type="hidden" name="command" value="scantron_validate" />
- <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" />
- <input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" />
- <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />
- $default_form_data
-SCANTRONFORM
- $r->print($result);
-
- my @validate_phases=( 'ID',
- 'CODE',
- 'doublebubble',
- 'missingbubbles');
- if (!$ENV{'form.validatepass'}) {
- $ENV{'form.valiadatepass'} = 0;
- }
- my $currentphase=$ENV{'form.valiadatepass'};
-
- if ($ENV{'form.scantron_selectfile'}=~m-^/-) {
- #first pass copy file to classdir
-
- }
- my $stop=0;
- while (!$stop && $currentphase < scalar(@validate_phases)) {
- my $which="scantron_validate_".$validate_phases[$currentphase];
- {
- no strict 'refs';
- ($stop,$currentphase)=&$which($r,$currentphase);
- }
- }
- $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
- return '';
-}
-
-sub scantron_getfile {
- #my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}");
- #FIXME really would prefer a scantron directory but tokenwrapper
- # doesn't allow access to subdirs of userfiles
- my $lines;
- $lines=&Apache::lonnet::getfile('/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
- 'scantron_orig_'.$ENV{'form.scantron_selectfile'});
- if ($lines eq '-1') {
- #FIXME need to actually replicate file to course space
- }
- my %scanlines;
- $scanlines{'orig'}=[split("\n",$lines)];
- my $temp=$scanlines{'orig'};
- $scanlines{'count'}=$#$temp;
-
- $lines=&Apache::lonnet::getfile('/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
- 'scantron_corrected_'.$ENV{'form.scantron_selectfile'});
- if ($lines eq '-1') {
- $scanlines{'corrected'}=[];
- } else {
- $scanlines{'corrected'}=[split("\n",$lines)];
- }
- $lines=&Apache::lonnet::getfile('/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
- 'scantron_skipped_'.$ENV{'form.scantron_selectfile'});
- if ($lines eq '-1') {
- $scanlines{'skipped'}=[];
- } else {
- $scanlines{'skipped'}=[split("\n",$lines)];
- }
- return \%scanlines;
-}
-
-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);
-
-}
-
-sub scantron_putfile {
- my ($scanlines) = @_;
- #FIXME really would prefer a scantron directory but tokenwrapper
- # doesn't allow access to subdirs of userfiles
- my $prefix='/uploaded/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
- 'scantron_';
- 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'});
-}
-
-sub scantron_get_line {
- my ($scanlines,$i)=@_;
- if ($scanlines->{'skipped'}[$i]) {return undef;}
- if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];}
- return $scanlines->{'orig'}[$i];
-}
-
-sub scantron_put_line {
- my ($scanlines,$i,$newline,$skip)=@_;
- if ($skip) { $scanlines->{'skipped'}[$i]=$newline;return; }
- $scanlines->{'corrected'}[$i]=$newline;
-}
-
-sub scantron_validate_ID {
- my ($r,$currentphase) = @_;
-
- #get student info
- my $classlist=&Apache::loncoursedata::get_classlist();
- my %idmap=&username_to_idmap($classlist);
-
- #get scantron line setup
- my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
- my $scanlines=&scantron_getfile();
-
- my %found=('ids'=>{},'usernames'=>{});
- for (my $i=0;$i<=$scanlines->{'count'};$i++) {
- my $line=&scantron_get_line($scanlines,$i);
- if (!$line) { next; }
- my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
- my $id=$$scan_record{'scantron.ID'};
- $r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}."</p>\n");
- my $found;
- foreach my $checkid (keys(%idmap)) {
- if (lc($checkid) eq lc($id)) {
- if ($checkid ne $id) {
- $r->print("<p>Using $checkid for bubbled $id</p>\n");
- }
- $found=$checkid;last;
- }
- }
- if ($found) {
- if ($found{'ids'}{$found}) {
- #FIXME store away line we prviously saw the ID on
- &scantron_get_ID_correction($r,$i,$scan_record,
- 'duplicateID',$found);
- return(1);
- } else {
- $found{'ids'}{$found}++;
- }
- } else {
- &scantron_get_ID_correction($r,$i,$scan_record,'incorrectID');
- return(1);
- }
- }
-
- return (0,$currentphase+1);
-}
-
-sub scantron_get_ID_correction {
- my ($r,$i,$scan_record,$error,$arg)=@_;
-#FIXME allow th poosibility of skipping a line, or in the case of a duplicated ID the previous line, probaly need to show both the current line and the previous one.
- $r->print("<p>need to correct ID</p>\n");
- $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
- $r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
- if ($error eq 'unknownID') {
- $r->print("<p> Unknown ID </p>\n");
- } elsif ($error eq 'duplicateID') {
- $r->print("<p> Duplicated ID </p>\n");
- }
- $r->print("<p>Original ID is ".$$scan_record{'scantron.ID'}."</p>\n");
- $r->print("<p>Name on paper is ".$$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."</p>");
- $r->print("Corrected User -- ");
- $r->print("\nusername:<input type='text' name='scantron_username' value='' />");
- $r->print("\ndomain:".
- &Apache::loncommon::select_dom_form(undef,'scantron_domain'));
- #FIXME it would be nice if this sent back the user ID and
- #could do partial userID matches
- $r->print(&Apache::loncommon::selectstudent_link('scantronupload',
- 'scantron_username','scantron_domain'));
- &scantron_end_validate_form($r);
-}
-
-sub scantron_end_validate_form {
- my ($r) = @_;
- $r->print('<input type="submit" name="submit" /></form></body></html>');
}
sub scantron_process_students {
my ($r) = @_;
- my (undef,undef,$sequence)=split(/___/,$ENV{'form.selectpage'});
+ my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'});
my ($symb,$url)=&get_symb_and_url($r);
if (!$symb) {return '';}
my $default_form_data=&defaultFormData($symb,$url);
@@ -3606,7 +3408,7 @@ sub scantron_process_students {
my @scanlines=<$scanlines>;
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)."<br />");
@@ -3762,7 +3564,7 @@ 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;}
@@ -3830,12 +3632,14 @@ GRADINGMENUJS
$result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
'<input type="radio" name="radioChoice" value="submission" '.
- ($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>Current Resource:</b> For one or more students'.
- '<br /> -->For students with '.
- '<input type="radio" name="submitonly" value="yes" '.
- ($saveSub eq 'yes' ? 'checked' : '').' /> submissions or '.
- '<input type="radio" name="submitonly" value="all" '.
- ($saveSub eq 'all' ? 'checked' : '').' /> for all</td></tr>'."\n";
+ ($saveCmd eq 'submission' ? 'checked' : '').'> '.'<b>Current Resource:</b> For one or more students '.
+ '<select name="submitonly">'.
+ '<option value="yes" '.
+ ($saveSub eq 'yes' ? 'selected="on"' : '').'>with submissions</option>'.
+ '<option value="graded" '.
+ ($saveSub eq 'graded' ? 'selected="on"' : '').'>with ungraded submissions</option>'.
+ '<option value="all" '.
+ ($saveSub eq 'all' ? 'selected="on"' : '').'>with any status</option></select></td></tr>'."\n";
$result.='<tr bgcolor="#ffffe6"valign="top"><td>'.
'<input type="radio" name="radioChoice" value="viewgrades" '.
@@ -3881,9 +3685,9 @@ sub handler {
undef(%perm);
if ($ENV{'browser.mathml'}) {
- $request->content_type('text/xml');
+ &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;
@@ -3893,7 +3697,7 @@ sub handler {
my $command=$ENV{'form.command'};
if (!$url) {
my ($temp1,$temp2);
- ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);
+ ($temp1,$temp2,$ENV{'form.url'})=&Apache::lonnet::decode_symb($symb);
$url = $ENV{'form.url'};
}
&send_header($request);
@@ -3906,7 +3710,7 @@ sub handler {
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,