loncom/homework/grades.pm - diff

Return to grades.pm CVS log

Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.130.2.1.2.4 and 1.130.2.1.2.8

version 1.130.2.1.2.4, 2003/09/27 01:59:10	version 1.130.2.1.2.8, 2003/10/13 22:36:59
Line 3214 sub scantron_selectphase {	Line 3214 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 3269 sub username_to_idmap {	Line 3276 sub username_to_idmap {
}	}

sub scantron_fixup_scanline {	sub scantron_fixup_scanline {
my ($scantron_config,$line,$field,$newvalue) = @_;	my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
if ($field eq 'ID') {	if ($field eq 'ID') {
if ($newvalue > $$scantron_config{'IDlength'}) {	if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
return ($line,1,'New value to large');	return ($line,1,'New value to large');
}	}
if ($newvalue < $$scantron_config{'IDlength'}) {	if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) {
$newvalue=sprintf('%-'.$$scantron_config{'IDlength'}.'s',	$args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s',
$newvalue);	$args->{'newid'});
}	}
substr($line,$$scantron_config{'IDstart'}-1,	substr($line,$$scantron_config{'IDstart'}-1,
$$scantron_config{'IDlength'})=$newvalue;	$$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;	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 3315 sub scantron_parse_scanline {	Line 3351 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 (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) {	if (scalar(@array) gt 2) {
push(@{$record{'scantron.doubleerror'}},$currentquest);	Apache->request->print("snippet is <pre>$currentquest</pre>");
	push(@{$record{'scantron.doubleerror'}},$questnum);
my @ans=@array;	my @ans=@array;
my $i=length($ans[0]);shift(@ans);	my $i=length($ans[0]);shift(@ans);
while (@ans) {	while ($#ans) {
$i+=length($ans[0])+1;	$i+=length($ans[0])+1;
$record{"scantron.$questnum.answer"}.=$alphabet[$i];	$record{"scantron.$questnum.answer"}.=$alphabet[$i];
	shift(@ans);
}	}
}	}
}	}
Line 3345 sub scantron_add_delay {	Line 3386 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>');	#Apache->request->print('<pre>checking studnet -'.$id.'- againt -'.$scanID.'- </pre>');
if (lc($id) eq lc($scanID)) {	if (lc($id) eq lc($scanID)) {
Line 3365 sub scantron_filter {	Line 3409 sub scantron_filter {
return 0;	return 0;
}	}

#FIXME I think I am doing this in the wrong order, I think it would be
#better to make a several passes analyzing all of the lines in the
#file for common errors wrong/invalid PID/username duplicated
#PID/username, missing bubbles, double bubbles, missing/invalid CODE
#and then get the instructor to fix all of these errors, then grade
#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 {	sub scantron_process_corrections {
my ($r) = @_;	my ($r) = @_;
if ($ENV{'form.scantron_corrections'} =~ /^(duplicate\|incorrect)ID$/) {	my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});	my ($scanlines,$scan_data)=&scantron_getfile();
my $scanlines=&scantron_getfile();	my $classlist=&Apache::loncoursedata::get_classlist();
my $classlist=&Apache::loncoursedata::get_classlist();	my $which=$ENV{'form.scantron_line'};
my $which=$ENV{'form.scantron_line'};	my $line=&scantron_get_line($scanlines,$which);
my $line=&scantron_get_line($scanlines,$which);	my ($skip,$err,$errmsg);
my ($skip,$err,$errmsg);	if ($ENV{'form.scantron_skip_record'}) {
if ($ENV{'form.scantron_skip_record'}) {	$skip=1;
$skip=1;	} elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate\|incorrect)ID$/) {
} else {	my $newstudent=$ENV{'form.scantron_username'}.':'.
my $newstudent=$ENV{'form.scantron_username'}.':'.	$ENV{'form.scantron_domain'};
$ENV{'form.scantron_domain'};	my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID];
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)=	($line,$err,$errmsg)=
&scantron_fixup_scanline(\%scantron_config,$line,'ID',$newid);	&scantron_fixup_scanline(\%scantron_config,$scan_data,$line,
}	$which,'answer',
if ($err) {	{ 'question'=>$question,
$r->print("Unable to accept last correction, an error occurred :$errmsg:");	'response'=>$ENV{"form.scantron_correct_Q_$question"}});
} else {	if ($err) { last; }
&scantron_put_line($scanlines,$which,$line,$skip);
&scantron_putfile($scanlines);
}	}
}	}
	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 {	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 3413 sub scantron_validate_file {	Line 3460 sub scantron_validate_file {
$r->print(&Apache::loncommon::studentbrowser_javascript());	$r->print(&Apache::loncommon::studentbrowser_javascript());
my $result= <<SCANTRONFORM;	my $result= <<SCANTRONFORM;
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">	<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="selectpage" value="$ENV{'form.selectpage'}" />
<input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" />	<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_selectfile" value="$ENV{'form.scantron_selectfile'}" />
	<input type="hidden" name="scantron_maxbubble" value="$ENV{'form.scantron_maxbubble'}" />
$default_form_data	$default_form_data
SCANTRONFORM	SCANTRONFORM
$r->print($result);	$r->print($result);
Line 3436 SCANTRONFORM	Line 3483 SCANTRONFORM
}	}
my $stop=0;	my $stop=0;
while (!$stop && $currentphase < scalar(@validate_phases)) {	while (!$stop && $currentphase < scalar(@validate_phases)) {
	$r->print("<p> Validating ".$validate_phases[$currentphase]."</p>");
	$r->rflush();
my $which="scantron_validate_".$validate_phases[$currentphase];	my $which="scantron_validate_".$validate_phases[$currentphase];
{	{
no strict 'refs';	no strict 'refs';
($stop,$currentphase)=&$which($r,$currentphase);	($stop,$currentphase)=&$which($r,$currentphase);
}	}
}	}
$r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");	if (!$stop) {
	$r->print("Validation process complete, click 'Submit' to start proccssing");
	$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."' />");
	}
	$r->print('<input type="submit" name="submit" /></form></body></html>');
return '';	return '';
}	}

sub scantron_getfile {	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	#FIXME really would prefer a scantron directory but tokenwrapper
# doesn't allow access to subdirs of userfiles	# 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;	my $lines;
$lines=&Apache::lonnet::getfile('/uploaded/'.	$lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
'scantron_orig_'.$ENV{'form.scantron_selectfile'});	'scantron_orig_'.$ENV{'form.scantron_selectfile'});
if ($lines eq '-1') {	if ($lines eq '-1') {
#FIXME need to actually replicate file to course space	#FIXME need to actually replicate file to course space
	#FIXME when replicating strip CRLF to LF or CR to LF
}	}
my %scanlines;	my %scanlines;
$scanlines{'orig'}=[split("\n",$lines)];	$scanlines{'orig'}=[(split("\n",$lines,-1))];
my $temp=$scanlines{'orig'};	my $temp=$scanlines{'orig'};
$scanlines{'count'}=$#$temp;	$scanlines{'count'}=$#$temp;

$lines=&Apache::lonnet::getfile('/uploaded/'.	$lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
'scantron_corrected_'.$ENV{'form.scantron_selectfile'});	'scantron_corrected_'.$ENV{'form.scantron_selectfile'});
if ($lines eq '-1') {	if ($lines eq '-1') {
$scanlines{'corrected'}=[];	$scanlines{'corrected'}=[];
} else {	} else {
$scanlines{'corrected'}=[split("\n",$lines)];	$scanlines{'corrected'}=[(split("\n",$lines,-1))];
}	}
$lines=&Apache::lonnet::getfile('/uploaded/'.	$lines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
'scantron_skipped_'.$ENV{'form.scantron_selectfile'});	'scantron_skipped_'.$ENV{'form.scantron_selectfile'});
if ($lines eq '-1') {	if ($lines eq '-1') {
$scanlines{'skipped'}=[];	$scanlines{'skipped'}=[];
} else {	} else {
$scanlines{'skipped'}=[split("\n",$lines)];	$scanlines{'skipped'}=[(split("\n",$lines,-1))];
}	}
return \%scanlines;	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 {	sub lonnet_putfile {
Line 3495 sub lonnet_putfile {	Line 3550 sub lonnet_putfile {
}	}

sub scantron_putfile {	sub scantron_putfile {
my ($scanlines) = @_;	my ($scanlines,$scan_data) = @_;
#FIXME really would prefer a scantron directory but tokenwrapper	#FIXME really would prefer a scantron directory but tokenwrapper
# doesn't allow access to subdirs of userfiles	# doesn't allow access to subdirs of userfiles
my $prefix='/uploaded/'.	my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.	my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
'scantron_';
my $prefix='scantron_';	my $prefix='scantron_';
# no need to update orig, shouldn't change	# no need to update orig, shouldn't change
# &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.	# &lonnet_putfile(join("\n",@{$scanlines->{'orig'}}),$prefix.'orig_'.
Line 3512 sub scantron_putfile {	Line 3565 sub scantron_putfile {
&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),	&lonnet_putfile(join("\n",@{$scanlines->{'skipped'}}),
$prefix.'skipped_'.	$prefix.'skipped_'.
$ENV{'form.scantron_selectfile'});	$ENV{'form.scantron_selectfile'});
	&Apache::lonnet::put('scantrondata',$scan_data,$cdom,$cname);
}	}

sub scantron_get_line {	sub scantron_get_line {
Line 3523 sub scantron_get_line {	Line 3577 sub scantron_get_line {

sub scantron_put_line {	sub scantron_put_line {
my ($scanlines,$i,$newline,$skip)=@_;	my ($scanlines,$i,$newline,$skip)=@_;
if ($skip) { $scanlines->{'skipped'}[$i]=$newline;return; }	if ($skip) {
	$scanlines->{'skipped'}[$i]=$newline;
	return;
	}
$scanlines->{'corrected'}[$i]=$newline;	$scanlines->{'corrected'}[$i]=$newline;
}	}

Line 3536 sub scantron_validate_ID {	Line 3593 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=&scantron_getfile();	my ($scanlines,$scan_data)=&scantron_getfile();

my %found=('ids'=>{},'usernames'=>{});	my %found=('ids'=>{},'usernames'=>{});
for (my $i=0;$i<=$scanlines->{'count'};$i++) {	for (my $i=0;$i<=$scanlines->{'count'};$i++) {
my $line=&scantron_get_line($scanlines,$i);	my $line=&scantron_get_line($scanlines,$i);
if (!$line) { next; }	if (!$line) { next; }
my $scan_record=&scantron_parse_scanline($line,\%scantron_config);	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
	$scan_data);
my $id=$$scan_record{'scantron.ID'};	my $id=$$scan_record{'scantron.ID'};
$r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}.	# $r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}.
" on paper ID ".$$scan_record{'scantron.PaperID'}."</p>\n");	# " 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 encoded $id</p>\n");	#$r->print("<p>Using $checkid for encoded $id</p>\n");
}	}
$found=$checkid;last;	$found=$checkid;last;
}	}
}	}
if ($found) {	if ($found) {
	my $username=$idmap{$found};
if ($found{'ids'}{$found}) {	if ($found{'ids'}{$found}) {
#FIXME store away line we prviously saw the ID on	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
&scantron_get_correction($r,$i,$scan_record,$line,	$line,'duplicateID',$found);
'duplicateID',$found);	return(1);
	} elsif ($found{'usernames'}{$username}) {
	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
	$line,'duplicateID',$username);
return(1);	return(1);
} else {
$found{'ids'}{$found}++;
}	}
	#FIXME store away line we prviously saw the ID on to use above
	$found{'ids'}{$found}++;
	$found{'usernames'}{$username}++;
} else {	} else {
&scantron_get_correction($r,$i,$scan_record,$line,	if ($id =~ /^\s*$/) {
'incorrectID');	my $username=&scan_data($scan_data,"$i.user");
return(1);	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);
	}
}	}
}	}

Line 3575 sub scantron_validate_ID {	Line 3654 sub scantron_validate_ID {
}	}

sub scantron_get_correction {	sub scantron_get_correction {
my ($r,$i,$scan_record,$line,$error,$arg)=@_;	my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;

#FIXME in the case of a duplicated ID the previous line, probaly need	#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	#to show both the current line and the previous one and allow skipping
#the previous one or the current one	#the previous one or the current one

$r->print("<p>This scantron record has an error.");	$r->print("<p>This scantron record has an error ($error). ");
if ( defined($$scan_record{'scantron.PaperID'}) ) {	if ( defined($$scan_record{'scantron.PaperID'}) ) {
$r->print("The current PaperID is <tt>".	$r->print("The current PaperID is <tt>".
$$scan_record{'scantron.PaperID'}."</tt> \n");	$$scan_record{'scantron.PaperID'}."</tt> \n");
Line 3609 sub scantron_get_correction {	Line 3688 sub scantron_get_correction {
#could do partial userID matches	#could do partial userID matches
$r->print(&Apache::loncommon::selectstudent_link('scantronupload',	$r->print(&Apache::loncommon::selectstudent_link('scantronupload',
'scantron_username','scantron_domain'));	'scantron_username','scantron_domain'));
	$r->print('</li>');
} elsif ($error eq 'doublebubble') {	} elsif ($error eq 'doublebubble') {
$r->print("There have been muttiple bubbles scanned for a single question\n");	$r->print("<pre>$line</pre>");
	$Apache::lonxml::debug=1;
	&Apache::lonhomework::showhashsubset($scan_record,'.');
	$Apache::lonxml::debug=0;
	$r->print("There have been multiple bubbles scanned for a single question\n");
	$r->print('<input type="hidden" name="scantron_questions" value="'.
	join(',',@{$arg}).'" />');
foreach my $question (@{$arg}) {	foreach my $question (@{$arg}) {
my $selected=$$scan_record{"scantron.$question.answer"};	my $selected=$$scan_record{"scantron.$question.answer"};
$r->print("<p> For question $question, selected bubbles were".	$r->print("<p> For question $question, selected bubbles were ".
join(" ",split('',$selected)).	join(" ",split('',$selected,-1)).
" Please pick which one should be used for grading");	" <br />Please pick which one should be used for grading<br />");
#FIXMENEXT need to have radio buttons to chose which one to use	&scantron_bubble_selector($r,$scan_config,$question);
	}
	} elsif ($error eq 'missingbubble') {
	$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"};
	$r->print("<p>Question $question, Please select a bubble to use ");
	&scantron_bubble_selector($r,$scan_config,$question);
}	}
	} else {
	$r->print("\n<ul>");
}	}
$r->print("</li> <li>Skip this scanline saving it for later ");	$r->print("<li>Skip this scanline saving it for later ");
$r->print("\n<input type='checkbox' name='scantron_skip_record' /> </li></ul>");	$r->print("\n<input type='checkbox' name='scantron_skip_record' /> </li></ul>");
&scantron_end_validate_form($r);	}

	sub scantron_bubble_selector {
	my ($r,$scan_config,$quest)=@_;
	my $max=$$scan_config{'Qlength'};
	my @alphabet=('A'..'Z');
	for (my $i=0;$i<$max;$i++) {
	$r->print('<input type="radio" name="scantron_correct_Q_'.$quest.
	'" value="'.$i.'" />'.$alphabet[$i]);
	}
	$r->print('<input type="radio" name="scantron_correct_Q_'.$quest.
	'" value="none" /> Nothing');
	$r->print('<br />');
}	}

sub scantron_validate_CODE {	sub scantron_validate_CODE {
Line 3639 sub scantron_validate_doublebubble {	Line 3747 sub scantron_validate_doublebubble {

#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=&scantron_getfile();	my ($scanlines,$scan_data)=&scantron_getfile();
for (my $i=0;$i<=$scanlines->{'count'};$i++) {	for (my $i=0;$i<=$scanlines->{'count'};$i++) {
my $line=&scantron_get_line($scanlines,$i);	my $line=&scantron_get_line($scanlines,$i);
if (!$line) { next; }	if (!$line) { next; }
my $scan_record=&scantron_parse_scanline($line,\%scantron_config);	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
	$scan_data);
if (!defined($$scan_record{'scantron.doubleerror'})) { next; }	if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
&scantron_get_correction($r,$i,$scan_record,$line,'double',	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
	'doublebubble',
$$scan_record{'scantron.doubleerror'});	$$scan_record{'scantron.doubleerror'});
return (1,$currentphase);	return (1,$currentphase);
}	}
return (0,$currentphase+1);	return (0,$currentphase+1);
}	}

sub scantron_end_validate_form {	sub scantron_validate_missingbubbles {
my ($r) = @_;	my ($r,$currentphase) = @_;
$r->print('<input type="submit" name="submit" /></form></body></html>');	#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) { 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 {
Line 3665 sub scantron_process_students {	Line 3802 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($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1);	my $navmap=Apache::lonnavmaps::navmap->new($ENV{'request.course.fn'}.'.db',$ENV{'request.course.fn'}.'_parms.db',1, 1);
Line 3683 SCANTRONFORM	Line 3819 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;
	while ($i<$scanlines->{'count'}) {
	$i++;
	my $line=&scantron_get_line($scanlines,$i);
$r->print('<pre>line is'.$line.'</pre>');	$r->print('<pre>line is'.$line.'</pre>');
	if (!defined($line)) {
chomp($line);	$r->print('skipping');
my $scan_record=&scantron_parse_scanline($line,\%scantron_config);	next;
	}
	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
	$scan_data);
my ($uname,$udom);	my ($uname,$udom);
unless ($uname=&scantron_find_student($scan_record,\%idmap)) {	unless ($uname=&scantron_find_student($scan_record,$scan_data,
	\%idmap,$i)) {
&scantron_add_delay(\@delayqueue,$line,	&scantron_add_delay(\@delayqueue,$line,
'Unable to find a student that matches',1);	'Unable to find a student that matches',1);
next;	next;
Line 3774 SCANTRONFORM	Line 3917 SCANTRONFORM

$navmap->untieHashes();	$navmap->untieHashes();
}	}

	sub scantron_upload_scantron_data {
	my ($r)=@_;
	$r->print(&Apache::loncommon::coursebrowser_javascript($ENV{'request.role.domain'}));
	$r->print(&Apache::loncommon::selectcourse_link('rules',
	'courseid','domain'));
	$r->print("Course: <input name='courseid' type='text'/>");
	$r->print("Domain: <input name='domain' type='text'/>");

	return '';

	}
#-------- end of section for handling grading scantron forms -------	#-------- end of section for handling grading scantron forms -------
#	#
#-------------------------------------------------------------------	#-------------------------------------------------------------------
Line 4001 sub handler {	Line 4156 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 4045 sub handler {	Line 4199 sub handler {
$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) {	} elsif ($command) {
$request->print("Access Denied");	$request->print("Access Denied");
}	}
Line 4062 sub send_header {	Line 4218 sub send_header {
#remotewindow.close();	#remotewindow.close();
#</script>");	#</script>");
$request->print(&Apache::loncommon::bodytag('Grading'));	$request->print(&Apache::loncommon::bodytag('Grading'));
	$request->rflush();
}	}

sub send_footer {	sub send_footer {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.130.2.1.2.4
changed lines
	Added in v.1.130.2.1.2.8