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.596.2.12.2.1 and 1.596.2.12.2.16

version 1.596.2.12.2.1, 2012/05/02 14:01:32	version 1.596.2.12.2.16, 2013/06/28 22:54:50
Line 52 use POSIX qw(floor);	Line 52 use POSIX qw(floor);


my %perm=();	my %perm=();
	my %old_essays=();

# These variables are used to recover from ssi errors	# These variables are used to recover from ssi errors

Line 124 sub getpartlist {	Line 125 sub getpartlist {
# --- Get the symbolic name of a problem and the url	# --- Get the symbolic name of a problem and the url
sub get_symb {	sub get_symb {
my ($request,$silent) = @_;	my ($request,$silent) = @_;
(my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}\|$ENV{'HTTP_HOST'})--;	my $symb=$env{'form.symb'};
my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));	unless ($symb) {
if ($symb eq '') {	(my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}\|$ENV{'HTTP_HOST'})--;
if (!$silent) {	$symb = &Apache::lonnet::symbread($url);
$request->print(&mt("Unable to handle ambiguous references: [_1].",$url));	if ($symb eq '') {
return ();	if (!$silent) {
}	$request->print(&mt("Unable to handle ambiguous references: [_1].",$url));
	return ();
	}
	}
}	}
&Apache::lonenc::check_decrypt(\$symb);	&Apache::lonenc::check_decrypt(\$symb);
return ($symb);	return ($symb);
Line 249 sub showResourceInfo {	Line 253 sub showResourceInfo {
$result.='<td>'.$display_part.'</td>'	$result.='<td>'.$display_part.'</td>'
.'<td>'.'<span class="LC_internal_info">'.$resID.'</span></td>'	.'<td>'.'<span class="LC_internal_info">'.$resID.'</span></td>'
.'<td>'.&mt($responsetype).'</td>'	.'<td>'.&mt($responsetype).'</td>'
# .'<td>'.&mt('<b>Handgrade: </b>[_1]',$handgrade).'</td>'	# .'<td><b>'.&mt('Handgrade: [_1]',$handgrade).'</b></td>'
.&Apache::loncommon::end_data_table_row();	.&Apache::loncommon::end_data_table_row();
}	}
}	}
Line 260 sub showResourceInfo {	Line 264 sub showResourceInfo {
sub reset_caches {	sub reset_caches {
&reset_analyze_cache();	&reset_analyze_cache();
&reset_perm();	&reset_perm();
	&reset_old_essays();
}	}

{	{
Line 743 sub compute_points {	Line 748 sub compute_points {
#	#

sub most_similar {	sub most_similar {
my ($uname,$udom,$uessay,$old_essays)=@_;	my ($uname,$udom,$symb,$uessay)=@_;

	unless ($symb) { return ''; }

	unless (ref($old_essays{$symb}) eq 'HASH') { return ''; }

# ignore spaces and punctuation	# ignore spaces and punctuation

Line 760 sub most_similar {	Line 769 sub most_similar {
my $scrsid='';	my $scrsid='';
my $sessay='';	my $sessay='';
# go through all essays ...	# go through all essays ...
foreach my $tkey (keys(%$old_essays)) {	foreach my $tkey (keys(%{$old_essays{$symb}})) {
my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));	my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey));
# ... except the same student	# ... except the same student
next if (($tname eq $uname) && ($tdom eq $udom));	next if (($tname eq $uname) && ($tdom eq $udom));
my $tessay=$old_essays->{$tkey};	my $tessay=$old_essays{$symb}{$tkey};
$tessay=~s/\W+/ /gs;	$tessay=~s/\W+/ /gs;
# String similarity gives up if not even limit	# String similarity gives up if not even limit
my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);	my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit);
Line 774 sub most_similar {	Line 783 sub most_similar {
$sname=$tname;	$sname=$tname;
$sdom=$tdom;	$sdom=$tdom;
$scrsid=$tcrsid;	$scrsid=$tcrsid;
$sessay=$old_essays->{$tkey};	$sessay=$old_essays{$symb}{$tkey};
}	}
}	}
if ($limit>0.6) {	if ($limit>0.6) {
Line 1610 INNERJS	Line 1619 INNERJS

function savedMsgHeader(Nmsg,usrctr,fullname) {	function savedMsgHeader(Nmsg,usrctr,fullname) {
var height = 70*Nmsg+250;	var height = 70*Nmsg+250;
var scrollbar = "no";
if (height > 600) {	if (height > 600) {
height = 600;	height = 600;
scrollbar = "yes";
}	}
var xpos = (screen.width-600)/2;	var xpos = (screen.width-600)/2;
xpos = (xpos < 0) ? '0' : xpos;	xpos = (xpos < 0) ? '0' : xpos;
var ypos = (screen.height-height)/2-30;	var ypos = (screen.height-height)/2-30;
ypos = (ypos < 0) ? '0' : ypos;	ypos = (ypos < 0) ? '0' : ypos;

pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=700,height='+height);	pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars=yes,screenx='+xpos+',screeny='+ypos+',width=700,height='+height);
pWin.focus();	pWin.focus();
pDoc = pWin.document;	pDoc = pWin.document;
pDoc.$docopen;	pDoc.$docopen;
Line 1916 sub show_problem {	Line 1923 sub show_problem {
$companswer=~s\|</form>\|\|g;	$companswer=~s\|</form>\|\|g;
$companswer=~s\|name="submit"\|name="would_have_been_submit"\|g;	$companswer=~s\|name="submit"\|name="would_have_been_submit"\|g;
}	}
	my $renderheading = &mt('View of the problem');
	my $answerheading = &mt('Correct answer');
	if (($uname ne $env{'user.name'}) \|\| ($udom ne $env{'user.domain'})) {
	my $stu_fullname = $env{'form.fullname'};
	if ($stu_fullname eq '') {
	$stu_fullname = &Apache::loncommon::plainname($uname,$udom,'lastname');
	}
	my $forwhom = &nameUserString(undef,$stu_fullname,$uname,$udom);
	if ($forwhom ne '') {
	$renderheading = &mt('View of the problem for[_1]',$forwhom);
	$answerheading = &mt('Correct answer for[_1]',$forwhom);
	}
	}
$rendered=	$rendered=
'<div class="LC_Box">'	'<div class="LC_Box">'
.'<h3 class="LC_hcell">'.&mt('View of the problem').'</h3>'	.'<h3 class="LC_hcell">'.$renderheading.'</h3>'
.$rendered	.$rendered
.'</div>';	.'</div>';
$companswer=	$companswer=
'<div class="LC_Box">'	'<div class="LC_Box">'
.'<h3 class="LC_hcell">'.&mt('Correct answer').'</h3>'	.'<h3 class="LC_hcell">'.$answerheading.'</h3>'
.$companswer	.$companswer
.'</div>';	.'</div>';
my $result;	my $result;
Line 1994 sub submission {	Line 2014 sub submission {
$udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?	$udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student?
my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});	my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
$env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';	$env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq '';
my $symb = &get_symb($request);	my ($symb) = &get_symb($request);
if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }	if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; }

if (!&canview($usec)) {	if (!&canview($usec)) {
Line 2013 sub submission {	Line 2033 sub submission {
'" src="'.$request->dir_config('lonIconsURL').	'" src="'.$request->dir_config('lonIconsURL').
'/check.gif" height="16" border="0" />';	'/check.gif" height="16" border="0" />';

my %old_essays;
# header info	# header info
if ($counter == 0) {	if ($counter == 0) {
&sub_page_js($request);	&sub_page_js($request);
Line 2129 KEYWORDS	Line 2148 KEYWORDS
my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);	my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
$apath=&escape($apath);	$apath=&escape($apath);
$apath=~s/\W/\_/gs;	$apath=~s/\W/\_/gs;
%old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);	&init_old_essays($symb,$apath,$adom,$aname);
}	}
}	}

Line 2266 KEYWORDS	Line 2285 KEYWORDS
}	}
if($env{'form.checkPlag'}){	if($env{'form.checkPlag'}){
my ($oname,$odom,$ocrsid,$oessay,$osim)=	my ($oname,$odom,$ocrsid,$oessay,$osim)=
&most_similar($uname,$udom,$subval,\%old_essays);	&most_similar($uname,$udom,$symb,$subval);
if ($osim) {	if ($osim) {
$osim=int($osim*100.0);	$osim=int($osim*100.0);
my %old_course_desc =	my %old_course_desc =
Line 2598 sub keywords_highlight {	Line 2617 sub keywords_highlight {
return $string;	return $string;
}	}

	# For Tasks provide a mechanism to display previous version for one specific student

	sub show_previous_task_version {
	my ($request,$symb) = @_;
	if ($symb eq '') {
	$request->print("Unable to handle ambiguous references.");

	return '';
	}
	my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'});
	my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
	if (!&canview($usec)) {
	$request->print('<span class="LC_warning">Unable to view previous version for requested student.('.
	$uname.':'.$udom.' in section '.$usec.' in course id '.
	$env{'request.course.id'}.')</span>');
	return;
	}
	my $mode = 'both';
	my $isTask = ($symb =~/\.task$/);
	if ($isTask) {
	if ($env{'form.previousversion'} =~ /^\d+$/) {
	if ($env{'form.fullname'} eq '') {
	$env{'form.fullname'} =
	&Apache::loncommon::plainname($uname,$udom,'lastname');
	}
	my $probtitle=&Apache::lonnet::gettitle($symb);
	$request->print("\n\n".
	'<div class="LC_grade_show_user">'.
	'<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
	'</h2>'."\n");
	&Apache::lonxml::clear_problem_counter();
	$request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode,
	{'previousversion' => $env{'form.previousversion'} }));
	$request->print("\n</div>");
	}
	}
	return;
	}

	sub choose_task_version_form {
	my ($symb,$uname,$udom,$nomenu) = @_;
	my $isTask = ($symb =~/\.task$/);
	my ($current,$version,$result,$js,$displayed,$rowtitle);
	if ($isTask) {
	my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
	$udom,$uname);
	if (($record{'resource.0.version'} eq '') \|\|
	($record{'resource.0.version'} < 2)) {
	return ($record{'resource.0.version'},
	$record{'resource.0.version'},$result,$js);
	} else {
	$current = $record{'resource.0.version'};
	}
	if ($env{'form.previousversion'}) {
	$displayed = $env{'form.previousversion'};
	$rowtitle = &mt('Choose another version:')
	} else {
	$displayed = $current;
	$rowtitle = &mt('Show earlier version:');
	}
	$result = '<div class="LC_left_float">';
	my $list;
	my $numversions = 0;
	for (my $i=1; $i<=$record{'resource.0.version'}; $i++) {
	if ($i == $current) {
	if (!$env{'form.previousversion'} \|\| $nomenu) {
	next;
	} else {
	$list .= '<option value="'.$i.'">'.&mt('Current').'</option>'."\n";
	$numversions ++;
	}
	} elsif (defined($record{'resource.'.$i.'.0.status'})) {
	unless ($i == $env{'form.previousversion'}) {
	$numversions ++;
	}
	$list .= '<option value="'.$i.'">'.$i.'</option>'."\n";
	}
	}
	if ($numversions) {
	$symb = &HTML::Entities::encode($symb,'<>"&');
	$result .=
	'<form name="getprev" method="post" action=""'.
	' onsubmit="return previousVersion('."'$uname','$udom','$symb','$displayed'".');">'.
	&Apache::loncommon::start_data_table().
	&Apache::loncommon::start_data_table_row().
	'<th align="left">'.$rowtitle.'</th>'.
	'<td><select name="version">'.
	'<option>'.&mt('Select').'</option>'.
	$list.
	'</select></td>'.
	&Apache::loncommon::end_data_table_row();
	unless ($nomenu) {
	$result .= &Apache::loncommon::start_data_table_row().
	'<th align="left">'.&mt('Open in new window').'</th>'.
	'<td><span class="LC_nobreak">'.
	'<label><input type="radio" name="prevwin" value="1" />'.
	&mt('Yes').'</label>'.
	'<label><input type="radio" name="prevwin" value="0" checked="checked" />'.&mt('No').'</label>'.
	'</span></td>'.
	&Apache::loncommon::end_data_table_row();
	}
	$result .=
	&Apache::loncommon::start_data_table_row().
	'<th align="left"> </th>'.
	'<td>'.
	'<input type="submit" name="prevsub" value="'.&mt('Display').'" />'.
	'</td>'.
	&Apache::loncommon::end_data_table_row().
	&Apache::loncommon::end_data_table().
	'</form>';
	$js = &previous_display_javascript($nomenu,$current);
	} elsif ($displayed && $nomenu) {
	$result .= '<a href="javascript:window.close()">'.&mt('Close window').'</a>';
	} else {
	$result .= &mt('No previous versions to show for this student');
	}
	$result .= '</div>';
	}
	return ($current,$displayed,$result,$js);
	}

	sub previous_display_javascript {
	my ($nomenu,$current) = @_;
	my $js = <<"JSONE";
	<script type="text/javascript">
	// <![CDATA[
	function previousVersion(uname,udom,symb) {
	var current = '$current';
	var version = document.getprev.version.options[document.getprev.version.selectedIndex].value;
	var prevstr = new RegExp("^\\\\d+\$");
	if (!prevstr.test(version)) {
	return false;
	}
	var url = '';
	if (version == current) {
	url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=submission';
	} else {
	url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=versionsub&previousversion='+version;
	}
	JSONE
	if ($nomenu) {
	$js .= <<"JSTWO";
	document.location.href = url;
	JSTWO
	} else {
	$js .= <<"JSTHREE";
	var newwin = 0;
	for (var i=0; i<document.getprev.prevwin.length; i++) {
	if (document.getprev.prevwin[i].checked == true) {
	newwin = document.getprev.prevwin[i].value;
	}
	}
	if (newwin == 1) {
	var options = 'height=600,width=800,resizable=yes,scrollbars=yes,location=no,menubar=no,toolbar=no';
	url = url+'&inhibitmenu=yes';
	if (typeof(previousWin) == 'undefined' \|\| previousWin.closed) {
	previousWin = window.open(url,'',options,1);
	} else {
	previousWin.location.href = url;
	}
	previousWin.focus();
	return false;
	} else {
	document.location.href = url;
	return false;
	}
	JSTHREE
	}
	$js .= <<"ENDJS";
	return false;
	}
	// ]]>
	</script>
	ENDJS

	}

#--- Called from submission routine	#--- Called from submission routine
sub processHandGrade {	sub processHandGrade {
my ($request) = shift;	my ($request) = shift;
my $symb = &get_symb($request);	my ($symb) = &get_symb($request);
my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);	my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
my $button = $env{'form.gradeOpt'};	my $button = $env{'form.gradeOpt'};
my $ngrade = $env{'form.NCT'};	my $ngrade = $env{'form.NCT'};
Line 3006 sub handback_files {	Line 3202 sub handback_files {
&file_name_version_ext($answer_file);	&file_name_version_ext($answer_file);
my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);	my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/);
my $getpropath = 1;	my $getpropath = 1;
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath);	my ($dir_list,$listerror) =
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);	&Apache::lonnet::dirlist($portfolio_root.$portfolio_path,
# fix file name	$domain,$stuname,$getpropath);
	my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
	# fix filename
my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);	my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/);
my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,	my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain,
$newflg.'_'.$part_resp.'_returndoc'.$counter,	$newflg.'_'.$part_resp.'_returndoc'.$counter,
Line 3028 sub handback_files {	Line 3226 sub handback_files {
$file_msg.='<span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span> <br />";	$file_msg.='<span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span> <br />";

}	}
$request->print('<br />'.&mt('[_1] will be the uploaded file name [_2]','<span class="LC_info">'.$fname.'</span>','<span class="LC_filename">'.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'</span>'));	$request->print('<br />'.&mt('[_1] will be the uploaded filename [_2]','<span class="LC_info">'.$fname.'</span>','<span class="LC_filename">'.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'</span>'));
}	}
}	}
}	}
Line 3167 sub version_portfiles {	Line 3365 sub version_portfiles {
my ($directory,$answer_file) =($file =~ /^(.?)([^\/])$/);	my ($directory,$answer_file) =($file =~ /^(.?)([^\/])$/);
my ($answer_name,$answer_ver,$answer_ext) =	my ($answer_name,$answer_ver,$answer_ext) =
&file_name_version_ext($answer_file);	&file_name_version_ext($answer_file);
my $getpropath = 1;	my $getpropath = 1;
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath);	my ($dir_list,$listerror) =
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);	&Apache::lonnet::dirlist($portfolio_root.$directory,$domain,
	$stu_name,$getpropath);
	my $version = &get_next_version($answer_name,$answer_ext,$dir_list);
my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);	my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
if ($new_answer ne 'problem getting file') {	if ($new_answer ne 'problem getting file') {
push(@versioned_portfiles, $directory.$new_answer);	push(@versioned_portfiles, $directory.$new_answer);
Line 3188 sub version_portfiles {	Line 3388 sub version_portfiles {
sub get_next_version {	sub get_next_version {
my ($answer_name, $answer_ext, $dir_list) = @_;	my ($answer_name, $answer_ext, $dir_list) = @_;
my $version;	my $version;
foreach my $row (@$dir_list) {	if (ref($dir_list) eq 'ARRAY') {
my ($file) = split(/\&/,$row,2);	foreach my $row (@{$dir_list}) {
my ($file_name,$file_version,$file_ext) =	my ($file) = split(/\&/,$row,2);
&file_name_version_ext($file);	my ($file_name,$file_version,$file_ext) =
if (($file_name eq $answer_name) &&	&file_name_version_ext($file);
($file_ext eq $answer_ext)) {	if (($file_name eq $answer_name) &&
# gets here if filename and extension match, regardless of version	($file_ext eq $answer_ext)) {
	# gets here if filename and extension match,
	# regardless of version
if ($file_version ne '') {	if ($file_version ne '') {
# a versioned file is found so save it for later	# a versioned file is found so save it for later
if ($file_version > $version) {	if ($file_version > $version) {
$version = $file_version;	$version = $file_version;
	}
}	}
}	}
}	}
}	}
$version ++;	$version ++;
return($version);	return($version);
}	}
Line 3662 sub viewstudentgrade {	Line 3865 sub viewstudentgrade {
sub editgrades {	sub editgrades {
my ($request) = @_;	my ($request) = @_;

my $symb=&get_symb($request);	my ($symb)=&get_symb($request);
my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));	my $section_display = join (", ",&Apache::loncommon::get_env_multiple('form.section'));
my $title='<h2>'.&mt('Current Grade Status').'</h2>';	my $title='<h2>'.&mt('Current Grade Status').'</h2>';
$title.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";	$title.='<h4>'.&mt('<b>Current Resource: </b>[_1]',$env{'form.probTitle'}).'</h4>'."\n";
Line 4607 sub displayPage {	Line 4810 sub displayPage {
&Apache::loncommon::start_data_table_row().	&Apache::loncommon::start_data_table_row().
'<td align="center" valign="top" >'.$prob.	'<td align="center" valign="top" >'.$prob.
(scalar(@{$parts}) == 1 ? ''	(scalar(@{$parts}) == 1 ? ''
: '<br />('.&mt('[_1]parts)',	: '<br />('.&mt('[_1]parts',
scalar(@{$parts}).' ')	scalar(@{$parts}).' ').')'
).	).
'</td>';	'</td>';
$studentTable.='<td valign="top">';	$studentTable.='<td valign="top">';
Line 4690 sub displaySubByDates {	Line 4893 sub displaySubByDates {
&Apache::loncommon::start_data_table_header_row().	&Apache::loncommon::start_data_table_header_row().
'<th>'.&mt('Date/Time').'</th>'.	'<th>'.&mt('Date/Time').'</th>'.
($isCODE?'<th>'.&mt('CODE').'</th>':'').	($isCODE?'<th>'.&mt('CODE').'</th>':'').
	($isTask?'<th>'.&mt('Version').'</th>':'').
'<th>'.&mt('Submission').'</th>'.	'<th>'.&mt('Submission').'</th>'.
'<th>'.&mt('Status').'</th>'.	'<th>'.&mt('Status').'</th>'.
&Apache::loncommon::end_data_table_header_row();	&Apache::loncommon::end_data_table_header_row();
Line 4710 sub displaySubByDates {	Line 4914 sub displaySubByDates {
if (exists($$record{$version.':resource.0.version'})) {	if (exists($$record{$version.':resource.0.version'})) {
$interaction = $$record{$version.':resource.0.version'};	$interaction = $$record{$version.':resource.0.version'};
}	}
	if ($isTask && $env{'form.previousversion'}) {
	next unless ($interaction == $env{'form.previousversion'});
	}
my $where = ($isTask ? "$version:resource.$interaction"	my $where = ($isTask ? "$version:resource.$interaction"
: "$version:resource");	: "$version:resource");
$studentTable.=&Apache::loncommon::start_data_table_row().	$studentTable.=&Apache::loncommon::start_data_table_row().
Line 4718 sub displaySubByDates {	Line 4924 sub displaySubByDates {
if ($isCODE) {	if ($isCODE) {
$studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';	$studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
}	}
	if ($isTask) {
	$studentTable.='<td>'.$interaction.'</td>';
	}
my @versionKeys = split(/\:/,$$record{$version.':keys'});	my @versionKeys = split(/\:/,$$record{$version.':keys'});
my @displaySub = ();	my @displaySub = ();
foreach my $partid (@{$parts}) {	foreach my $partid (@{$parts}) {
Line 4737 sub displaySubByDates {	Line 4946 sub displaySubByDates {

my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)	my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
: ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));	: ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
$displaySub[0].='<span class="LC_nobreak"';	$displaySub[0].='<span class="LC_nobreak">';
$displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>'	$displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>'
.' <span class="LC_internal_info">'	.' <span class="LC_internal_info">'
.'('.&mt('Response ID: [_1]',$responseId).')'	.'('.&mt('Response ID: [_1]',$responseId).')'
Line 5099 my %subdivided_bubble_lines; # no.	Line 5308 my %subdivided_bubble_lines; # no.

my %responsetype_per_response; # responsetype for each response	my %responsetype_per_response; # responsetype for each response

	my %masterseq_id_responsenum; # src_id (e.g., 12.3_0.11 etc.) for each
	# numbered response. Needed when randomorder
	# or randompick are in use. Key is ID, value
	# is response number.

# Save and restore the bubble lines array to the form env.	# Save and restore the bubble lines array to the form env.


Line 5112 sub save_bubble_lines {	Line 5326 sub save_bubble_lines {
$env{"form.scantron.responsetype.$line"} =	$env{"form.scantron.responsetype.$line"} =
$responsetype_per_response{$line};	$responsetype_per_response{$line};
}	}
	foreach my $resid (keys(%masterseq_id_responsenum)) {
	my $line = $masterseq_id_responsenum{$resid};
	$env{"form.scantron.residpart.$line"} = $resid;
	}
}	}


sub restore_bubble_lines {	sub restore_bubble_lines {
my $line = 0;	my $line = 0;
%bubble_lines_per_response = ();	%bubble_lines_per_response = ();
	%masterseq_id_responsenum = ();
while ($env{"form.scantron.bubblelines.$line"}) {	while ($env{"form.scantron.bubblelines.$line"}) {
my $value = $env{"form.scantron.bubblelines.$line"};	my $value = $env{"form.scantron.bubblelines.$line"};
$bubble_lines_per_response{$line} = $value;	$bubble_lines_per_response{$line} = $value;
Line 5127 sub restore_bubble_lines {	Line 5346 sub restore_bubble_lines {
$env{"form.scantron.sub_bubblelines.$line"};	$env{"form.scantron.sub_bubblelines.$line"};
$responsetype_per_response{$line} =	$responsetype_per_response{$line} =
$env{"form.scantron.responsetype.$line"};	$env{"form.scantron.responsetype.$line"};
	my $id = $env{"form.scantron.residpart.$line"};
	$masterseq_id_responsenum{$id} = $line;
$line++;	$line++;
}	}
}	}

# Given the parsed scanline, get the response for
# 'answer' number n:

sub get_response_bubbles {
my ($parsed_line, $response) = @_;

my $bubble_line = $first_bubble_line{$response-1} +1;
my $bubble_lines= $bubble_lines_per_response{$response-1};

my $selected = "";

for (my $bline = 0; $bline < $bubble_lines; $bline++) {
$selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":";
$bubble_line++;
}
return $selected;
}

=pod	=pod

=item scantron_filenames	=item scantron_filenames
Line 5161 sub scantron_filenames {	Line 5364 sub scantron_filenames {
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};	my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};	my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $getpropath = 1;	my $getpropath = 1;
my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname,	my ($dirlist,$listerror) = &Apache::lonnet::dirlist('userfiles',$cdom,
$getpropath);	$cname,$getpropath);
my @possiblenames;	my @possiblenames;
foreach my $filename (sort(@files)) {	if (ref($dirlist) eq 'ARRAY') {
($filename)=split(/&/,$filename);	foreach my $filename (sort(@{$dirlist})) {
if ($filename!~/^scantron_orig_/) { next ; }	($filename)=split(/&/,$filename);
$filename=~s/^scantron_orig_//;	if ($filename!~/^scantron_orig_/) { next ; }
push(@possiblenames,$filename);	$filename=~s/^scantron_orig_//;
	push(@possiblenames,$filename);
	}
}	}
return @possiblenames;	return @possiblenames;
}	}
Line 5810 sub digits_to_letters {	Line 6015 sub digits_to_letters {
(see scantron_getfile for more information)	(see scantron_getfile for more information)
just_header - True if should not process question answers but only	just_header - True if should not process question answers but only
the stuff to the left of the answers.	the stuff to the left of the answers.
	randomorder - True if randomorder in use
	randompick - True if randompick in use
	sequence - Exam folder URL
	master_seq - Ref to array containing symbs in exam folder
	symb_to_resource - Ref to hash of symbs for resources in exam folder
	(corresponding values are resource objects)
	partids_by_symb - Ref to hash of symb -> array ref of partIDs
	orderedforcode - Ref to hash of arrays. keys are CODEs and values
	are refs to an array of resource objects, ordered
	according to order used for CODE, when randomorder
	and or randompick are in use.
	respnumlookup - Ref to hash mapping question numbers in bubble lines
	for current line to question number used for same question
	in "Master Sequence" (as seen by Course Coordinator).
	startline - Ref to hash where key is question number (0 is first)
	and value is number of first bubble line for current
	student or code-based randompick and/or randomorder.
	totalref - Ref of scalar used to score total number of bubble
	lines needed for responses in a scan line (used when
	randompick in use.

Returns:	Returns:
Hash containing the result of parsing the scanline	Hash containing the result of parsing the scanline

Line 5854 sub digits_to_letters {	Line 6080 sub digits_to_letters {
=cut	=cut

sub scantron_parse_scanline {	sub scantron_parse_scanline {
my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;	my ($line,$whichline,$scantron_config,$scan_data,$just_header,$idmap,
	$randomorder,$randompick,$sequence,$master_seq,$symb_to_resource,
	$partids_by_symb,$orderedforcode,$respnumlookup,$startline,$totalref)=@_;

my %record;	my %record;
my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'};	my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # stuff before answers
my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers
my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff
if (!($$scantron_config{'CODElocation'} eq 0 \|\|	if (!($$scantron_config{'CODElocation'} eq 0 \|\|
$$scantron_config{'CODElocation'} eq 'none')) {	$$scantron_config{'CODElocation'} eq 'none')) {
if ($$scantron_config{'CODElocation'} < 0 \|\|	if ($$scantron_config{'CODElocation'} < 0 \|\|
Line 5895 sub scantron_parse_scanline {	Line 6121 sub scantron_parse_scanline {
my $questnum=0;	my $questnum=0;
my $ansnum =1; # Multiple 'answer lines'/question.	my $ansnum =1; # Multiple 'answer lines'/question.

	my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'};
	if ($randompick \|\| $randomorder) {
	my $total = &get_respnum_lookups($sequence,$scan_data,$idmap,$line,\%record,
	$master_seq,$symb_to_resource,
	$partids_by_symb,$orderedforcode,
	$respnumlookup,$startline);
	if ($total) {
	$lastpos = $total*$$scantron_config{'Qlength'};
	}
	if (ref($totalref)) {
	$$totalref = $total;
	}
	}
	my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers
chomp($questions); # Get rid of any trailing \n.	chomp($questions); # Get rid of any trailing \n.
$questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads).	$questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads).
while (length($questions)) {	while (length($questions)) {
my $answers_needed = $bubble_lines_per_response{$questnum};	my $answers_needed;
	if (($randompick \|\| $randomorder) && (ref($respnumlookup) eq 'HASH')) {
	$answers_needed = $bubble_lines_per_response{$respnumlookup->{$questnum}};
	} else {
	$answers_needed = $bubble_lines_per_response{$questnum};
	}
my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed)	my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed)
\|\| 1;	\|\| 1;
$questnum++;	$questnum++;
Line 5907 sub scantron_parse_scanline {	Line 6152 sub scantron_parse_scanline {
$questions = substr($questions,$answer_length);	$questions = substr($questions,$answer_length);
if (length($currentquest) < $answer_length) { next; }	if (length($currentquest) < $answer_length) { next; }

if ($subdivided_bubble_lines{$questnum-1} =~ /,/) {	my $subdivided;
	if (($randompick \|\| $randomorder) && (ref($respnumlookup) eq 'HASH')) {
	$subdivided = $subdivided_bubble_lines{$respnumlookup->{$questnum-1}};
	} else {
	$subdivided = $subdivided_bubble_lines{$questnum-1};
	}
	if ($subdivided =~ /,/) {
my $subquestnum = 1;	my $subquestnum = 1;
my $subquestions = $currentquest;	my $subquestions = $currentquest;
my @subanswers_needed =	my @subanswers_needed = split(/,/,$subdivided);
split(/,/,$subdivided_bubble_lines{$questnum-1});
foreach my $subans (@subanswers_needed) {	foreach my $subans (@subanswers_needed) {
my $subans_length =	my $subans_length =
($$scantron_config{'Qlength'} * $subans) \|\| 1;	($$scantron_config{'Qlength'} * $subans) \|\| 1;
Line 5922 sub scantron_parse_scanline {	Line 6172 sub scantron_parse_scanline {
($$scantron_config{'Qon'} eq 'number')) {	($$scantron_config{'Qon'} eq 'number')) {
$ansnum = &scantron_validator_lettnum($ansnum,	$ansnum = &scantron_validator_lettnum($ansnum,
$questnum,$quest_id,$subans,$currsubquest,$whichline,	$questnum,$quest_id,$subans,$currsubquest,$whichline,
\@alphabet,\%record,$scantron_config,$scan_data);	\@alphabet,\%record,$scantron_config,$scan_data,
	$randomorder,$randompick,$respnumlookup);
} else {	} else {
$ansnum = &scantron_validator_positional($ansnum,	$ansnum = &scantron_validator_positional($ansnum,
$questnum,$quest_id,$subans,$currsubquest,$whichline, \@alphabet,\%record,$scantron_config,$scan_data);	$questnum,$quest_id,$subans,$currsubquest,$whichline,
	\@alphabet,\%record,$scantron_config,$scan_data,
	$randomorder,$randompick,$respnumlookup);
}	}
$subquestnum ++;	$subquestnum ++;
}	}
Line 5934 sub scantron_parse_scanline {	Line 6187 sub scantron_parse_scanline {
($$scantron_config{'Qon'} eq 'number')) {	($$scantron_config{'Qon'} eq 'number')) {
$ansnum = &scantron_validator_lettnum($ansnum,$questnum,	$ansnum = &scantron_validator_lettnum($ansnum,$questnum,
$quest_id,$answers_needed,$currentquest,$whichline,	$quest_id,$answers_needed,$currentquest,$whichline,
\@alphabet,\%record,$scantron_config,$scan_data);	\@alphabet,\%record,$scantron_config,$scan_data,
	$randomorder,$randompick,$respnumlookup);
} else {	} else {
$ansnum = &scantron_validator_positional($ansnum,$questnum,	$ansnum = &scantron_validator_positional($ansnum,$questnum,
$quest_id,$answers_needed,$currentquest,$whichline,	$quest_id,$answers_needed,$currentquest,$whichline,
\@alphabet,\%record,$scantron_config,$scan_data);	\@alphabet,\%record,$scantron_config,$scan_data,
	$randomorder,$randompick,$respnumlookup);
}	}
}	}
}	}
Line 5946 sub scantron_parse_scanline {	Line 6201 sub scantron_parse_scanline {
return \%record;	return \%record;
}	}

	sub get_master_seq {
	my ($resources,$master_seq,$symb_to_resource) = @_;
	return unless ((ref($resources) eq 'ARRAY') && (ref($master_seq) eq 'ARRAY') &&
	(ref($symb_to_resource) eq 'HASH'));
	my $resource_error;
	foreach my $resource (@{$resources}) {
	my $ressymb;
	if (ref($resource)) {
	$ressymb = $resource->symb();
	push(@{$master_seq},$ressymb);
	$symb_to_resource->{$ressymb} = $resource;
	} else {
	$resource_error = 1;
	last;
	}
	}
	return $resource_error;
	}

	sub get_respnum_lookups {
	my ($sequence,$scan_data,$idmap,$line,$record,$master_seq,$symb_to_resource,
	$partids_by_symb,$orderedforcode,$respnumlookup,$startline) = @_;
	return unless ((ref($record) eq 'HASH') && (ref($master_seq) eq 'ARRAY') &&
	(ref($symb_to_resource) eq 'HASH') && (ref($partids_by_symb) eq 'HASH') &&
	(ref($orderedforcode) eq 'HASH') && (ref($respnumlookup) eq 'HASH') &&
	(ref($startline) eq 'HASH'));
	my ($user,$scancode);
	if ((exists($record->{'scantron.CODE'})) &&
	(&Apache::lonnet::validCODE($record->{'scantron.CODE'}))) {
	$scancode = $record->{'scantron.CODE'};
	} else {
	$user = &scantron_find_student($record,$scan_data,$idmap,$line);
	}
	my @mapresources =
	&users_order($user,$scancode,$sequence,$master_seq,$symb_to_resource,
	$orderedforcode);
	my $total = 0;
	my $count = 0;
	foreach my $resource (@mapresources) {
	my $id = $resource->id();
	my $symb = $resource->symb();
	if (ref($partids_by_symb->{$symb}) eq 'ARRAY') {
	foreach my $partid (@{$partids_by_symb->{$symb}}) {
	my $respnum = $masterseq_id_responsenum{$id.'_'.$partid};
	if ($respnum ne '') {
	$respnumlookup->{$count} = $respnum;
	$startline->{$count} = $total;
	$total += $bubble_lines_per_response{$respnum};
	$count ++;
	}
	}
	}
	}
	return $total;
	}

sub scantron_validator_lettnum {	sub scantron_validator_lettnum {
my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,	my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline,
$alphabet,$record,$scantron_config,$scan_data) = @_;	$alphabet,$record,$scantron_config,$scan_data,$randomorder,
	$randompick,$respnumlookup) = @_;

# Qon 'letter' implies for each slot in currquest we have:	# Qon 'letter' implies for each slot in currquest we have:
# ? or * for doubles, a letter in A-Z for a bubble, and	# ? or * for doubles, a letter in A-Z for a bubble, and
Line 5967 sub scantron_validator_lettnum {	Line 6279 sub scantron_validator_lettnum {
$matchon = '\d';	$matchon = '\d';
}	}
my $occurrences = 0;	my $occurrences = 0;
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') \|\|	my $responsenum = $questnum-1;
($responsetype_per_response{$questnum-1} eq 'formularesponse') \|\|	if (($randompick \|\| $randomorder) && (ref($respnumlookup) eq 'HASH')) {
($responsetype_per_response{$questnum-1} eq 'stringresponse') \|\|	$responsenum = $respnumlookup->{$questnum-1}
($responsetype_per_response{$questnum-1} eq 'imageresponse') \|\|	}
($responsetype_per_response{$questnum-1} eq 'reactionresponse') \|\|	if (($responsetype_per_response{$responsenum} eq 'essayresponse') \|\|
($responsetype_per_response{$questnum-1} eq 'organicresponse')) {	($responsetype_per_response{$responsenum} eq 'formularesponse') \|\|
	($responsetype_per_response{$responsenum} eq 'stringresponse') \|\|
	($responsetype_per_response{$responsenum} eq 'imageresponse') \|\|
	($responsetype_per_response{$responsenum} eq 'reactionresponse') \|\|
	($responsetype_per_response{$responsenum} eq 'organicresponse')) {
my @singlelines = split('',$currquest);	my @singlelines = split('',$currquest);
foreach my $entry (@singlelines) {	foreach my $entry (@singlelines) {
$occurrences = &occurence_count($entry,$matchon);	$occurrences = &occurence_count($entry,$matchon);
if ($occurrences > 1) {	if ($occurrences > 1) {
last;	last;
}	}
}	}
} else {	} else {
$occurrences = &occurence_count($currquest,$matchon);	$occurrences = &occurence_count($currquest,$matchon);
}	}
Line 6027 sub scantron_validator_lettnum {	Line 6343 sub scantron_validator_lettnum {

sub scantron_validator_positional {	sub scantron_validator_positional {
my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,	my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,
$whichline,$alphabet,$record,$scantron_config,$scan_data) = @_;	$whichline,$alphabet,$record,$scantron_config,$scan_data,
	$randomorder,$randompick,$respnumlookup) = @_;

# Otherwise there's a positional notation;	# Otherwise there's a positional notation;
# each bubble line requires Qlength items, and there are filled in	# each bubble line requires Qlength items, and there are filled in
Line 6069 sub scantron_validator_positional {	Line 6386 sub scantron_validator_positional {
# record all the bubbles filled in as well as the	# record all the bubbles filled in as well as the
# fact this response consists of multiple bubbles.	# fact this response consists of multiple bubbles.
#	#
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') \|\|	my $responsenum = $questnum-1;
($responsetype_per_response{$questnum-1} eq 'formularesponse') \|\|	if (($randompick \|\| $randomorder) && (ref($respnumlookup) eq 'HASH')) {
($responsetype_per_response{$questnum-1} eq 'stringresponse') \|\|	$responsenum = $respnumlookup->{$questnum-1}
($responsetype_per_response{$questnum-1} eq 'imageresponse') \|\|	}
($responsetype_per_response{$questnum-1} eq 'reactionresponse') \|\|	if (($responsetype_per_response{$responsenum} eq 'essayresponse') \|\|
($responsetype_per_response{$questnum-1} eq 'organicresponse')) {	($responsetype_per_response{$responsenum} eq 'formularesponse') \|\|
	($responsetype_per_response{$responsenum} eq 'stringresponse') \|\|
	($responsetype_per_response{$responsenum} eq 'imageresponse') \|\|
	($responsetype_per_response{$responsenum} eq 'reactionresponse') \|\|
	($responsetype_per_response{$responsenum} eq 'organicresponse')) {
my $doubleerror = 0;	my $doubleerror = 0;
while (($currquest >= $$scantron_config{'Qlength'}) &&	while (($currquest >= $$scantron_config{'Qlength'}) &&
(!$doubleerror)) {	(!$doubleerror)) {
Line 6383 sub scantron_warning_screen {	Line 6704 sub scantron_warning_screen {
'<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.	'<tr><td><b>'.&mt('List of CODES to validate against:').'</b></td><td><tt>'.
$env{'form.scantron_CODElist'}.'</tt></td></tr>';	$env{'form.scantron_CODElist'}.'</tt></td></tr>';
}	}
	my $lastbubblepoints;
	if ($env{'form.scantron_lastbubblepoints'} ne '') {
	$lastbubblepoints =
	'<tr><td><b>'.&mt('Hand-graded items: points from last bubble in row').'</b></td><td><tt>'.
	$env{'form.scantron_lastbubblepoints'}.'</tt></td></tr>';
	}
return ('	return ('
<p>	<p>
<span class="LC_warning">	<span class="LC_warning">
Line 6391 sub scantron_warning_screen {	Line 6718 sub scantron_warning_screen {
<table>	<table>
<tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>	<tr><td><b>'.&mt('Sequence to be Graded:').'</b></td><td>'.$title.'</td></tr>
<tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>	<tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr>
'.$CODElist.'	'.$CODElist.$lastbubblepoints.'
</table>	</table>
<br />	<br />
<p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p>	<p> '.&mt("If this information is correct, please click on '[_1]'.",&mt($button_text)).'</p>
<p> '.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').'</p>	<p> '.&mt("If something is incorrect, please click the 'Grading Menu' button to start over.").'</p>

<br />	<br />
');	');
Line 6431 sub scantron_do_warning {	Line 6758 sub scantron_do_warning {
}	}
} else {	} else {
my $warning=&scantron_warning_screen('Grading: Validate Records');	my $warning=&scantron_warning_screen('Grading: Validate Records');
	my $bubbledbyhand=&hand_bubble_option();
$r->print('	$r->print('
'.$warning.'	'.$warning.$bubbledbyhand.'
<input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />	<input type="submit" name="submit" value="'.&mt('Grading: Validate Records').'" />
<input type="hidden" name="command" value="scantron_validate" />	<input type="hidden" name="command" value="scantron_validate" />
');	');
Line 6474 SCANTRONFORM	Line 6802 SCANTRONFORM
'<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";	'<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n";
$chunk .=	$chunk .=
'<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";	'<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n";
	$chunk .=
	'<input type="hidden" name="scantron.residpart.'.$line.'" value="'.$env{"form.scantron.residpart.$line"}.'" />'."\n";
$result .= $chunk;	$result .= $chunk;
$line++;	$line++;
}	}
return $result;	return $result;
}	}

Line 6529 sub scantron_validate_file {	Line 6859 sub scantron_validate_file {
return '';	return '';
}	}
my $result=&scantron_form_start($max_bubble).$default_form_data;	my $result=&scantron_form_start($max_bubble).$default_form_data;
	if ($env{'form.scantron_lastbubblepoints'} ne '') {
	$result .= '<input type="hidden" name="scantron_lastbubblepoints" value="'.$env{'form.scantron_lastbubblepoints'}.'" />';
	}
$r->print($result);	$r->print($result);

my @validate_phases=( 'sequence',	my @validate_phases=( 'sequence',
Line 6546 sub scantron_validate_file {	Line 6879 sub scantron_validate_file {
while (!$stop && $currentphase < scalar(@validate_phases)) {	while (!$stop && $currentphase < scalar(@validate_phases)) {
$r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />');	$r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />');
$r->rflush();	$r->rflush();

my $which="scantron_validate_".$validate_phases[$currentphase];	my $which="scantron_validate_".$validate_phases[$currentphase];
{	{
no strict 'refs';	no strict 'refs';
Line 6954 sub scantron_validate_sequence {	Line 7288 sub scantron_validate_sequence {
my @resources=	my @resources=
$navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);	$navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
if (@resources) {	if (@resources) {
$r->print("<p>".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>");	$r->print('<p class="LC_warning">'
	.&mt('Some resources in the sequence currently are not set to'
	.' exam mode. Grading these resources currently may not'
	.' work correctly.')
	.'</p>'
	);
return (1,$currentphase);	return (1,$currentphase);
}	}
}	}
Line 7035 sub scantron_validate_ID {	Line 7374 sub scantron_validate_ID {


sub scantron_get_correction {	sub scantron_get_correction {
my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;	my ($r,$i,$scan_record,$scan_config,$line,$error,$arg,
	$randomorder,$randompick,$respnumlookup,$startline)=@_;
#FIXME in the case of a duplicated ID the previous line, probably need	#FIXME in the case of a duplicated ID the previous line, probably 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
Line 7085 sub scantron_get_correction {	Line 7425 sub scantron_get_correction {
$r->print(&Apache::loncommon::selectstudent_link('scantronupload',	$r->print(&Apache::loncommon::selectstudent_link('scantronupload',
'scantron_username','scantron_domain'));	'scantron_username','scantron_domain'));
$r->print(": <input type='text' name='scantron_username' value='' />");	$r->print(": <input type='text' name='scantron_username' value='' />");
$r->print("\n@".	$r->print("\n:\n".
&Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));	&Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain'));

$r->print('</li>');	$r->print('</li>');
Line 7171 ENDSCRIPT	Line 7511 ENDSCRIPT
# The form field scantron_questions is acutally a list of line numbers.	# The form field scantron_questions is acutally a list of line numbers.
# represented by this form so:	# represented by this form so:

my $line_list = &questions_to_line_list($arg);	my $line_list = &questions_to_line_list($arg,$randomorder,$randompick,
	$respnumlookup,$startline);

$r->print('<input type="hidden" name="scantron_questions" value="'.	$r->print('<input type="hidden" name="scantron_questions" value="'.
$line_list.'" />');	$line_list.'" />');
Line 7179 ENDSCRIPT	Line 7520 ENDSCRIPT
$r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");	$r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>");
foreach my $question (@{$arg}) {	foreach my $question (@{$arg}) {
my @linenums = &prompt_for_corrections($r,$question,$scan_config,	my @linenums = &prompt_for_corrections($r,$question,$scan_config,
$scan_record, $error);	$scan_record, $error,
	$randomorder,$randompick,
	$respnumlookup,$startline);
push(@lines_to_correct,@linenums);	push(@lines_to_correct,@linenums);
}	}
$r->print(&verify_bubbles_checked(@lines_to_correct));	$r->print(&verify_bubbles_checked(@lines_to_correct));
Line 7193 ENDSCRIPT	Line 7536 ENDSCRIPT
# a list of question numbers. Therefore:	# a list of question numbers. Therefore:
#	#

my $line_list = &questions_to_line_list($arg);	my $line_list = &questions_to_line_list($arg,$randomorder,$randompick,
	$respnumlookup,$startline);

$r->print('<input type="hidden" name="scantron_questions" value="'.	$r->print('<input type="hidden" name="scantron_questions" value="'.
$line_list.'" />');	$line_list.'" />');
foreach my $question (@{$arg}) {	foreach my $question (@{$arg}) {
my @linenums = &prompt_for_corrections($r,$question,$scan_config,	my @linenums = &prompt_for_corrections($r,$question,$scan_config,
$scan_record, $error);	$scan_record, $error,
	$randomorder,$randompick,
	$respnumlookup,$startline);
push(@lines_to_correct,@linenums);	push(@lines_to_correct,@linenums);
}	}
$r->print(&verify_bubbles_checked(@lines_to_correct));	$r->print(&verify_bubbles_checked(@lines_to_correct));
Line 7252 used to fill in the scantron_questions f	Line 7598 used to fill in the scantron_questions f

Arguments:	Arguments:
questions - Reference to an array of questions.	questions - Reference to an array of questions.
	randomorder - True if randomorder in use.
	randompick - True if randompick in use.
	respnumlookup - Reference to HASH mapping question numbers in bubble lines
	for current line to question number used for same question
	in "Master Seqence" (as seen by Course Coordinator).
	startline - Reference to hash where key is question number (0 is first)
	and key is number of first bubble line for current student
	or code-based randompick and/or randomorder.

=cut	=cut


sub questions_to_line_list {	sub questions_to_line_list {
my ($questions) = @_;	my ($questions,$randomorder,$randompick,$respnumlookup,$startline) = @_;
my @lines;	my @lines;

foreach my $item (@{$questions}) {	foreach my $item (@{$questions}) {
Line 7266 sub questions_to_line_list {	Line 7620 sub questions_to_line_list {
if ($item =~ /^(\d+)\.(\d+)$/) {	if ($item =~ /^(\d+)\.(\d+)$/) {
$question = $1;	$question = $1;
my $subquestion = $2;	my $subquestion = $2;
$first = $first_bubble_line{$question-1} + 1;	my $responsenum = $question-1;
	if (($randomorder \|\| $randompick) && (ref($respnumlookup) eq 'HASH')) {
	$responsenum = $respnumlookup->{$question-1};
	if (ref($startline) eq 'HASH') {
	$first = $startline->{$question-1} + 1;
	}
	} else {
	$first = $first_bubble_line{$responsenum} + 1;
	}
my @subans = split(/,/,$subdivided_bubble_lines{$question-1});	my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
my $subcount = 1;	my $subcount = 1;
while ($subcount<$subquestion) {	while ($subcount<$subquestion) {
Line 7322 for multi and missing bubble cases).	Line 7684 for multi and missing bubble cases).
=cut	=cut

sub prompt_for_corrections {	sub prompt_for_corrections {
my ($r, $question, $scan_config, $scan_record, $error) = @_;	my ($r, $question, $scan_config, $scan_record, $error, $randomorder,
	$randompick, $respnumlookup, $startline) = @_;
my ($current_line,$lines);	my ($current_line,$lines);
my @linenums;	my @linenums;
my $questionnum = $question;	my $questionnum = $question;
	my ($first,$responsenum);
if ($question =~ /^(\d+)\.(\d+)$/) {	if ($question =~ /^(\d+)\.(\d+)$/) {
$question = $1;	$question = $1;
$current_line = $first_bubble_line{$question-1} + 1 ;
my $subquestion = $2;	my $subquestion = $2;
my @subans = split(/,/,$subdivided_bubble_lines{$question-1});	if (($randomorder \|\| $randompick) && (ref($respnumlookup) eq 'HASH')) {
	$responsenum = $respnumlookup->{$question-1};
	if (ref($startline) eq 'HASH') {
	$first = $startline->{$question-1};
	}
	} else {
	$responsenum = $question-1;
	$first = $first_bubble_line{$responsenum} + 1;
	}
	$current_line = $first + 1 ;
	my @subans = split(/,/,$subdivided_bubble_lines{$responsenum});
my $subcount = 1;	my $subcount = 1;
while ($subcount<$subquestion) {	while ($subcount<$subquestion) {
$current_line += $subans[$subcount-1];	$current_line += $subans[$subcount-1];
Line 7338 sub prompt_for_corrections {	Line 7711 sub prompt_for_corrections {
}	}
$lines = $subans[$subquestion-1];	$lines = $subans[$subquestion-1];
} else {	} else {
$current_line = $first_bubble_line{$question-1} + 1 ;	if (($randomorder \|\| $randompick) && (ref($respnumlookup) eq 'HASH')) {
$lines = $bubble_lines_per_response{$question-1};	$responsenum = $respnumlookup->{$question-1};
	if (ref($startline) eq 'HASH') {
	$first = $startline->{$question-1};
	}
	} else {
	$responsenum = $question-1;
	$first = $first_bubble_line{$responsenum};
	}
	$current_line = $first + 1;
	$lines = $bubble_lines_per_response{$responsenum};
}	}
if ($lines > 1) {	if ($lines > 1) {
$r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');	$r->print(&mt('The group of bubble lines below responds to a single question.').'<br />');
if (($responsetype_per_response{$question-1} eq 'essayresponse') \|\|	if (($responsetype_per_response{$responsenum} eq 'essayresponse') \|\|
($responsetype_per_response{$question-1} eq 'formularesponse') \|\|	($responsetype_per_response{$responsenum} eq 'formularesponse') \|\|
($responsetype_per_response{$question-1} eq 'stringresponse') \|\|	($responsetype_per_response{$responsenum} eq 'stringresponse') \|\|
($responsetype_per_response{$question-1} eq 'imageresponse') \|\|	($responsetype_per_response{$responsenum} eq 'imageresponse') \|\|
($responsetype_per_response{$question-1} eq 'reactionresponse') \|\|	($responsetype_per_response{$responsenum} eq 'reactionresponse') \|\|
($responsetype_per_response{$question-1} eq 'organicresponse')) {	($responsetype_per_response{$responsenum} eq 'organicresponse')) {
$r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />');	$r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the bubblesheet exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />');
} else {	} else {
$r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");	$r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />");
}	}
}	}
for (my $i =0; $i < $lines; $i++) {	for (my $i =0; $i < $lines; $i++) {
my $selected = $$scan_record{"scantron.$current_line.answer"};	my $selected = $$scan_record{"scantron.$current_line.answer"};
&scantron_bubble_selector($r,$scan_config,$current_line,	&scantron_bubble_selector($r,$scan_config,$current_line,
$questionnum,$error,split('', $selected));	$questionnum,$error,split('', $selected));
push(@linenums,$current_line);	push(@linenums,$current_line);
$current_line++;	$current_line++;
Line 7610 sub scantron_validate_doublebubble {	Line 7992 sub scantron_validate_doublebubble {
#get student info	#get student info
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 (undef,undef,$sequence)=
	&Apache::lonnet::decode_symb($env{'form.selectpage'});

#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,$scan_data)=&scantron_getfile();	my ($scanlines,$scan_data)=&scantron_getfile();

	my $navmap = Apache::lonnavmaps::navmap->new();
	unless (ref($navmap)) {
	$r->print(&navmap_errormsg());
	return(1,$currentphase);
	}
	my $map=$navmap->getResourceByUrl($sequence);
	my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
	my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
	%grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline);
	my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);

my $nav_error;	my $nav_error;
	if (ref($map)) {
	$randomorder = $map->randomorder();
	$randompick = $map->randompick();
	if ($randomorder \|\| $randompick) {
	$nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
	if ($nav_error) {
	$r->print(&navmap_errormsg());
	return(1,$currentphase);
	}
	&graders_resources_pass(\@resources,\%grader_partids_by_symb,
	\%grader_randomlists_by_symb,$bubbles_per_row);
	}
	} else {
	$r->print(&navmap_errormsg());
	return(1,$currentphase);
	}

&scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array.	&scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array.
if ($nav_error) {	if ($nav_error) {
$r->print(&navmap_errormsg());	$r->print(&navmap_errormsg());
Line 7625 sub scantron_validate_doublebubble {	Line 8038 sub scantron_validate_doublebubble {
my $line=&scantron_get_line($scanlines,$scan_data,$i);	my $line=&scantron_get_line($scanlines,$scan_data,$i);
if ($line=~/^[\s\cz]*$/) { next; }	if ($line=~/^[\s\cz]*$/) { next; }
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
$scan_data);	$scan_data,undef,\%idmap,$randomorder,
	$randompick,$sequence,\@master_seq,
	\%symb_to_resource,\%grader_partids_by_symb,
	\%orderedforcode,\%respnumlookup,\%startline);
if (!defined($$scan_record{'scantron.doubleerror'})) { next; }	if (!defined($$scan_record{'scantron.doubleerror'})) { next; }
&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line,
'doublebubble',	'doublebubble',
$$scan_record{'scantron.doubleerror'});	$$scan_record{'scantron.doubleerror'},
	$randomorder,$randompick,\%respnumlookup,\%startline);
return (1,$currentphase);	return (1,$currentphase);
}	}
return (0,$currentphase+1);	return (0,$currentphase+1);
Line 7668 sub scantron_get_maxbubble {	Line 8085 sub scantron_get_maxbubble {
%first_bubble_line = ();	%first_bubble_line = ();
%subdivided_bubble_lines = ();	%subdivided_bubble_lines = ();
%responsetype_per_response = ();	%responsetype_per_response = ();
	%masterseq_id_responsenum = ();

my $response_number = 0;	my $response_number = 0;
my $bubble_line = 0;	my $bubble_line = 0;
foreach my $resource (@resources) {	foreach my $resource (@resources) {
	my $resid = $resource->id();
my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,	my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,
$udom,$bubbles_per_row);	$udom,$bubbles_per_row);
if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {	if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
Line 7722 sub scantron_get_maxbubble {	Line 8141 sub scantron_get_maxbubble {
$bubble_lines_per_response{$response_number} = $lines;	$bubble_lines_per_response{$response_number} = $lines;
$responsetype_per_response{$response_number} =	$responsetype_per_response{$response_number} =
$analysis->{$part_id.'.type'};	$analysis->{$part_id.'.type'};
	$masterseq_id_responsenum{$resid.'_'.$part_id} = $response_number;
$response_number++;	$response_number++;

$bubble_line += $lines;	$bubble_line += $lines;
Line 7754 sub scantron_validate_missingbubbles {	Line 8174 sub scantron_validate_missingbubbles {
#get student info	#get student info
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 (undef,undef,$sequence)=
	&Apache::lonnet::decode_symb($env{'form.selectpage'});

#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,$scan_data)=&scantron_getfile();	my ($scanlines,$scan_data)=&scantron_getfile();

	my $navmap = Apache::lonnavmaps::navmap->new();
	unless (ref($navmap)) {
	$r->print(&navmap_errormsg());
	return(1,$currentphase);
	}

	my $map=$navmap->getResourceByUrl($sequence);
	my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
	my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
	%grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline);
	my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);

my $nav_error;	my $nav_error;
	if (ref($map)) {
	$randomorder = $map->randomorder();
	$randompick = $map->randompick();
	} else {
	$r->print(&navmap_errormsg());
	return '';
	}
	my $nav_error;
	my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
	if ($randomorder \|\| $randompick) {
	$nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
	if ($nav_error) {
	$r->print(&navmap_errormsg());
	return '';
	}
	}
	&graders_resources_pass(\@resources,\%grader_partids_by_symb,
	\%grader_randomlists_by_symb,$bubbles_per_row);

	my ($uname,$udom);

my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);	my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config);
if ($nav_error) {	if ($nav_error) {
	$r->print(&navmap_errormsg());
return(1,$currentphase);	return(1,$currentphase);
}	}

if (!$max_bubble) { $max_bubble=2**31; }	if (!$max_bubble) { $max_bubble=2**31; }
for (my $i=0;$i<=$scanlines->{'count'};$i++) {	for (my $i=0;$i<=$scanlines->{'count'};$i++) {
my $line=&scantron_get_line($scanlines,$scan_data,$i);	my $line=&scantron_get_line($scanlines,$scan_data,$i);
if ($line=~/^[\s\cz]*$/) { next; }	if ($line=~/^[\s\cz]*$/) { next; }
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,	my $scan_record =
$scan_data);	&scantron_parse_scanline($line,$i,\%scantron_config,$scan_data,undef,\%idmap,
	$randomorder,$randompick,$sequence,\@master_seq,
	\%symb_to_resource,\%grader_partids_by_symb,
	\%orderedforcode,\%respnumlookup,\%startline);
if (!defined($$scan_record{'scantron.missingerror'})) { next; }	if (!defined($$scan_record{'scantron.missingerror'})) { next; }
my @to_correct;	my @to_correct;

Line 7777 sub scantron_validate_missingbubbles {	Line 8238 sub scantron_validate_missingbubbles {
foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {	foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
my $lastbubble;	my $lastbubble;
if ($missing =~ /^(\d+)\.(\d+)$/) {	if ($missing =~ /^(\d+)\.(\d+)$/) {
my $question = $1;	my $question = $1;
my $subquestion = $2;	my $subquestion = $2;
if (!defined($first_bubble_line{$question -1})) { next; }	my ($first,$responsenum);
my $first = $first_bubble_line{$question-1};	if ($randomorder \|\| $randompick) {
my @subans = split(/,/,$subdivided_bubble_lines{$question-1});	$responsenum = $respnumlookup{$question-1};
my $subcount = 1;	$first = $startline{$question-1};
while ($subcount<$subquestion) {	} else {
$first += $subans[$subcount-1];	$responsenum = $question-1;
$subcount ++;	$first = $first_bubble_line{$responsenum};
}	}
my $count = $subans[$subquestion-1];	if (!defined($first)) { next; }
$lastbubble = $first + $count;	my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
	my $subcount = 1;
	while ($subcount<$subquestion) {
	$first += $subans[$subcount-1];
	$subcount ++;
	}
	my $count = $subans[$subquestion-1];
	$lastbubble = $first + $count;
} else {	} else {
if (!defined($first_bubble_line{$missing - 1})) { next; }	my ($first,$responsenum);
$lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};	if ($randomorder \|\| $randompick) {
	$responsenum = $respnumlookup{$missing-1};
	$first = $startline{$missing-1};
	} else {
	$responsenum = $missing-1;
	$first = $first_bubble_line{$responsenum};
	}
	if (!defined($first)) { next; }
	$lastbubble = $first + $bubble_lines_per_response{$responsenum};
}	}
if ($lastbubble > $max_bubble) { next; }	if ($lastbubble > $max_bubble) { next; }
push(@to_correct,$missing);	push(@to_correct,$missing);
}	}
if (@to_correct) {	if (@to_correct) {
&scantron_get_correction($r,$i,$scan_record,\%scantron_config,	&scantron_get_correction($r,$i,$scan_record,\%scantron_config,
$line,'missingbubble',\@to_correct);	$line,'missingbubble',\@to_correct,
	$randomorder,$randompick,\%respnumlookup,
	\%startline);
return (1,$currentphase);	return (1,$currentphase);
}	}

Line 7806 sub scantron_validate_missingbubbles {	Line 8284 sub scantron_validate_missingbubbles {
return (0,$currentphase+1);	return (0,$currentphase+1);
}	}

	sub hand_bubble_option {
	my (undef, undef, $sequence) =
	&Apache::lonnet::decode_symb($env{'form.selectpage'});
	return if ($sequence eq '');
	my $navmap = Apache::lonnavmaps::navmap->new();
	unless (ref($navmap)) {
	return;
	}
	my $needs_hand_bubbles;
	my $map=$navmap->getResourceByUrl($sequence);
	my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
	foreach my $res (@resources) {
	if (ref($res)) {
	if ($res->is_problem()) {
	my $partlist = $res->parts();
	foreach my $part (@{ $partlist }) {
	my @types = $res->responseType($part);
	if (grep(/^(chem\|essay\|image\|formula\|math\|string\|functionplot)$/,@types)) {
	$needs_hand_bubbles = 1;
	last;
	}
	}
	}
	}
	}
	if ($needs_hand_bubbles) {
	my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
	my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
	return &mt('The sequence to be graded contains response types which are handgraded.').'<p>'.
	&mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?','<br />').
	'<label><input type="radio" name="scantron_lastbubblepoints" value="'.$bubbles_per_row.'" checked="checked" />'.&mt('[quant,_1,point]',$bubbles_per_row).'</label> '.&mt('or').' '.
	'<label><input type="radio" name="scantron_lastbubblepoints" value="0"/>0 points</label></p>';
	}
	return;
	}

sub scantron_process_students {	sub scantron_process_students {
my ($r) = @_;	my ($r) = @_;
Line 7818 sub scantron_process_students {	Line 8331 sub scantron_process_students {
my $default_form_data=&defaultFormData($symb);	my $default_form_data=&defaultFormData($symb);

my %scantron_config=&get_scantron_config($env{'form.scantron_format'});	my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
	my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
my ($scanlines,$scan_data)=&scantron_getfile();	my ($scanlines,$scan_data)=&scantron_getfile();
my $classlist=&Apache::loncoursedata::get_classlist();	my $classlist=&Apache::loncoursedata::get_classlist();
my %idmap=&username_to_idmap($classlist);	my %idmap=&username_to_idmap($classlist);
Line 7825 sub scantron_process_students {	Line 8339 sub scantron_process_students {
unless (ref($navmap)) {	unless (ref($navmap)) {
$r->print(&navmap_errormsg());	$r->print(&navmap_errormsg());
return '';	return '';
}
my $map=$navmap->getResourceByUrl($sequence);
my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
my (%grader_partids_by_symb,%grader_randomlists_by_symb);
&graders_resources_pass(\@resources,\%grader_partids_by_symb,
\%grader_randomlists_by_symb);
my $resource_error;
foreach my $resource (@resources) {
my $ressymb;
if (ref($resource)) {
$ressymb = $resource->symb();
} else {
$resource_error = 1;
last;
}
my ($analysis,$parts) =
&scantron_partids_tograde($resource,$env{'request.course.id'},
$env{'user.name'},$env{'user.domain'},
1,$bubbles_per_row);
$grader_partids_by_symb{$ressymb} = $parts;
if (ref($analysis) eq 'HASH') {
if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') {
$grader_randomlists_by_symb{$ressymb} =
$analysis->{'parts_withrandomlist'};
}
}
}	}
if ($resource_error) {	my $map=$navmap->getResourceByUrl($sequence);
	my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
	%grader_randomlists_by_symb);
	if (ref($map)) {
	$randomorder = $map->randomorder();
	$randompick = $map->randompick();
	} else {
$r->print(&navmap_errormsg());	$r->print(&navmap_errormsg());
return '';	return '';
}	}
	my $nav_error;
	my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
	my (%grader_partids_by_symb,%grader_randomlists_by_symb,%ordered);
	if ($randomorder \|\| $randompick) {
	$nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
	if ($nav_error) {
	$r->print(&navmap_errormsg());
	return '';
	}
	}
	&graders_resources_pass(\@resources,\%grader_partids_by_symb,
	\%grader_randomlists_by_symb,$bubbles_per_row);

my ($uname,$udom);	my ($uname,$udom);
my $result= <<SCANTRONFORM;	my $result= <<SCANTRONFORM;
Line 7870 SCANTRONFORM	Line 8376 SCANTRONFORM

my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));	my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam'));
my $count=&get_todo_count($scanlines,$scan_data);	my $count=&get_todo_count($scanlines,$scan_data);
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet Status',	my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
'Bubblesheet Progress',$count,
'inline',undef,'scantronupload');
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,	&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
'Processing first student');	'Processing first student');
$r->print('<br />');	$r->print('<br />');
Line 7880 SCANTRONFORM	Line 8384 SCANTRONFORM
my $i=-1;	my $i=-1;
my $started;	my $started;

my $nav_error;
&scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.	&scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.
if ($nav_error) {	if ($nav_error) {
$r->print(&navmap_errormsg());	$r->print(&navmap_errormsg());
Line 7900 SCANTRONFORM	Line 8403 SCANTRONFORM

my %lettdig = &letter_to_digits();	my %lettdig = &letter_to_digits();
my $numletts = scalar(keys(%lettdig));	my $numletts = scalar(keys(%lettdig));
	my %orderedforcode;

while ($i<$scanlines->{'count'}) {	while ($i<$scanlines->{'count'}) {
($uname,$udom)=('','');	($uname,$udom)=('','');
Line 7911 SCANTRONFORM	Line 8415 SCANTRONFORM
'last student');	'last student');
}	}
$started=1;	$started=1;
	my %respnumlookup = ();
	my %startline = ();
	my $total;
my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,	my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config,
$scan_data);	$scan_data,undef,\%idmap,$randomorder,
	$randompick,$sequence,\@master_seq,
	\%symb_to_resource,\%grader_partids_by_symb,
	\%orderedforcode,\%respnumlookup,\%startline,
	\$total);
unless ($uname=&scantron_find_student($scan_record,$scan_data,	unless ($uname=&scantron_find_student($scan_record,$scan_data,
\%idmap,$i)) {	\%idmap,$i)) {
&scantron_add_delay(\@delayqueue,$line,	&scantron_add_delay(\@delayqueue,$line,
Line 7924 SCANTRONFORM	Line 8435 SCANTRONFORM
'Student '.$uname.' has multiple sheets',2);	'Student '.$uname.' has multiple sheets',2);
next;	next;
}	}
	my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
	my $user = $uname.':'.$usec;
($uname,$udom)=split(/:/,$uname);	($uname,$udom)=split(/:/,$uname);

	my $scancode;
	if ((exists($scan_record->{'scantron.CODE'})) &&
	(&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
	$scancode = $scan_record->{'scantron.CODE'};
	} else {
	$scancode = '';
	}

	my @mapresources = @resources;
	if ($randomorder \|\| $randompick) {
	@mapresources =
	&users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource,
	\%orderedforcode);
	}
my (%partids_by_symb,$res_error);	my (%partids_by_symb,$res_error);
foreach my $resource (@resources) {	foreach my $resource (@mapresources) {
my $ressymb;	my $ressymb;
if (ref($resource)) {	if (ref($resource)) {
$ressymb = $resource->symb();	$ressymb = $resource->symb();
Line 7959 SCANTRONFORM	Line 8486 SCANTRONFORM
&scantron_putfile($scanlines,$scan_data);	&scantron_putfile($scanlines,$scan_data);
}	}

my $scancode;
if ((exists($scan_record->{'scantron.CODE'})) &&
(&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
$scancode = $scan_record->{'scantron.CODE'};
} else {
$scancode = '';
}

if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,	if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
\@resources,\%partids_by_symb,	\@mapresources,\%partids_by_symb,
$bubbles_per_row) eq 'ssi_error') {	$bubbles_per_row,$randomorder,$randompick,
	\%respnumlookup,\%startline)
	eq 'ssi_error') {
$ssi_error = 0; # So end of handler error message does not trigger.	$ssi_error = 0; # So end of handler error message does not trigger.
$r->print("</form>");	$r->print("</form>");
&ssi_print_error($r);	&ssi_print_error($r);
Line 7978 SCANTRONFORM	Line 8499 SCANTRONFORM
return ''; # Why return ''? Beats me.	return ''; # Why return ''? Beats me.
}	}

	if (($scancode) && ($randomorder \|\| $randompick)) {
	my $parmresult =
	&Apache::lonparmset::storeparm_by_symb($symb,
	'0_examcode',2,$scancode,
	'string_examcode',$uname,
	$udom);
	}
$completedstudents{$uname}={'line'=>$line};	$completedstudents{$uname}={'line'=>$line};
if ($env{'form.verifyrecord'}) {	if ($env{'form.verifyrecord'}) {
my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};	my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
	if ($randompick) {
	if ($total) {
	$lastpos = $total*$scantron_config{'Qlength'};
	}
	}

my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);	my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
chomp($studentdata);	chomp($studentdata);
$studentdata =~ s/\r$//;	$studentdata =~ s/\r$//;
my $studentrecord = '';	my $studentrecord = '';
my $counter = -1;	my $counter = -1;
foreach my $resource (@resources) {	foreach my $resource (@mapresources) {
my $ressymb = $resource->symb();	my $ressymb = $resource->symb();
($counter,my $recording) =	($counter,my $recording) =
&verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},	&verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
$counter,$studentdata,$partids_by_symb{$ressymb},	$counter,$studentdata,$partids_by_symb{$ressymb},
\%scantron_config,\%lettdig,$numletts);	\%scantron_config,\%lettdig,$numletts,$randomorder,
	$randompick,\%respnumlookup,\%startline);
$studentrecord .= $recording;	$studentrecord .= $recording;
}	}
if ($studentrecord ne $studentdata) {	if ($studentrecord ne $studentdata) {
&Apache::lonxml::clear_problem_counter();	&Apache::lonxml::clear_problem_counter();
if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,	if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode,
\@resources,\%partids_by_symb,	\@mapresources,\%partids_by_symb,
$bubbles_per_row) eq 'ssi_error') {	$bubbles_per_row,$randomorder,$randompick,
	\%respnumlookup,\%startline)
	eq 'ssi_error') {
$ssi_error = 0; # So end of handler error message does not trigger.	$ssi_error = 0; # So end of handler error message does not trigger.
$r->print("</form>");	$r->print("</form>");
&ssi_print_error($r);	&ssi_print_error($r);
Line 8009 SCANTRONFORM	Line 8546 SCANTRONFORM
}	}
$counter = -1;	$counter = -1;
$studentrecord = '';	$studentrecord = '';
foreach my $resource (@resources) {	foreach my $resource (@mapresources) {
my $ressymb = $resource->symb();	my $ressymb = $resource->symb();
($counter,my $recording) =	($counter,my $recording) =
&verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},	&verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'},
$counter,$studentdata,$partids_by_symb{$ressymb},	$counter,$studentdata,$partids_by_symb{$ressymb},
\%scantron_config,\%lettdig,$numletts);	\%scantron_config,\%lettdig,$numletts,
	$randomorder,$randompick,\%respnumlookup,
	\%startline);
$studentrecord .= $recording;	$studentrecord .= $recording;
}	}
if ($studentrecord ne $studentdata) {	if ($studentrecord ne $studentdata) {
Line 8063 SCANTRONFORM	Line 8602 SCANTRONFORM
}	}

sub graders_resources_pass {	sub graders_resources_pass {
my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_;	my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb,
	$bubbles_per_row) = @_;
if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) &&	if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) &&
(ref($grader_randomlists_by_symb) eq 'HASH')) {	(ref($grader_randomlists_by_symb) eq 'HASH')) {
foreach my $resource (@{$resources}) {	foreach my $resource (@{$resources}) {
Line 8084 sub graders_resources_pass {	Line 8624 sub graders_resources_pass {
return;	return;
}	}

	=pod

	=item users_order

	Returns array of resources in current map, ordered based on either CODE,
	if this is a CODEd exam, or based on student's identity if this is a
	"NAMEd" exam.

	Should be used when randomorder and/or randompick applied when the
	corresponding exam was printed, prior to students completing bubblesheets
	for the version of the exam the student received.

	=cut

	sub users_order {
	my ($user,$scancode,$mapurl,$master_seq,$symb_to_resource,$orderedforcode) = @_;
	my @mapresources;
	unless ((ref($master_seq) eq 'ARRAY') && (ref($symb_to_resource) eq 'HASH')) {
	return @mapresources;
	}
	if ($scancode) {
	if ((ref($orderedforcode) eq 'HASH') && (ref($orderedforcode->{$scancode}) eq 'ARRAY')) {
	@mapresources = @{$orderedforcode->{$scancode}};
	} else {
	$env{'form.CODE'} = $scancode;
	my $actual_seq =
	&Apache::lonprintout::master_seq_to_person_seq($mapurl,
	$master_seq,
	$user,$scancode,1);
	if (ref($actual_seq) eq 'ARRAY') {
	@mapresources = map { $symb_to_resource->{$_}; } @{$actual_seq};
	if (ref($orderedforcode) eq 'HASH') {
	if (@mapresources > 0) {
	$orderedforcode->{$scancode} = \@mapresources;
	}
	}
	}
	delete($env{'form.CODE'});
	}
	} else {
	my $actual_seq =
	&Apache::lonprintout::master_seq_to_person_seq($mapurl,
	$master_seq,
	$user,undef,1);
	if (ref($actual_seq) eq 'ARRAY') {
	@mapresources =
	map { $symb_to_resource->{$_}; } @{$actual_seq};
	}
	}
	return @mapresources;
	}

sub grade_student_bubbles {	sub grade_student_bubbles {
my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_;	my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row,
	$randomorder,$randompick,$respnumlookup,$startline) = @_;
	my $uselookup = 0;
	if (($randomorder \|\| $randompick) && (ref($respnumlookup) eq 'HASH') &&
	(ref($startline) eq 'HASH')) {
	$uselookup = 1;
	}

if (ref($resources) eq 'ARRAY') {	if (ref($resources) eq 'ARRAY') {
my $count = 0;	my $count = 0;
foreach my $resource (@{$resources}) {	foreach my $resource (@{$resources}) {
Line 8101 sub grade_student_bubbles {	Line 8700 sub grade_student_bubbles {
if ($bubbles_per_row ne '') {	if ($bubbles_per_row ne '') {
$form{'bubbles_per_row'} = $bubbles_per_row;	$form{'bubbles_per_row'} = $bubbles_per_row;
}	}
	if ($env{'form.scantron_lastbubblepoints'} ne '') {
	$form{'scantron_lastbubblepoints'} = $env{'form.scantron_lastbubblepoints'};
	}
if (ref($parts) eq 'HASH') {	if (ref($parts) eq 'HASH') {
if (ref($parts->{$ressymb}) eq 'ARRAY') {	if (ref($parts->{$ressymb}) eq 'ARRAY') {
foreach my $part (@{$parts->{$ressymb}}) {	foreach my $part (@{$parts->{$ressymb}}) {
$form{'scantron_questnum_start.'.$part} =	if ($uselookup) {
1+$env{'form.scantron.first_bubble_line.'.$count};	$form{'scantron_questnum_start.'.$part} = $startline->{$count} + 1;
	} else {
	$form{'scantron_questnum_start.'.$part} =
	1+$env{'form.scantron.first_bubble_line.'.$count};
	}
$count++;	$count++;
}	}
}	}
Line 8127 sub scantron_upload_scantron_data {	Line 8733 sub scantron_upload_scantron_data {
'domainid',	'domainid',
'coursename',$dom);	'coursename',$dom);
my $syllabuslink = '<a href="javascript:ToSyllabus();">'.&mt('Syllabus').'</a>'.	my $syllabuslink = '<a href="javascript:ToSyllabus();">'.&mt('Syllabus').'</a>'.
('&nbsp'x2).&mt('(shows course personnel)');	('&nbsp'x2).&mt('(shows course personnel)');
my $default_form_data=&defaultFormData(&get_symb($r,1));	my ($symb) = &get_symb($r,1);
	my $default_form_data=&defaultFormData($symb);
my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.');	my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.');
my $nocourseid_alert = &mt("Please use the 'Select Course' link to open a separate window where you can search for a course to which a file can be uploaded.");	my $nocourseid_alert = &mt("Please use the 'Select Course' link to open a separate window where you can search for a course to which a file can be uploaded.");
$r->print('	$r->print('
Line 8333 sub valid_file {	Line 8940 sub valid_file {

sub scantron_download_scantron_data {	sub scantron_download_scantron_data {
my ($r)=@_;	my ($r)=@_;
my $default_form_data=&defaultFormData(&get_symb($r,1));	my ($symb) = &get_symb($r,1);
	my $default_form_data=&defaultFormData($symb);
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};	my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};	my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $file=$env{'form.scantron_selectfile'};	my $file=$env{'form.scantron_selectfile'};
if (! &valid_file($file)) {	if (! &valid_file($file)) {
$r->print('	$r->print('
<p>	<p>
'.&mt('The requested file name was invalid.').'	'.&mt('The requested filename was invalid.').'
</p>	</p>
');	');
$r->print(&show_grading_menu_form(&get_symb($r,1)));	$r->print(&show_grading_menu_form($symb));
return;	return;
}	}
my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;	my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file;
Line 8366 sub scantron_download_scantron_data {	Line 8974 sub scantron_download_scantron_data {
'<a href="'.$skipped.'">','</a>').'	'<a href="'.$skipped.'">','</a>').'
</p>	</p>
');	');
$r->print(&show_grading_menu_form(&get_symb($r,1)));	$r->print(&show_grading_menu_form($symb));
return '';	return '';
}	}

Line 8384 sub checkscantron_results {	Line 8992 sub checkscantron_results {
my %record;	my %record;
my %scantron_config =	my %scantron_config =
&Apache::grades::get_scantron_config($env{'form.scantron_format'});	&Apache::grades::get_scantron_config($env{'form.scantron_format'});
	my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config);
my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();	my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
my $classlist=&Apache::loncoursedata::get_classlist();	my $classlist=&Apache::loncoursedata::get_classlist();
my %idmap=&Apache::grades::username_to_idmap($classlist);	my %idmap=&Apache::grades::username_to_idmap($classlist);
Line 8393 sub checkscantron_results {	Line 9002 sub checkscantron_results {
return '';	return '';
}	}
my $map=$navmap->getResourceByUrl($sequence);	my $map=$navmap->getResourceByUrl($sequence);
	my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb,
	%grader_randomlists_by_symb,%orderedforcode);
	if (ref($map)) {
	$randomorder=$map->randomorder();
	}
my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);	my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
my (%grader_partids_by_symb,%grader_randomlists_by_symb);	my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource);
&graders_resources_pass(\@resources,\%grader_partids_by_symb, \%grader_randomlists_by_symb);	if ($nav_error) {
	$r->print(&navmap_errormsg());
	return '';
	}
	&graders_resources_pass(\@resources,\%grader_partids_by_symb,
	\%grader_randomlists_by_symb,$bubbles_per_row);
my ($uname,$udom);	my ($uname,$udom);
my (%scandata,%lastname,%bylast);	my (%scandata,%lastname,%bylast);
$r->print('	$r->print('
Line 8405 sub checkscantron_results {	Line 9023 sub checkscantron_results {
my @delayqueue;	my @delayqueue;
my %completedstudents;	my %completedstudents;

my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);	my $count=&get_todo_count($scanlines,$scan_data);
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet/Submissions Comparison Status',	my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count);
'Progress of Bubblesheet Data/Submission Records Comparison',$count,	my ($username,$domain,$started,%ordered);
'inline',undef,'checkscantron');
my ($username,$domain,$started);
my $nav_error;
&scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.	&scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse.
if ($nav_error) {	if ($nav_error) {
$r->print(&navmap_errormsg());	$r->print(&navmap_errormsg());
Line 8435 sub checkscantron_results {	Line 9050 sub checkscantron_results {
my $scan_record=	my $scan_record=
&Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,	&Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
$scan_data);	$scan_data);
unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,	unless ($uname=&scantron_find_student($scan_record,$scan_data,
\%idmap,$i)) {	\%idmap,$i)) {
&Apache::grades::scantron_add_delay(\@delayqueue,$line,	&Apache::grades::scantron_add_delay(\@delayqueue,$line,
'Unable to find a student that matches',1);	'Unable to find a student that matches',1);
next;	next;
Line 8449 sub checkscantron_results {	Line 9064 sub checkscantron_results {
my $pid = $scan_record->{'scantron.ID'};	my $pid = $scan_record->{'scantron.ID'};
$lastname{$pid} = $scan_record->{'scantron.LastName'};	$lastname{$pid} = $scan_record->{'scantron.LastName'};
push(@{$bylast{$lastname{$pid}}},$pid);	push(@{$bylast{$lastname{$pid}}},$pid);
	my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION];
	my $user = $uname.':'.$usec;
	($username,$domain)=split(/:/,$uname);

	my $scancode;
	if ((exists($scan_record->{'scantron.CODE'})) &&
	(&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) {
	$scancode = $scan_record->{'scantron.CODE'};
	} else {
	$scancode = '';
	}

	my @mapresources = @resources;
my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};	my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'};
	my %respnumlookup=();
	my %startline=();
	if ($randomorder \|\| $randompick) {
	@mapresources =
	&users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource,
	\%orderedforcode);
	my $total = &get_respnum_lookups($sequence,$scan_data,\%idmap,$line,
	$scan_record,\@master_seq,\%symb_to_resource,
	\%grader_partids_by_symb,\%orderedforcode,
	\%respnumlookup,\%startline);
	if ($randompick && $total) {
	$lastpos = $total*$scantron_config{'Qlength'};
	}
	}
$scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);	$scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos);
chomp($scandata{$pid});	chomp($scandata{$pid});
$scandata{$pid} =~ s/\r$//;	$scandata{$pid} =~ s/\r$//;
($username,$domain)=split(/:/,$uname);
my $counter = -1;	my $counter = -1;
foreach my $resource (@resources) {	foreach my $resource (@mapresources) {
my $parts;	my $parts;
my $ressymb = $resource->symb();	my $ressymb = $resource->symb();
if ((exists($grader_randomlists_by_symb{$ressymb})) \|\|	if ((exists($grader_randomlists_by_symb{$ressymb})) \|\|
Line 8470 sub checkscantron_results {	Line 9112 sub checkscantron_results {
($counter,my $recording) =	($counter,my $recording) =
&verify_scantron_grading($resource,$domain,$username,$cid,$counter,	&verify_scantron_grading($resource,$domain,$username,$cid,$counter,
$scandata{$pid},$parts,	$scandata{$pid},$parts,
\%scantron_config,\%lettdig,$numletts);	\%scantron_config,\%lettdig,$numletts,
	$randomorder,$randompick,
	\%respnumlookup,\%startline);
$record{$pid} .= $recording;	$record{$pid} .= $recording;
}	}
}	}
Line 8516 sub checkscantron_results {	Line 9160 sub checkscantron_results {
$env{'form.scantron_maxbubble'}).	$env{'form.scantron_maxbubble'}).
'</p>'	'</p>'
);	);
$r->print('<p>'.&mt('Exact matches for <b>[quant,_1,student]</b>.',$passed).'<br />'.&mt('Discrepancies detected for <b>[quant,_1,student]</b>.',$failed).'</p>');	$r->print('<p>'
	.&mt('Exact matches for [_1][quant,_2,student][_3].','<b>',$passed,'</b>')
	.'<br />'
	.&mt('Discrepancies detected for [_1][quant,_2,student][_3].','<b>',$failed,'</b>')
	.'</p>');
if ($passed) {	if ($passed) {
$r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />');	$r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />');
$r->print(&Apache::loncommon::start_data_table()."\n".	$r->print(&Apache::loncommon::start_data_table()."\n".
Line 8542 sub checkscantron_results {	Line 9190 sub checkscantron_results {

sub verify_scantron_grading {	sub verify_scantron_grading {
my ($resource,$domain,$username,$cid,$counter,$scandata,$partids,	my ($resource,$domain,$username,$cid,$counter,$scandata,$partids,
$scantron_config,$lettdig,$numletts) = @_;	$scantron_config,$lettdig,$numletts,$randomorder,$randompick,
	$respnumlookup,$startline) = @_;
my ($record,%expected,%startpos);	my ($record,%expected,%startpos);
return ($counter,$record) if (!ref($resource));	return ($counter,$record) if (!ref($resource));
return ($counter,$record) if (!$resource->is_problem());	return ($counter,$record) if (!$resource->is_problem());
Line 8551 sub verify_scantron_grading {	Line 9200 sub verify_scantron_grading {
foreach my $part_id (@{$partids}) {	foreach my $part_id (@{$partids}) {
$counter ++;	$counter ++;
$expected{$part_id} = 0;	$expected{$part_id} = 0;
if ($env{"form.scantron.sub_bubblelines.$counter"}) {	my $respnum = $counter;
my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});	if ($randomorder \|\| $randompick) {
	$respnum = $respnumlookup->{$counter};
	$startpos{$part_id} = $startline->{$counter} + 1;
	} else {
	$startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
	}
	if ($env{"form.scantron.sub_bubblelines.$respnum"}) {
	my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$respnum"});
foreach my $item (@sub_lines) {	foreach my $item (@sub_lines) {
$expected{$part_id} += $item;	$expected{$part_id} += $item;
}	}
} else {	} else {
$expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};	$expected{$part_id} = $env{"form.scantron.bubblelines.$respnum"};
}	}
$startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
}	}
if ($symb) {	if ($symb) {
my %recorded;	my %recorded;
Line 8655 sub verify_scantron_grading {	Line 9310 sub verify_scantron_grading {
return ($counter,$record);	return ($counter,$record);
}	}

sub letter_to_digits {	sub letter_to_digits {
my %lettdig = (	my %lettdig = (
A => 1,	A => 1,
B => 2,	B => 2,
Line 8702 sub savedState {	Line 9357 sub savedState {
return \%savedState;	return \%savedState;
}	}

	#--- Href with symb and command ---

	sub href_symb_cmd {
	my ($symb,$cmd)=@_;
	return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&command='.$cmd;
	}

sub grading_menu {	sub grading_menu {
my ($request) = @_;	my ($request) = @_;
my ($symb)=&get_symb($request);	my ($symb)=&get_symb($request);
Line 9009 sub init_perm {	Line 9671 sub init_perm {
}	}
}	}

	sub init_old_essays {
	my ($symb,$apath,$adom,$aname) = @_;
	if ($symb ne '') {
	my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname);
	if (keys(%essays) > 0) {
	$old_essays{$symb} = \%essays;
	}
	}
	return;
	}

	sub reset_old_essays {
	undef(%old_essays);
	}

sub gather_clicker_ids {	sub gather_clicker_ids {
my %clicker_ids;	my %clicker_ids;

Line 9110 sub process_clicker {	Line 9787 sub process_clicker {
my $pincorrect=&mt("Percentage points for incorrect solution");	my $pincorrect=&mt("Percentage points for incorrect solution");
my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',	my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
{'iclicker' => 'i>clicker',	{'iclicker' => 'i>clicker',
'interwrite' => 'interwrite PRS'});	'interwrite' => 'interwrite PRS',
	'turning' => 'Turning Technologies'});
$symb = &Apache::lonenc::check_encrypt($symb);	$symb = &Apache::lonenc::check_encrypt($symb);
$result.=<<ENDUPFORM;	$result.=<<ENDUPFORM;
<script type="text/javascript">	<script type="text/javascript">
Line 9283 ENDHEADER	Line 9961 ENDHEADER
if ($env{'form.upfiletype'} eq 'interwrite') {	if ($env{'form.upfiletype'} eq 'interwrite') {
($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);	($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
}	}
	if ($env{'form.upfiletype'} eq 'turning') {
	($errormsg,$number)=&turning_eval(\@questiontitles,\%responses);
	}
$result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.	$result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
'<input type="hidden" name="number" value="'.$number.'" />'.	'<input type="hidden" name="number" value="'.$number.'" />'.
&mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',	&mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
Line 9414 sub interwrite_eval {	Line 10095 sub interwrite_eval {
return ($errormsg,$number);	return ($errormsg,$number);
}	}

	sub turning_eval {
	my ($questiontitles,$responses)=@_;
	my $number=0;
	my $errormsg='';
	foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
	my %components=&Apache::loncommon::record_sep($line);
	my @entries=map {$components{$_}} (sort(keys(%components)));
	if ($#entries>$number) { $number=$#entries; }
	my $id=$entries[0];
	my @idresponses;
	$id=~s/^[\#0]+//;
	unless ($id) { next; }
	for (my $idx=1;$idx<=$#entries;$idx++) {
	$entries[$idx]=~s/\,/\;/g;
	$entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+\;]+//g;
	push(@idresponses,$entries[$idx]);
	}
	$$responses{$id}=join(',',@idresponses);
	}
	for (my $i=1; $i<=$number; $i++) {
	$$questiontitles[$i]=&mt('Question [_1]',$i);
	}
	return ($errormsg,$number);
	}

sub assign_clicker_grades {	sub assign_clicker_grades {
my ($r)=@_;	my ($r)=@_;
my ($symb)=&get_symb($r);	my ($symb)=&get_symb($r);
Line 9555 sub navmap_errormsg {	Line 10261 sub navmap_errormsg {
'</div>';	'</div>';
}	}

	sub startpage {
	my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js) = @_;
	if ($nomenu) {
	$r->print(&Apache::loncommon::start_page("Student's Version",$js,{'only_body' => '1'}));
	} else {
	$r->print(&Apache::loncommon::start_page('Grading',$js,
	{'bread_crumbs' => $crumbs}));
	}
	unless ($nodisplayflag) {
	$r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp));
	}
	}

sub handler {	sub handler {
my $request=$_[0];	my $request=$_[0];
&reset_caches();	&reset_caches();
Line 9576 sub handler {	Line 10295 sub handler {
$ssi_error = 0;	$ssi_error = 0;
my $brcrum = [{href=>"/adm/grades",text=>"Grading"}];	my $brcrum = [{href=>"/adm/grades",text=>"Grading"}];
my $start_page = &Apache::loncommon::start_page('Grading',undef,	my $start_page = &Apache::loncommon::start_page('Grading',undef,
{'bread_crumbs' => $brcrum});	{'bread_crumbs' => $brcrum});
if ($symb eq '' && $command eq '') {	if ($symb eq '' && $command eq '') {
if ($env{'user.adv'}) {	if ($env{'user.adv'}) {
&Apache::loncommon::content_type($request,'text/html');	&Apache::loncommon::content_type($request,'text/html');
Line 9609 sub handler {	Line 10328 sub handler {
&init_perm();	&init_perm();
if (!%perm) {	if (!%perm) {
$request->internal_redirect('/adm/quickgrades');	$request->internal_redirect('/adm/quickgrades');
	return OK;
} else {	} else {
&Apache::loncommon::content_type($request,'text/html');	&Apache::loncommon::content_type($request,'text/html');
$request->send_http_header;	$request->send_http_header;
Line 9629 sub handler {	Line 10349 sub handler {
}	}
&Apache::loncommon::content_type($request,'text/html');	&Apache::loncommon::content_type($request,'text/html');
$request->send_http_header;	$request->send_http_header;
$request->print($start_page);	unless ((($command eq 'submission' \|\| $command eq 'versionsub')) && ($perm{'vgr'})) {
	$request->print($start_page);
	}
if ($command eq 'submission' && $perm{'vgr'}) {	if ($command eq 'submission' && $perm{'vgr'}) {
	my ($stuvcurrent,$stuvdisp,$versionform,$js);
	if (($env{'form.student'} ne '') && ($env{'form.userdom'} ne '')) {
	($stuvcurrent,$stuvdisp,$versionform,$js) =
	&choose_task_version_form($symb,$env{'form.student'},
	$env{'form.userdom'});
	}
	&startpage($request,$symb,[{href=>"", text=>"Student Submissions"}],undef,undef,$stuvcurrent,$stuvdisp,undef,$js);
	if ($versionform) {
	$request->print($versionform);
	}
	$request->print('<br clear="all" />');
($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));	($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
	} elsif ($command eq 'versionsub' && $perm{'vgr'}) {
	my ($stuvcurrent,$stuvdisp,$versionform,$js) =
	&choose_task_version_form($symb,$env{'form.student'},
	$env{'form.userdom'},
	$env{'form.inhibitmenu'});
	&startpage($request,$symb,[{href=>"", text=>"Previous Student Version"}],undef,undef,$stuvcurrent,$stuvdisp,$env{'form.inhibitmenu'},$js);
	if ($versionform) {
	$request->print($versionform);
	}
	$request->print('<br clear="all" />');
	$request->print(&show_previous_task_version($request,$symb));
} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {	} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
&pickStudentPage($request);	&pickStudentPage($request);
} elsif ($command eq 'displayPage' && $perm{'vgr'}) {	} elsif ($command eq 'displayPage' && $perm{'vgr'}) {
Line 9802 ssi_with_retries()	Line 10546 ssi_with_retries()
- missingbubble - array ref of the bubble lines that have missing	- missingbubble - array ref of the bubble lines that have missing
bubble errors	bubble errors

	$randomorder - True if exam folder has randomorder set
	$randompick - True if exam folder has randompick set
	$respnumlookup - Reference to HASH mapping question numbers in bubble lines
	for current line to question number used for same question
	in "Master Seqence" (as seen by Course Coordinator).
	$startline - Reference to hash where key is question number (0 is first)
	and value is number of first bubble line for current student
	or code-based randompick and/or randomorder.


=item scantron_get_maxbubble() :	=item scantron_get_maxbubble() :

Arguments:	Arguments:
Line 9822 ssi_with_retries()	Line 10576 ssi_with_retries()
$env{'form.scantron.bubble_lines.n'},	$env{'form.scantron.bubble_lines.n'},
$env{'form.scantron.first_bubble_line.n'} and	$env{'form.scantron.first_bubble_line.n'} and
$env{"form.scantron.sub_bubblelines.n"}	$env{"form.scantron.sub_bubblelines.n"}
which are the total number of bubble, lines, the number of bubble	which are the total number of bubble lines, the number of bubble
lines for response n and number of the first bubble line for response n,	lines for response n and number of the first bubble line for response n,
and a comma separated list of numbers of bubble lines for sub-questions	and a comma separated list of numbers of bubble lines for sub-questions
(for optionresponse, matchresponse, and rankresponse items), for response n.	(for optionresponse, matchresponse, and rankresponse items), for response n.

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

Removed from v.1.596.2.12.2.1
changed lines
	Added in v.1.596.2.12.2.16