version 1.150, 2003/11/07 19:10:51
|
version 1.158, 2003/11/12 21:20:54
|
Line 132 sub response_type {
|
Line 132 sub response_type {
|
my ($url,$symb) = shift; |
my ($url,$symb) = shift; |
$symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq ''); |
$symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq ''); |
my $allkeys = &Apache::lonnet::metadata($url,'keys'); |
my $allkeys = &Apache::lonnet::metadata($url,'keys'); |
|
my %vPart; |
|
foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { |
|
$vPart{$partid}=1; |
|
} |
my %seen = (); |
my %seen = (); |
my (@partlist,%handgrade,%responseType); |
my (@partlist,%handgrade,%responseType); |
foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { |
foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { |
Line 141 sub response_type {
|
Line 145 sub response_type {
|
if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { |
if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { |
next; |
next; |
} |
} |
|
if (%vPart && !exists($vPart{$partid})) { |
|
next; |
|
} |
$responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! |
$responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! |
my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); |
my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); |
$handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); |
$handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); |
Line 157 sub response_type {
|
Line 164 sub response_type {
|
#--- Show resource title |
#--- Show resource title |
#--- and parts and response type |
#--- and parts and response type |
sub showResourceInfo { |
sub showResourceInfo { |
my ($url,$probTitle) = @_; |
my ($url,$probTitle,$checkboxes) = @_; |
|
my $col=3; |
|
if ($checkboxes) { $col=4; } |
my $result ='<table border="0">'. |
my $result ='<table border="0">'. |
'<tr><td colspan=3><font size=+1><b>Current Resource: </b>'.$probTitle.'</font></td></tr>'."\n"; |
'<tr><td colspan="'.$col.'"><font size="+1"><b>Current Resource: </b>'. |
|
$probTitle.'</font></td></tr>'."\n"; |
my ($partlist,$handgrade,$responseType) = &response_type($url); |
my ($partlist,$handgrade,$responseType) = &response_type($url); |
my %resptype = (); |
my %resptype = (); |
my $hdgrade='no'; |
my $hdgrade='no'; |
|
my %partsseen; |
for my $part_resID (sort keys(%$handgrade)) { |
for my $part_resID (sort keys(%$handgrade)) { |
my $handgrade=$$handgrade{$part_resID}; |
my $handgrade=$$handgrade{$part_resID}; |
my ($partID,$resID) = split(/_/,$part_resID); |
my ($partID,$resID) = split(/_/,$part_resID); |
my $responsetype = $responseType->{$partID}->{$resID}; |
my $responsetype = $responseType->{$partID}->{$resID}; |
$hdgrade = $handgrade if ($handgrade eq 'yes'); |
$hdgrade = $handgrade if ($handgrade eq 'yes'); |
$result.='<tr><td><b>Part </b>'.$partID.' <font color="#999999">'. |
$result.='<tr>'; |
|
if ($checkboxes) { |
|
if (exists($partsseen{$partID})) { |
|
$result.="<td> </td>"; |
|
} else { |
|
$result.="<td><input type='checkbox' name='vPart' value='$partID' checked='on' /></td>"; |
|
} |
|
$partsseen{$partID}=1; |
|
} |
|
$result.='<td><b>Part </b>'.$partID.' <font color="#999999">'. |
$resID.'</font></td>'. |
$resID.'</font></td>'. |
'<td><b>Type: </b>'.$responsetype.'</td></tr>'; |
'<td><b>Type: </b>'.$responsetype.'</td></tr>'; |
# '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>'; |
# '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>'; |
Line 550 sub listStudents {
|
Line 570 sub listStudents {
|
my $result='<h3><font color="#339933"> '.$viewgrade. |
my $result='<h3><font color="#339933"> '.$viewgrade. |
' Submissions for a Student or a Group of Students</font></h3>'; |
' Submissions for a Student or a Group of Students</font></h3>'; |
|
|
my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'}); |
my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$ENV{'form.probTitle'},($ENV{'form.showgrading'} eq 'yes')); |
$result.=$table; |
|
|
|
$request->print(<<LISTJAVASCRIPT); |
$request->print(<<LISTJAVASCRIPT); |
<script type="text/javascript" language="javascript"> |
<script type="text/javascript" language="javascript"> |
Line 591 LISTJAVASCRIPT
|
Line 610 LISTJAVASCRIPT
|
|
|
my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; |
my $checkhdgrade = ($ENV{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; |
my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; |
my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; |
my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n". |
my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'. |
|
"\n".$table. |
' <b>View Problem Text: </b><input type="radio" name="vProb" value="no" checked="on" /> 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="yes" /> one student '."\n". |
'<input type="radio" name="vProb" value="all" /> all students <br />'."\n". |
'<input type="radio" name="vProb" value="all" /> all students <br />'."\n". |
Line 671 LISTJAVASCRIPT
|
Line 691 LISTJAVASCRIPT
|
$status{'resource.'.$partid.'.submitted_by'}.'" />'; |
$status{'resource.'.$partid.'.submitted_by'}.'" />'; |
} |
} |
} |
} |
next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); |
next if (!$submitted && ($submitonly eq 'yes' || |
next if (!$graded && $submitonly eq 'graded'); |
$submitonly eq 'incorrect' || |
|
$submitonly eq 'graded')); |
|
next if (!$graded && ($submitonly eq 'graded' || |
|
$submitonly eq 'incorrect')); |
} |
} |
|
|
$ctr++; |
$ctr++; |
Line 729 LISTJAVASCRIPT
|
Line 752 LISTJAVASCRIPT
|
sub processGroup { |
sub processGroup { |
my ($request) = shift; |
my ($request) = shift; |
my $ctr = 0; |
my $ctr = 0; |
my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} |
my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); |
: ($ENV{'form.stuinfo'})); |
|
my $total = scalar(@stuchecked)-1; |
my $total = scalar(@stuchecked)-1; |
|
|
foreach (@stuchecked) { |
foreach (@stuchecked) { |
Line 1435 sub submission {
|
Line 1457 sub submission {
|
'<input type="hidden" name="msgsub" value="'.$ENV{'form.msgsub'}.'" />'."\n". |
'<input type="hidden" name="msgsub" value="'.$ENV{'form.msgsub'}.'" />'."\n". |
'<input type="hidden" name="shownSub" value="0" />'."\n". |
'<input type="hidden" name="shownSub" value="0" />'."\n". |
'<input type="hidden" name="savemsgN" value="'.$ENV{'form.savemsgN'}.'" />'."\n"); |
'<input type="hidden" name="savemsgN" value="'.$ENV{'form.savemsgN'}.'" />'."\n"); |
|
foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { |
|
$request->print('<input type="hidden" name="vPart" value="'.$partid.'" />'."\n"); |
|
} |
} |
} |
|
|
my ($cts,$prnmsg) = (1,''); |
my ($cts,$prnmsg) = (1,''); |
Line 1562 KEYWORDS
|
Line 1587 KEYWORDS
|
# (3) Last submission plus the parts info |
# (3) Last submission plus the parts info |
# (4) The whole record for this student |
# (4) The whole record for this student |
if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { |
if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { |
my ($string,$timestamp)= &get_last_submission(\%record); |
my ($string,$timestamp)= &get_last_submission(\%record); |
my $lastsubonly=''. |
my $lastsubonly=''. |
($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '. |
($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '. |
$$timestamp)."</td></tr>\n"; |
$$timestamp)."</td></tr>\n"; |
if ($$timestamp eq '') { |
if ($$timestamp eq '') { |
$lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; |
$lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; |
} else { |
} else { |
my %seenparts; |
my %seenparts; |
for my $part (sort keys(%$handgrade)) { |
for my $part (sort keys(%$handgrade)) { |
my ($partid,$respid) = split(/_/,$part); |
my ($partid,$respid) = split(/_/,$part); |
if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { |
if ($ENV{"form.$uname:$udom:$partid:submitted_by"}) { |
if (exists($seenparts{$partid})) { next; } |
if (exists($seenparts{$partid})) { next; } |
$seenparts{$partid}=1; |
$seenparts{$partid}=1; |
my $submitby='<b>Part '.$partid. |
my $submitby='<b>Part '.$partid. |
' Collaborative submission by: </b>'. |
' Collaborative submission by: </b>'. |
'<a href="javascript:viewSubmitter(\''. |
'<a href="javascript:viewSubmitter(\''. |
$ENV{"form.$uname:$udom:$partid:submitted_by"}. |
$ENV{"form.$uname:$udom:$partid:submitted_by"}. |
'\')"; TARGET=_self>'. |
'\')"; TARGET=_self>'. |
$$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />'; |
$$fullname{$ENV{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />'; |
$request->print($submitby); |
$request->print($submitby); |
next; |
next; |
|
} |
|
my $responsetype = $responseType->{$partid}->{$respid}; |
|
if (!exists($record{"resource.$partid.$respid.submission"})) { |
|
$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. |
|
$partid.'</b> <font color="#999999">( ID '.$respid. |
|
' )</font> '. |
|
'<font color="red">Nothing submitted - no attempts</font><br /><br />'; |
|
next; |
|
} |
|
foreach (@$string) { |
|
my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; |
|
if ($part ne ($partid.'_'.$respid)) { next; } |
|
my ($ressub,$subval) = split(/:/,$_,2); |
|
# Similarity check |
|
my $similar=''; |
|
if($ENV{'form.checkPlag'}){ |
|
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 $responsetype = $responseType->{$partid}->{$respid}; |
my $order=&get_order($partid,$respid,$symb,$uname,$udom); |
if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) { |
if ($ENV{'form.lastSub'} eq 'lastonly' || |
|
($ENV{'form.lastSub'} eq 'hdgrade' && |
|
$$handgrade{$part} eq 'yes')) { |
$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. |
$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. |
$partid.'</b> <font color="#999999">( ID '.$respid. |
$partid.'</b> <font color="#999999">( ID '.$respid. |
' )</font> '. |
' )</font> '; |
'<font color="red">Nothing submitted - no attempts</font><br /><br />'; |
if ($record{"resource.$partid.$respid.uploadedurl"}) { |
} else { |
$lastsubonly.='<a href="'.&Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}).'"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> <font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />'; |
foreach (@$string) { |
|
my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; |
|
if ($part eq ($partid.'_'.$respid)) { |
|
my ($ressub,$subval) = split(/:/,$_,2); |
|
# Similarity check |
|
my $similar=''; |
|
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 />'; |
|
} |
|
} |
|
my $order=&get_order($partid,$respid,$symb,$uname,$udom); |
|
$lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '. |
|
$partid.'</b> <font color="#999999">( ID '.$respid. |
|
' )</font> '. |
|
($record{"resource.$partid.$respid.uploadedurl"}? |
|
'<a href="'. |
|
&Apache::lonnet::tokenwrapper($record{"resource.$partid.$respid.uploadedurl"}). |
|
'"><img src="/adm/lonIcons/unknown.gif" border=0"> File uploaded by student</a> '. |
|
'<font color="red" size="1">Like all files provided by users, '. |
|
'this file may contain virusses</font><br />':''). |
|
'<b>Submitted Answer: </b>'. |
|
&cleanRecord($subval,$responsetype,$symb,$partid,$respid,\%record,$order). |
|
'<br /><br />'.$similar."\n" |
|
if ($ENV{'form.lastSub'} eq 'lastonly' || |
|
($ENV{'form.lastSub'} eq 'hdgrade' && |
|
$$handgrade{$part} eq 'yes')); |
|
} |
|
} |
} |
|
$lastsubonly.='<b>Submitted Answer: </b>'. |
|
&cleanRecord($subval,$responsetype,$symb,$partid, |
|
$respid,\%record,$order); |
|
if ($similar) {$lastsubonly.="<br /><br />$similar\n";} |
} |
} |
} |
} |
} |
} |
$lastsubonly.='</td></tr><tr bgcolor="#ffffff"><td>'."\n"; |
} |
$request->print($lastsubonly); |
$lastsubonly.='</td></tr><tr bgcolor="#ffffff"><td>'."\n"; |
|
$request->print($lastsubonly); |
} elsif ($ENV{'form.lastSub'} eq 'datesub') { |
} elsif ($ENV{'form.lastSub'} eq 'datesub') { |
my (undef,$responseType,undef,$parts) = &showResourceInfo($url); |
my (undef,$responseType,undef,$parts) = &showResourceInfo($url); |
$request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); |
$request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); |
Line 1810 sub processHandGrade {
|
Line 1831 sub processHandGrade {
|
$ENV{'form.msgsub'},$message); |
$ENV{'form.msgsub'},$message); |
} |
} |
if ($ENV{'form.collaborator'.$ctr}) { |
if ($ENV{'form.collaborator'.$ctr}) { |
&Apache::lonnet::logthis('collab '.(join(':',@{ $ENV{'form.collaborator'.$ctr} }))); |
my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); |
my @collabstrs; |
|
if (ref($ENV{'form.collaborator'.$ctr}) eq 'ARRAY') { |
|
@collabstrs=@{$ENV{'form.collaborator'.$ctr}}; |
|
} else { |
|
@collabstrs=$ENV{'form.collaborator'.$ctr}; |
|
} |
|
foreach my $collabstr (@collabstrs) { |
foreach my $collabstr (@collabstrs) { |
my ($part,@collaborators) = split(/:/,$collabstr); |
my ($part,@collaborators) = split(/:/,$collabstr); |
foreach (@collaborators) { |
foreach (@collaborators) { |
Line 1938 sub processHandGrade {
|
Line 1953 sub processHandGrade {
|
foreach my $student (@parsedlist) { |
foreach my $student (@parsedlist) { |
my $submitonly=$ENV{'form.submitonly'}; |
my $submitonly=$ENV{'form.submitonly'}; |
my ($uname,$udom) = split(/:/,$student); |
my ($uname,$udom) = split(/:/,$student); |
if ($submitonly =~ /^(yes|graded)$/) { |
if ($submitonly =~ /^(yes|graded|incorrect)$/) { |
# my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); |
# my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); |
my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist); |
my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist); |
my $submitted = 0; |
my $submitted = 0; |
Line 1951 sub processHandGrade {
|
Line 1966 sub processHandGrade {
|
$submitted = 0; |
$submitted = 0; |
} |
} |
} |
} |
next if (!$submitted && ($submitonly eq 'yes' || $submitonly eq 'graded')); |
next if (!$submitted && ($submitonly eq 'yes' || |
next if (!$graded && $submitonly eq 'graded'); |
$submitonly eq 'incorrect' || |
|
$submitonly eq 'graded')); |
|
next if (!$graded && ($submitonly eq 'graded' || |
|
$submitonly eq 'incorrect')); |
} |
} |
push @nextlist,$student if ($ctr < $ntstu); |
push @nextlist,$student if ($ctr < $ntstu); |
last if ($ctr == $ntstu); |
last if ($ctr == $ntstu); |
Line 1990 sub saveHandGrade {
|
Line 2008 sub saveHandGrade {
|
my %newrecord = (); |
my %newrecord = (); |
my ($pts,$wgt) = ('',''); |
my ($pts,$wgt) = ('',''); |
foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { |
foreach (split(/:/,$ENV{'form.partlist'.$newflg})) { |
&Apache::lonnet::logthis("-$submitter-$stuname-$part-$_"); |
|
#collaborator may vary for different parts |
#collaborator may vary for different parts |
if ($submitter && $_ ne $part) { next; } |
if ($submitter && $_ ne $part) { next; } |
my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_}; |
my $dropMenu = $ENV{'form.GD_SEL'.$newflg.'_'.$_}; |
Line 2013 sub saveHandGrade {
|
Line 2030 sub saveHandGrade {
|
$pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? |
$pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? |
$ENV{'form.GD_BOX'.$newflg.'_'.$_} : |
$ENV{'form.GD_BOX'.$newflg.'_'.$_} : |
$ENV{'form.RADVAL'.$newflg.'_'.$_}); |
$ENV{'form.RADVAL'.$newflg.'_'.$_}); |
return 'no_score' if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq ''); |
if ($pts eq '' && $ENV{'form.GD_SEL'.$newflg.'_'.$_} eq '') { |
|
next; |
|
} |
$wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : |
$wgt = $ENV{'form.WGT'.$newflg.'_'.$_} eq '' ? 1 : |
$ENV{'form.WGT'.$newflg.'_'.$_}; |
$ENV{'form.WGT'.$newflg.'_'.$_}; |
my $partial= $pts/$wgt; |
my $partial= $pts/$wgt; |
next if ($partial eq $record{'resource.'.$_.'.awarded'}); #do not update score for part if not changed. |
if ($partial eq $record{'resource.'.$_.'.awarded'}) { |
$newrecord{'resource.'.$_.'.awarded'} = $partial |
#do not update score for part if not changed. |
if ($record{'resource.'.$_.'.awarded'} ne $partial); |
next; |
|
} |
|
if ($record{'resource.'.$_.'.awarded'} ne $partial) { |
|
$newrecord{'resource.'.$_.'.awarded'} = $partial; |
|
} |
my $reckey = 'resource.'.$_.'.solved'; |
my $reckey = 'resource.'.$_.'.solved'; |
if ($partial == 0) { |
if ($partial == 0) { |
$newrecord{$reckey} = 'incorrect_by_override' |
if ($record{$reckey} ne 'incorrect_by_override') { |
if ($record{$reckey} ne 'incorrect_by_override'); |
$newrecord{$reckey} = 'incorrect_by_override'; |
|
} |
} else { |
} else { |
$newrecord{$reckey} = 'correct_by_override' |
if ($record{$reckey} ne 'correct_by_override') { |
if ($record{$reckey} ne 'correct_by_override'); |
$newrecord{$reckey} = 'correct_by_override'; |
|
} |
|
} |
|
if ($submitter && |
|
($record{'resource.'.$_.'.submitted_by'} ne $submitter)) { |
|
$newrecord{'resource.'.$_.'.submitted_by'} = $submitter; |
} |
} |
|
$newrecord{'resource.'.$_.'.regrader'}= |
$newrecord{'resource.'.$_.'.submitted_by'} = $submitter |
"$ENV{'user.name'}:$ENV{'user.domain'}"; |
if ($submitter && ($record{'resource.'.$_.'.submitted_by'} ne $submitter)); |
|
$newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; |
|
} |
} |
} |
} |
|
|
if (scalar(keys(%newrecord)) > 0) { |
if (scalar(keys(%newrecord)) > 0) { |
&Apache::lonnet::cstore(\%newrecord,$symb, |
&Apache::lonnet::cstore(\%newrecord,$symb, |
$ENV{'request.course.id'},$domain,$stuname); |
$ENV{'request.course.id'},$domain,$stuname); |
Line 3345 sub getSequenceDropDown {
|
Line 3371 sub getSequenceDropDown {
|
return $result; |
return $result; |
} |
} |
|
|
|
#FIXME, I am in loncreatecourse, use that one instead |
|
sub propath { |
|
my ($udom,$uname)=@_; |
|
$udom=~s/\W//g; |
|
$uname=~s/\W//g; |
|
my $subdir=$uname.'__'; |
|
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
|
my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
|
return $proname; |
|
} |
|
|
sub scantron_uploads { |
sub scantron_uploads { |
if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; |
if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''}; |
my $result= '<select name="scantron_selectfile">'; |
my $result= '<select name="scantron_selectfile">'; |
opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'}); |
my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; |
my @files=sort(readdir(DIR)); |
my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; |
|
my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, |
|
&propath($cdom,$cname)); |
foreach my $filename (@files) { |
foreach my $filename (@files) { |
if ($filename eq '.' or $filename eq '..') { next; } |
($filename)=split(/&/,$filename); |
|
if ($filename!~/^scantron_orig_/) { next ; } |
|
$filename=~s/^scantron_orig_//; |
$result.="<option>$filename</option>\n"; |
$result.="<option>$filename</option>\n"; |
} |
} |
closedir(DIR); |
|
$result.="</select>"; |
$result.="</select>"; |
return $result; |
return $result; |
} |
} |
Line 3382 sub scantron_selectphase {
|
Line 3422 sub scantron_selectphase {
|
my $file_selector=&scantron_uploads(); |
my $file_selector=&scantron_uploads(); |
my $format_selector=&scantron_scantab(); |
my $format_selector=&scantron_scantab(); |
my $result; |
my $result; |
|
#FIXME allow instructor to be able to download the scantron file |
|
# and to upload it, |
$result.= <<SCANTRONFORM; |
$result.= <<SCANTRONFORM; |
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process"> |
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process"> |
<input type="hidden" name="command" value="scantron_validate" /> |
<input type="hidden" name="command" value="scantron_validate" /> |
Line 3410 sub scantron_selectphase {
|
Line 3452 sub scantron_selectphase {
|
Format of data file: $format_selector |
Format of data file: $format_selector |
</td> |
</td> |
</tr> |
</tr> |
|
<tr bgcolor="#ffffe6"> |
|
<td> |
|
<!-- FIXME this is lazy, a single parse of the set should let me know what this is --> |
|
Last line to expect an answer on: |
|
<input type="text" name="scantron_maxbubble" /> |
|
</td> |
|
</tr> |
</table> |
</table> |
</td> |
</td> |
</tr> |
</tr> |
Line 3426 sub get_scantron_config {
|
Line 3475 sub get_scantron_config {
|
my ($which) = @_; |
my ($which) = @_; |
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); |
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); |
my %config; |
my %config; |
|
#FIXME probably should move to XML it has already gotten a bit much now |
foreach my $line (<$fh>) { |
foreach my $line (<$fh>) { |
my ($name,$descrip)=split(/:/,$line); |
my ($name,$descrip)=split(/:/,$line); |
if ($name ne $which ) { next; } |
if ($name ne $which ) { next; } |
Line 3442 sub get_scantron_config {
|
Line 3492 sub get_scantron_config {
|
$config{'Qlength'}=$config[8]; |
$config{'Qlength'}=$config[8]; |
$config{'Qoff'}=$config[9]; |
$config{'Qoff'}=$config[9]; |
$config{'Qon'}=$config[10]; |
$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; |
last; |
} |
} |
return %config; |
return %config; |
Line 3457 sub username_to_idmap {
|
Line 3513 sub username_to_idmap {
|
return %idmap; |
return %idmap; |
} |
} |
|
|
|
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'); |
|
} |
|
if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { |
|
$args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', |
|
$args->{'newid'}); |
|
} |
|
substr($line,$$scantron_config{'IDstart'}-1, |
|
$$scantron_config{'IDlength'})=$args->{'newid'}; |
|
if ($args->{'newid'}=~/^\s*$/) { |
|
&scan_data($scan_data,"$whichline.user", |
|
$args->{'username'}.':'.$args->{'domain'}); |
|
} |
|
} elsif ($field eq 'answer') { |
|
my $length=$scantron_config->{'Qlength'}; |
|
my $off=$scantron_config->{'Qoff'}; |
|
my $on=$scantron_config->{'Qon'}; |
|
my $answer=${off}x$length; |
|
if ($args->{'response'} eq 'none') { |
|
&scan_data($scan_data, |
|
"$whichline.no_bubble.".$args->{'question'},'1'); |
|
} else { |
|
substr($answer,$args->{'response'},1)=$on; |
|
&scan_data($scan_data, |
|
"$whichline.no_bubble.".$args->{'question'},undef,'1'); |
|
} |
|
my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; |
|
substr($line,$where-1,$length)=$answer; |
|
} |
|
return $line; |
|
} |
|
|
|
sub scan_data { |
|
my ($scan_data,$key,$value,$delete)=@_; |
|
my $filename=$ENV{'form.scantron_selectfile'}; |
|
if (defined($value)) { |
|
$scan_data->{$filename.'_'.$key} = $value; |
|
} |
|
if ($delete) { delete($scan_data->{$filename.'_'.$key}); } |
|
return $scan_data->{$filename.'_'.$key}; |
|
} |
|
|
sub scantron_parse_scanline { |
sub scantron_parse_scanline { |
my ($line,$scantron_config)=@_; |
my ($line,$whichline,$scantron_config,$scan_data)=@_; |
my %record; |
my %record; |
my $questions=substr($line,$$scantron_config{'Qstart'}-1); |
my $questions=substr($line,$$scantron_config{'Qstart'}-1); |
my $data=substr($line,0,$$scantron_config{'Qstart'}-1); |
my $data=substr($line,0,$$scantron_config{'Qstart'}-1); |
Line 3472 sub scantron_parse_scanline {
|
Line 3573 sub scantron_parse_scanline {
|
} |
} |
$record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, |
$record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, |
$$scantron_config{'IDlength'}); |
$$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 @alphabet=('A'..'Z'); |
my $questnum=0; |
my $questnum=0; |
while ($questions) { |
while ($questions) { |
Line 3479 sub scantron_parse_scanline {
|
Line 3589 sub scantron_parse_scanline {
|
my $currentquest=substr($questions,0,$$scantron_config{'Qlength'}); |
my $currentquest=substr($questions,0,$$scantron_config{'Qlength'}); |
substr($questions,0,$$scantron_config{'Qlength'})=''; |
substr($questions,0,$$scantron_config{'Qlength'})=''; |
if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } |
if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } |
my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest); |
my @array=split($$scantron_config{'Qon'},$currentquest,-1); |
if (scalar(@array) gt 2) { |
|
#FIXME do something intelligent with double bubbles |
|
Apache->request->print("<br ><b>Wha!!!</b> <pre>".scalar(@array). |
|
'-'.$currentquest.'-'.$questnum.'</pre><br />'); |
|
} |
|
if (length($array[0]) eq $$scantron_config{'Qlength'}) { |
if (length($array[0]) eq $$scantron_config{'Qlength'}) { |
$record{"scantron.$questnum.answer"}=''; |
$record{"scantron.$questnum.answer"}=''; |
|
if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { |
|
push(@{$record{"scantron.missingerror"}},$questnum); |
|
} |
} else { |
} else { |
$record{"scantron.$questnum.answer"}=$alphabet[length($array[0])]; |
$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); |
|
} |
|
} |
} |
} |
$record{'scantron.maxquest'}=$questnum; |
$record{'scantron.maxquest'}=$questnum; |
return \%record; |
return \%record; |
Line 3497 sub scantron_parse_scanline {
|
Line 3615 sub scantron_parse_scanline {
|
|
|
sub scantron_add_delay { |
sub scantron_add_delay { |
my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; |
my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; |
Apache->request->print('add_delay_error '.$_[2] ); |
|
push(@$delayqueue, |
push(@$delayqueue, |
{'line' => $scanline, 'emsg' => $errormessage, |
{'line' => $scanline, 'emsg' => $errormessage, |
'ecode' => $errorcode } |
'ecode' => $errorcode } |
Line 3505 sub scantron_add_delay {
|
Line 3622 sub scantron_add_delay {
|
} |
} |
|
|
sub scantron_find_student { |
sub scantron_find_student { |
my ($scantron_record,$idmap)=@_; |
my ($scantron_record,$scan_data,$idmap,$line)=@_; |
my $scanID=$$scantron_record{'scantron.ID'}; |
my $scanID=$$scantron_record{'scantron.ID'}; |
|
if ($scanID =~ /^\s*$/) { |
|
return &scan_data($scan_data,"$line.user"); |
|
} |
foreach my $id (keys(%$idmap)) { |
foreach my $id (keys(%$idmap)) { |
#Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>'); |
if (lc($id) eq lc($scanID)) { |
if (lc($id) eq lc($scanID)) { |
return $$idmap{$id}; |
#Apache->request->print('success'); |
} |
return $$idmap{$id}; |
|
} |
|
} |
} |
return undef; |
return undef; |
} |
} |
Line 3537 sub scantron_validate_file {
|
Line 3655 sub scantron_validate_file {
|
my ($r) = @_; |
my ($r) = @_; |
} |
} |
|
|
|
sub scantron_process_corrections { |
|
my ($r) = @_; |
|
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 ($skip,$err,$errmsg); |
|
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'}; |
|
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'})) { |
|
($line,$err,$errmsg)= |
|
&scantron_fixup_scanline(\%scantron_config,$scan_data,$line, |
|
$which,'answer', |
|
{ 'question'=>$question, |
|
'response'=>$ENV{"form.scantron_correct_Q_$question"}}); |
|
if ($err) { last; } |
|
} |
|
} |
|
if ($err) { |
|
$r->print("Unable to accept last correction, an error occurred :$errmsg:"); |
|
} else { |
|
&scantron_put_line($scanlines,$which,$line,$skip); |
|
&scantron_putfile($scanlines,$scan_data); |
|
} |
|
} |
|
|
|
|
|
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="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'}" /> |
|
<input type="hidden" name="scantron_maxbubble" value="$ENV{'form.scantron_maxbubble'}" /> |
|
$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)) { |
|
$r->print("<p> Validating ".$validate_phases[$currentphase]."</p>"); |
|
$r->rflush(); |
|
my $which="scantron_validate_".$validate_phases[$currentphase]; |
|
{ |
|
no strict 'refs'; |
|
($stop,$currentphase)=&$which($r,$currentphase); |
|
} |
|
} |
|
if (!$stop) { |
|
$r->print("Validation process complete.<br />"); |
|
$r->print('<input type="submit" name="submit" value="Start Grading" />'); |
|
$r->print('<input type="hidden" name="command" value="scantron_process" />'); |
|
} else { |
|
$r->print('<input type="hidden" name="command" value="scantron_validate" />'); |
|
$r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />"); |
|
} |
|
if ($stop) { |
|
$r->print('<input type="submit" name="submit" value="Continue ->" />'); |
|
$r->print(' using corrected info <br />'); |
|
$r->print("<input type='submit' value='Skip' name='scantron_skip_record' />"); |
|
$r->print(" this scanline saving it for later."); |
|
} |
|
$r->print(" </form><br />".&show_grading_menu_form($symb,$url). |
|
"</body></html>"); |
|
return ''; |
|
} |
|
|
|
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'}; |
|
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 |
|
} |
|
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'}); |
|
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'}); |
|
if ($lines eq '-1') { |
|
$scanlines{'skipped'}=[]; |
|
} else { |
|
$scanlines{'skipped'}=[(split("\n",$lines,-1))]; |
|
} |
|
my @tmp=&Apache::lonnet::dump('scantrondata',$cdom,$cname); |
|
if ($tmp[0] =~ /^(error:|no_such_host)/) { @tmp=(); } |
|
my %scan_data = @tmp; |
|
return (\%scanlines,\%scan_data); |
|
} |
|
|
|
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,$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_'; |
|
# 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); |
|
} |
|
|
|
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,$scan_data)=&scantron_getfile(); |
|
|
|
my %found=('ids'=>{},'usernames'=>{}); |
|
for (my $i=0;$i<=$scanlines->{'count'};$i++) { |
|
my $line=&scantron_get_line($scanlines,$i); |
|
if ($line=~/^[\s\cz]*$/) { next; } |
|
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, |
|
$scan_data); |
|
my $id=$$scan_record{'scantron.ID'}; |
|
my $found; |
|
foreach my $checkid (keys(%idmap)) { |
|
if (lc($checkid) eq lc($id)) { $found=$checkid;last; } |
|
} |
|
if ($found) { |
|
my $username=$idmap{$found}; |
|
if ($found{'ids'}{$found}) { |
|
&scantron_get_correction($r,$i,$scan_record,\%scantron_config, |
|
$line,'duplicateID',$found); |
|
return(1); |
|
} elsif ($found{'usernames'}{$username}) { |
|
&scantron_get_correction($r,$i,$scan_record,\%scantron_config, |
|
$line,'duplicateID',$username); |
|
return(1); |
|
} |
|
#FIXME store away line we prviously saw the ID on to use above |
|
$found{'ids'}{$found}++; |
|
$found{'usernames'}{$username}++; |
|
} else { |
|
if ($id =~ /^\s*$/) { |
|
my $username=&scan_data($scan_data,"$i.user"); |
|
if (defined($username) && $found{'usernames'}{$username}) { |
|
&scantron_get_correction($r,$i,$scan_record, |
|
\%scantron_config, |
|
$line,'duplicateID',$username); |
|
return(1); |
|
} elsif (!defined($username)) { |
|
&scantron_get_correction($r,$i,$scan_record, |
|
\%scantron_config, |
|
$line,'incorrectID'); |
|
return(1); |
|
} |
|
$found{'usernames'}{$username}++; |
|
} else { |
|
&scantron_get_correction($r,$i,$scan_record,\%scantron_config, |
|
$line,'incorrectID'); |
|
return(1); |
|
} |
|
} |
|
} |
|
|
|
return (0,$currentphase+1); |
|
} |
|
|
|
sub scantron_get_correction { |
|
my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; |
|
|
|
#FIXME in the case of a duplicated ID the previous line, probaly need |
|
#to show both the current line and the previous one and allow skipping |
|
#the previous one or the current one |
|
|
|
$r->print("<p>An error was detected ($error) "); |
|
if ( defined($$scan_record{'scantron.PaperID'}) ) { |
|
$r->print(" for PaperID <tt>". |
|
$$scan_record{'scantron.PaperID'}."</tt> \n"); |
|
} else { |
|
$r->print(" in scanline $i <pre>". |
|
$line."</pre> \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 =~ /ID$/) { |
|
if ($error eq 'unknownID') { |
|
$r->print("The encoded ID is not in the classlist</p>\n"); |
|
} elsif ($error eq 'duplicateID') { |
|
$r->print("The encoded ID has also been used by a previous paper $arg</p>\n"); |
|
} |
|
$r->print("<p>The ID on the form is <tt>". |
|
$$scan_record{'scantron.ID'}."</tt><br />\n"); |
|
$r->print("The name on the paper is ". |
|
$$scan_record{'scantron.LastName'}.",". |
|
$$scan_record{'scantron.FirstName'}."</p>"); |
|
$r->print("<p>How should I handle this? <br /> \n"); |
|
$r->print("\n<ul><li> "); |
|
#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')); |
|
$r->print(": <input type='text' name='scantron_username' value='' />"); |
|
$r->print("\n@". |
|
&Apache::loncommon::select_dom_form(undef,'scantron_domain')); |
|
|
|
$r->print('</li>'); |
|
} elsif ($error eq 'doublebubble') { |
|
#FIXME Need to print out who this is along with the paper info |
|
$r->print("<p>There have been multiple bubbles scanned for a some question(s)</p>\n"); |
|
$r->print('<input type="hidden" name="scantron_questions" value="'. |
|
join(',',@{$arg}).'" />'); |
|
$r->print("<p>Please indicate which bubble should be used for grading</p>"); |
|
foreach my $question (@{$arg}) { |
|
my $selected=$$scan_record{"scantron.$question.answer"}; |
|
&scantron_bubble_selector($r,$scan_config,$question,split('',$selected)); |
|
} |
|
} elsif ($error eq 'missingbubble') { |
|
$r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n"); |
|
$r->print("<p>Please indicate which bubble should be used for grading</p>"); |
|
$r->print("Some questions have no scanned bubbles\n"); |
|
$r->print('<input type="hidden" name="scantron_questions" value="'. |
|
join(',',@{$arg}).'" />'); |
|
foreach my $question (@{$arg}) { |
|
my $selected=$$scan_record{"scantron.$question.answer"}; |
|
&scantron_bubble_selector($r,$scan_config,$question); |
|
} |
|
} else { |
|
$r->print("\n<ul>"); |
|
} |
|
$r->print("\n</li></ul>"); |
|
|
|
} |
|
|
|
sub scantron_bubble_selector { |
|
my ($r,$scan_config,$quest,@selected)=@_; |
|
my $max=$$scan_config{'Qlength'}; |
|
my @alphabet=('A'..'Z'); |
|
$r->print("<table border='1'><tr><td rowspan='2'>$quest</td>"); |
|
for (my $i=0;$i<$max+1;$i++) { |
|
$r->print('<td align="center">'); |
|
if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } |
|
else { $r->print(' '); } |
|
$r->print('</td>'); |
|
} |
|
$r->print('<td></td></tr><tr>'); |
|
for (my $i=0;$i<$max;$i++) { |
|
$r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest. |
|
'" value="'.$i.'" />'.$alphabet[$i]."</td>"); |
|
} |
|
$r->print('<td><input type="radio" name="scantron_correct_Q_'.$quest. |
|
'" value="none" /> No bubble </td>'); |
|
$r->print('</tr></table>'); |
|
} |
|
|
|
sub scantron_validate_CODE { |
|
my ($r,$currentphase) = @_; |
|
#FIXME doesn't do anything yet |
|
return (0,$currentphase+1); |
|
} |
|
|
|
sub scantron_validate_doublebubble { |
|
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,$scan_data)=&scantron_getfile(); |
|
for (my $i=0;$i<=$scanlines->{'count'};$i++) { |
|
my $line=&scantron_get_line($scanlines,$i); |
|
if ($line=~/^[\s\cz]*$/) { next; } |
|
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, |
|
$scan_data); |
|
if (!defined($$scan_record{'scantron.doubleerror'})) { next; } |
|
&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, |
|
'doublebubble', |
|
$$scan_record{'scantron.doubleerror'}); |
|
return (1,$currentphase); |
|
} |
|
return (0,$currentphase+1); |
|
} |
|
|
|
sub scantron_validate_missingbubbles { |
|
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,$scan_data)=&scantron_getfile(); |
|
my $max_bubble=$ENV{'form.scantron_maxbubble'}; |
|
if (!$max_bubble) { $max_bubble=2**31; } |
|
for (my $i=0;$i<=$scanlines->{'count'};$i++) { |
|
my $line=&scantron_get_line($scanlines,$i); |
|
if ($line=~/^[\s\cz]*$/) { next; } |
|
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, |
|
$scan_data); |
|
if (!defined($$scan_record{'scantron.missingerror'})) { next; } |
|
my @to_correct; |
|
foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { |
|
if ($missing > $max_bubble) { next; } |
|
push(@to_correct,$missing); |
|
} |
|
if (@to_correct) { |
|
&scantron_get_correction($r,$i,$scan_record,\%scantron_config, |
|
$line,'missingbubble',\@to_correct); |
|
return (1,$currentphase); |
|
} |
|
|
|
} |
|
return (0,$currentphase+1); |
|
} |
|
|
sub scantron_process_students { |
sub scantron_process_students { |
my ($r) = @_; |
my ($r) = @_; |
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'}); |
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($ENV{'form.selectpage'}); |
Line 3545 sub scantron_process_students {
|
Line 4056 sub scantron_process_students {
|
my $default_form_data=&defaultFormData($symb,$url); |
my $default_form_data=&defaultFormData($symb,$url); |
|
|
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); |
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); |
my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}"); |
my ($scanlines,$scan_data)=&scantron_getfile(); |
my @scanlines=<$scanlines>; |
|
my $classlist=&Apache::loncoursedata::get_classlist(); |
my $classlist=&Apache::loncoursedata::get_classlist(); |
my %idmap=&username_to_idmap($classlist); |
my %idmap=&username_to_idmap($classlist); |
my $navmap=Apache::lonnavmaps::navmap->new(); |
my $navmap=Apache::lonnavmaps::navmap->new(); |
Line 3563 SCANTRONFORM
|
Line 4073 SCANTRONFORM
|
my @delayqueue; |
my @delayqueue; |
my %completedstudents; |
my %completedstudents; |
|
|
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r, |
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', |
'Scantron Status','Scantron Progress',scalar(@scanlines)); |
'Scantron Progress',$scanlines->{'count'}); |
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, |
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, |
'Processing first student'); |
'Processing first student'); |
my $start=&Time::HiRes::time(); |
my $start=&Time::HiRes::time(); |
foreach my $line (@scanlines) { |
my $i=-1; |
$r->print('<pre>line is'.$line.'</pre>'); |
my ($uname,$udom); |
|
while ($i<$scanlines->{'count'}) { |
chomp($line); |
($uname,$udom)=('',''); |
my $scan_record=&scantron_parse_scanline($line,\%scantron_config); |
$i++; |
my ($uname,$udom); |
my $line=&scantron_get_line($scanlines,$i); |
unless ($uname=&scantron_find_student($scan_record,\%idmap)) { |
# $r->print('<pre>line is'.$line.'</pre>'); |
&scantron_add_delay(\@delayqueue,$line, |
if ($line=~/^[\s\cz]*$/) { next; } |
'Unable to find a student that matches',1); |
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, |
next; |
$scan_data); |
} |
unless ($uname=&scantron_find_student($scan_record,$scan_data, |
if (exists $completedstudents{$uname}) { |
\%idmap,$i)) { |
&scantron_add_delay(\@delayqueue,$line, |
&scantron_add_delay(\@delayqueue,$line, |
'Student '.$uname.' has multiple sheets',2); |
'Unable to find a student that matches',1); |
next; |
next; |
} |
} |
$r->print('<pre>doing studnet'.$uname.'</pre>'); |
if (exists $completedstudents{$uname}) { |
($uname,$udom)=split(/:/,$uname); |
&scantron_add_delay(\@delayqueue,$line, |
&Apache::lonnet::delenv('form.counter'); |
'Student '.$uname.' has multiple sheets',2); |
&Apache::lonnet::appenv(%$scan_record); |
next; |
|
} |
|
# $r->print('<pre>doing studnet'.$uname.'</pre>'); |
|
($uname,$udom)=split(/:/,$uname); |
|
&Apache::lonnet::delenv('form.counter'); |
|
&Apache::lonnet::appenv(%$scan_record); |
# &Apache::lonhomework::showhash(%ENV); |
# &Apache::lonhomework::showhash(%ENV); |
# $Apache::lonxml::debug=1; |
# $Apache::lonxml::debug=1; |
# &Apache::lonxml::debug("line is $line"); |
# &Apache::lonxml::debug("line is $line"); |
|
|
my $i=0; |
my $i=0; |
foreach my $resource (@resources) { |
foreach my $resource (@resources) { |
$i++; |
$i++; |
Line 3653 SCANTRONFORM
|
Line 4168 SCANTRONFORM
|
# to ignore delayed students, possibly saving the delay queue for later |
# to ignore delayed students, possibly saving the delay queue for later |
|
|
$navmap->untieHashes(); |
$navmap->untieHashes(); |
|
$r->print("<p>Done</p>"); |
|
$r->print(&show_grading_menu_form($symb,$url)); |
|
return ''; |
|
} |
|
|
|
sub scantron_upload_scantron_data { |
|
my ($r)=@_; |
|
$r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'})); |
|
my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', |
|
'domainid'); |
|
my $domsel=&Apache::loncommon::select_dom_form($ENV{'request.role.domain'}, |
|
'domainid'); |
|
$r->print(<<UPLOAD); |
|
<script type="text/javascript" language="javascript"> |
|
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(); |
|
} |
|
</script> |
|
|
|
<form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'> |
|
Course: <input name='courseid' type='text' /> |
|
Domain: $domsel $select_link |
|
<br /> |
|
<input name='command' value='scantronupload_save' type='hidden' /> |
|
File to upload:<input type="file" name="upfile" size="50" /> |
|
<br /> |
|
<input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" /> |
|
</form> |
|
UPLOAD |
|
return ''; |
|
} |
|
|
|
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'}; |
|
#FIXME |
|
#copied from lonnet::userfileupload() |
|
#make that function able to target a specified course |
|
# Replace Windows backslashes by forward slashes |
|
$fname=~s/\\/\//g; |
|
# Get rid of everything but the actual filename |
|
$fname=~s/^.*\/([^\/]+)$/$1/; |
|
# Replace spaces by underscores |
|
$fname=~s/\s+/\_/g; |
|
# Replace all other weird characters by nothing |
|
$fname=~s/[^\w\.\-]//g; |
|
# See if there is anything left |
|
unless ($fname) { return 'error: no uploaded file'; } |
|
$fname='scantron_orig_'.$fname; |
|
&Apache::lonnet::logthis("fname is $fname"); |
|
$r->print(&Apache::lonnet::finishuserfileupload($ENV{'form.courseid'}, |
|
$ENV{'form.domainid'}, |
|
$home,'upfile',$fname)); |
|
return ''; |
} |
} |
|
|
|
|
#-------- end of section for handling grading scantron forms ------- |
#-------- end of section for handling grading scantron forms ------- |
# |
# |
#------------------------------------------------------------------- |
#------------------------------------------------------------------- |
Line 3758 GRADINGMENUJS
|
Line 4336 GRADINGMENUJS
|
$result.='<tr bgcolor="#ffffe6" valign="top"><td>'."\n". |
$result.='<tr bgcolor="#ffffe6" valign="top"><td>'."\n". |
' Select Section: <select name="section">'."\n"; |
' Select Section: <select name="section">'."\n"; |
if (ref($sections)) { |
if (ref($sections)) { |
foreach (sort (@$sections)) {$result.='<option value="'.$_.'" '. |
foreach (sort (@$sections)) { |
($saveSec eq $_ ? 'selected="on"' : '').'>'.$_.'</option>'."\n";} |
$result.='<option value="'.$_.'" '. |
|
($saveSec eq $_ ? 'selected="on"':'').'>'.$_.'</option>'."\n"; |
|
} |
} |
} |
$result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="on"' : ''). '>all</select> '; |
$result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="on"' : ''). '>all</select> '; |
|
|
$result.='Student Status:</b>'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); |
$result.='Student Status:</b>'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef); |
|
|
if (ref($sections)) { |
if (ref($sections) && (grep /no/,@$sections)) { |
$result.=' (Section "no" implies the students were not assigned a section.)<br />' |
$result.=' (Section "no" implies the students were not assigned a section.)<br />'; |
if (grep /no/,@$sections); |
|
} |
} |
$result.='</td></tr>'; |
$result.='</td></tr>'; |
|
|
Line 3779 GRADINGMENUJS
|
Line 4358 GRADINGMENUJS
|
($saveSub eq 'yes' ? 'selected="on"' : '').'>with submissions</option>'. |
($saveSub eq 'yes' ? 'selected="on"' : '').'>with submissions</option>'. |
'<option value="graded" '. |
'<option value="graded" '. |
($saveSub eq 'graded' ? 'selected="on"' : '').'>with ungraded submissions</option>'. |
($saveSub eq 'graded' ? 'selected="on"' : '').'>with ungraded submissions</option>'. |
|
'<option value="incorrect" '. |
|
($saveSub eq 'incorrect' ? 'selected="on"' : '').'>with incorrect submissions</option>'. |
'<option value="all" '. |
'<option value="all" '. |
($saveSub eq 'all' ? 'selected="on"' : '').'>with any status</option></select></td></tr>'."\n"; |
($saveSub eq 'all' ? 'selected="on"' : '').'>with any status</option></select></td></tr>'."\n"; |
|
|
Line 3842 sub handler {
|
Line 4423 sub handler {
|
$url = $ENV{'form.url'}; |
$url = $ENV{'form.url'}; |
} |
} |
&send_header($request); |
&send_header($request); |
if ($url eq '' && $symb eq '') { |
if ($url eq '' && $symb eq '' && $command eq '') { |
if ($ENV{'user.adv'}) { |
if ($ENV{'user.adv'}) { |
if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && |
if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) && |
($ENV{'form.codethree'})) { |
($ENV{'form.codethree'})) { |
Line 3883 sub handler {
|
Line 4464 sub handler {
|
delete($perm{'mgr'}); |
delete($perm{'mgr'}); |
} |
} |
} |
} |
|
|
if ($command eq 'submission' && $perm{'vgr'}) { |
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'}) { |
} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { |
Line 3923 sub handler {
|
Line 4503 sub handler {
|
} |
} |
} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { |
} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) { |
$request->print(&scantron_selectphase($request)); |
$request->print(&scantron_selectphase($request)); |
|
} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { |
|
$request->print(&scantron_validate_file($request)); |
} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { |
} elsif ($command eq 'scantron_validate' && $perm{'mgr'}) { |
$request->print(&scantron_validate_file($request)); |
$request->print(&scantron_validate_file($request)); |
} elsif ($command eq 'scantron_process' && $perm{'mgr'}) { |
} elsif ($command eq 'scantron_process' && $perm{'mgr'}) { |
$request->print(&scantron_process_students($request)); |
$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) { |
} elsif ($command) { |
$request->print("Access Denied"); |
$request->print("Access Denied ($command)"); |
} |
} |
} |
} |
&send_footer($request); |
&send_footer($request); |
Line 3944 sub send_header {
|
Line 4533 sub send_header {
|
#remotewindow.close(); |
#remotewindow.close(); |
#</script>"); |
#</script>"); |
$request->print(&Apache::loncommon::bodytag('Grading')); |
$request->print(&Apache::loncommon::bodytag('Grading')); |
foreach my $key (sort(keys(%ENV))) { |
$request->rflush(); |
if ($key =~ /^form\./) { |
|
Apache->request->print("$key => $ENV{$key} <br />"); |
|
} |
|
} |
|
} |
} |
|
|
sub send_footer { |
sub send_footer { |