version 1.130.2.1.2.2, 2003/09/25 02:46:19
|
version 1.130.2.1.2.4, 2003/09/27 01:59:10
|
Line 3268 sub username_to_idmap {
|
Line 3268 sub username_to_idmap {
|
return %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 { |
sub scantron_parse_scanline { |
my ($line,$scantron_config)=@_; |
my ($line,$scantron_config)=@_; |
my %record; |
my %record; |
Line 3283 sub scantron_parse_scanline {
|
Line 3299 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'}= |
$record{'scantron.PaperID'}= |
substr($data,$$scantron_config{'PaperID'}-1, |
substr($data,$$scantron_config{'PaperID'}-1, |
$$scantron_config{'PaperIDlength'}); |
$$scantron_config{'PaperIDlength'}); |
$record{'scantron.FirstName'}= |
$record{'scantron.FirstName'}= |
Line 3300 sub scantron_parse_scanline {
|
Line 3316 sub scantron_parse_scanline {
|
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); |
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 />'); |
|
} |
|
if (length($array[0]) eq $$scantron_config{'Qlength'}) { |
if (length($array[0]) eq $$scantron_config{'Qlength'}) { |
$record{"scantron.$questnum.answer"}=''; |
$record{"scantron.$questnum.answer"}=''; |
} 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'}},$currentquest); |
|
my @ans=@array; |
|
my $i=length($ans[0]);shift(@ans); |
|
while (@ans) { |
|
$i+=length($ans[0])+1; |
|
$record{"scantron.$questnum.answer"}.=$alphabet[$i]; |
|
} |
|
} |
} |
} |
$record{'scantron.maxquest'}=$questnum; |
$record{'scantron.maxquest'}=$questnum; |
return \%record; |
return \%record; |
Line 3354 sub scantron_filter {
|
Line 3373 sub scantron_filter {
|
#the corrected one, I'll still need to catch error conditions, but |
#the corrected one, I'll still need to catch error conditions, but |
#maybe most will taken care even before we start |
#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 ($skip,$err,$errmsg); |
|
if ($ENV{'form.scantron_skip_record'}) { |
|
$skip=1; |
|
} else { |
|
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,$line,'ID',$newid); |
|
} |
|
if ($err) { |
|
$r->print("Unable to accept last correction, an error occurred :$errmsg:"); |
|
} else { |
|
&scantron_put_line($scanlines,$which,$line,$skip); |
|
&scantron_putfile($scanlines); |
|
} |
|
} |
|
} |
|
|
sub scantron_validate_file { |
sub scantron_validate_file { |
my ($r) = @_; |
my ($r) = @_; |
my ($symb,$url)=&get_symb_and_url($r); |
my ($symb,$url)=&get_symb_and_url($r); |
Line 3397 SCANTRONFORM
|
Line 3443 SCANTRONFORM
|
} |
} |
} |
} |
$r->print("<input type='hidden' name='validatepass' value='".$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 { |
sub scantron_validate_ID { |
Line 3408 sub scantron_validate_ID {
|
Line 3536 sub scantron_validate_ID {
|
|
|
#get scantron line setup |
#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=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}"); |
my $scanlines=&scantron_getfile(); |
#FIXME really would prefer a scantron directory but tokenwrapper |
|
# doesn't allow access to subdirs of userfiles |
|
my $scanlines=&Apache::lonnet::getfile('/uploaded/'. |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'. |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'. |
|
'scantron_'.$ENV{'form.scantron_selectfile'}); |
|
|
|
my @scanlines=split("\n",$scanlines); |
|
|
|
my %found=('ids'=>{},'usernames'=>{}); |
my %found=('ids'=>{},'usernames'=>{}); |
foreach my $line (@scanlines) { |
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 $scan_record=&scantron_parse_scanline($line,\%scantron_config); |
my $id=$$scan_record{'scantron.ID'}; |
my $id=$$scan_record{'scantron.ID'}; |
$r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}."</p>\n"); |
$r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}. |
|
" on paper ID ".$$scan_record{'scantron.PaperID'}."</p>\n"); |
my $found; |
my $found; |
foreach my $checkid (keys(%idmap)) { |
foreach my $checkid (keys(%idmap)) { |
if (lc($checkid) eq lc($id)) { |
if (lc($checkid) eq lc($id)) { |
if ($checkid ne $id) { |
if ($checkid ne $id) { |
$r->print("<p>Using $checkid for bubbled $id</p>\n"); |
$r->print("<p>Using $checkid for encoded $id</p>\n"); |
} |
} |
$found=$checkid;last; |
$found=$checkid;last; |
} |
} |
} |
} |
if ($found) { |
if ($found) { |
if ($found{'ids'}{$found}) { |
if ($found{'ids'}{$found}) { |
&scantron_get_ID_correction($r,$line,$scan_record,'duplicate',$found); |
#FIXME store away line we prviously saw the ID on |
|
&scantron_get_correction($r,$i,$scan_record,$line, |
|
'duplicateID',$found); |
return(1); |
return(1); |
} else { |
} else { |
$found{'ids'}{$found}++; |
$found{'ids'}{$found}++; |
} |
} |
} else { |
} else { |
&scantron_get_ID_correction($r,$line,$scan_record,'incorrect'); |
&scantron_get_correction($r,$i,$scan_record,$line, |
|
'incorrectID'); |
return(1); |
return(1); |
} |
} |
} |
} |
Line 3448 sub scantron_validate_ID {
|
Line 3574 sub scantron_validate_ID {
|
return (0,$currentphase+1); |
return (0,$currentphase+1); |
} |
} |
|
|
sub scantron_get_ID_correction { |
sub scantron_get_correction { |
my ($r,$line,$scan_record,$error,$arg)=@_; |
my ($r,$i,$scan_record,$line,$error,$arg)=@_; |
$r->print("<p>need to correct ID</p>\n"); |
|
|
#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>This scantron record has an error."); |
|
if ( defined($$scan_record{'scantron.PaperID'}) ) { |
|
$r->print("The current PaperID is <tt>". |
|
$$scan_record{'scantron.PaperID'}."</tt> \n"); |
|
} else { |
|
$r->print("The current scanline is <pre>". |
|
$line."</pre> \n"); |
|
} |
$r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); |
$r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); |
$r->print('<input type="hidden" name="scantron_line" value="'.&HTML::Entities::encode($line).'" />'."\n"); |
$r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); |
if ($error eq 'unknown') { |
if ($error =~ /ID$/) { |
$r->print("<p> Unknown ID </p>\n"); |
if ($error eq 'unknownID') { |
} elsif ($error eq 'duplicate') { |
$r->print("The encoded ID is not in the classlist</p>\n"); |
$r->print("<p> Duplicated ID </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>Original ID is ".$$scan_record{'scantron.ID'}."</p>\n"); |
} |
$r->print("<p>Name on paper is ".$$scan_record{'scantron.LastName'}.",". |
$r->print("<p>Original ID is <tt>".$$scan_record{'scantron.ID'}. |
$$scan_record{'scantron.FirstName'}."</p>"); |
"</tt><br />\n"); |
$r->print("Corrected User -- "); |
$r->print("Name on paper is ".$$scan_record{'scantron.LastName'}.",". |
$r->print("\nusername:<input type='text' name='scantron_username' value='' />"); |
$$scan_record{'scantron.FirstName'}."</p>"); |
$r->print("\ndomain:". |
$r->print("<p>Please correct <br /> \n"); |
&Apache::loncommon::select_dom_form(undef,'scantron_domain')); |
$r->print("\n<ul><li> Pick a specific user -- username:<input type='text' name='scantron_username' value='' />"); |
#FIXME it would be nice if this sent back the user ID and |
$r->print("\ndomain:". |
#could do partial userID matches |
&Apache::loncommon::select_dom_form(undef,'scantron_domain')); |
$r->print(&Apache::loncommon::selectstudent_link('scantronupload', |
#FIXME it would be nice if this sent back the user ID and |
'scantron_username','scantron_domain')); |
#could do partial userID matches |
|
$r->print(&Apache::loncommon::selectstudent_link('scantronupload', |
|
'scantron_username','scantron_domain')); |
|
} elsif ($error eq 'doublebubble') { |
|
$r->print("There have been muttiple bubbles scanned for a single question\n"); |
|
foreach my $question (@{$arg}) { |
|
my $selected=$$scan_record{"scantron.$question.answer"}; |
|
$r->print("<p> For question $question, selected bubbles were". |
|
join(" ",split('',$selected)). |
|
" Please pick which one should be used for grading"); |
|
#FIXMENEXT need to have radio buttons to chose which one to use |
|
|
|
} |
|
} |
|
$r->print("</li> <li>Skip this scanline saving it for later "); |
|
$r->print("\n<input type='checkbox' name='scantron_skip_record' /> </li></ul>"); |
&scantron_end_validate_form($r); |
&scantron_end_validate_form($r); |
} |
} |
|
|
|
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=&scantron_getfile(); |
|
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); |
|
if (!defined($$scan_record{'scantron.doubleerror'})) { next; } |
|
&scantron_get_correction($r,$i,$scan_record,$line,'double', |
|
$$scan_record{'scantron.doubleerror'}); |
|
return (1,$currentphase); |
|
} |
|
return (0,$currentphase+1); |
|
} |
|
|
sub scantron_end_validate_form { |
sub scantron_end_validate_form { |
my ($r) = @_; |
my ($r) = @_; |
$r->print('<input type="submit" name="submit" /></form></body></html>'); |
$r->print('<input type="submit" name="submit" /></form></body></html>'); |