version 1.485, 2007/11/08 01:48:18
|
version 1.514, 2008/03/12 02:46:52
|
Line 47 use LONCAPA;
|
Line 47 use LONCAPA;
|
use POSIX qw(floor); |
use POSIX qw(floor); |
|
|
|
|
my %perm=(); |
|
my %bubble_lines_per_response = (); # no. bubble lines for each response. |
|
# index is "symb.part_id" |
|
|
|
my %first_bubble_line = (); # First bubble line no. for each bubble. |
my %perm=(); |
|
|
# Save and restore the bubble lines array to the form env. |
|
|
|
|
|
sub save_bubble_lines { |
|
foreach my $line (keys(%bubble_lines_per_response)) { |
|
$env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; |
|
$env{"form.scantron.first_bubble_line.$line"} = |
|
$first_bubble_line{$line}; |
|
} |
|
} |
|
|
|
|
|
sub restore_bubble_lines { |
|
my $line = 0; |
|
%bubble_lines_per_response = (); |
|
while ($env{"form.scantron.bubblelines.$line"}) { |
|
my $value = $env{"form.scantron.bubblelines.$line"}; |
|
$bubble_lines_per_response{$line} = $value; |
|
$first_bubble_line{$line} = |
|
$env{"form.scantron.first_bubble_line.$line"}; |
|
$line++; |
|
} |
|
|
|
} |
# These variables are used to recover from ssi errors |
|
|
# Given the parsed scanline, get the response for |
my $ssi_retries = 5; |
# 'answer' number n: |
my $ssi_error; |
|
my $ssi_error_resource; |
|
my $ssi_error_message; |
|
|
sub get_response_bubbles { |
|
my ($parsed_line, $response) = @_; |
|
|
|
|
# Do an ssi with retries: |
|
# While I'd love to factor out this with the vesrion in lonprintout, |
|
# that would either require a data coupling between modules, which I refuse to perpetuate |
|
# (there's quite enough of that already), or would require the invention of another infrastructure |
|
# I'm not quite ready to invent (e.g. an ssi_with_retry object). |
|
# |
|
# At least the logic that drives this has been pulled out into loncommon. |
|
|
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"}.":"; |
# ssi_with_retries - Does the server side include of a resource. |
$bubble_line++; |
# if the ssi call returns an error we'll retry it up to |
|
# the number of times requested by the caller. |
|
# If we still have a proble, no text is appended to the |
|
# output and we set some global variables. |
|
# to indicate to the caller an SSI error occured. |
|
# All of this is supposed to deal with the issues described |
|
# in LonCAPA BZ 5631 see: |
|
# http://bugs.lon-capa.org/show_bug.cgi?id=5631 |
|
# by informing the user that this happened. |
|
# |
|
# Parameters: |
|
# resource - The resource to include. This is passed directly, without |
|
# interpretation to lonnet::ssi. |
|
# form - The form hash parameters that guide the interpretation of the resource |
|
# |
|
# retries - Number of retries allowed before giving up completely. |
|
# Returns: |
|
# On success, returns the rendered resource identified by the resource parameter. |
|
# Side Effects: |
|
# The following global variables can be set: |
|
# ssi_error - If an unrecoverable error occured this becomes true. |
|
# It is up to the caller to initialize this to false |
|
# if desired. |
|
# ssi_last_error_resource - If an unrecoverable error occured, this is the value |
|
# of the resource that could not be rendered by the ssi |
|
# call. |
|
# ssi_last_error - The error string fetched from the ssi response |
|
# in the event of an error. |
|
# |
|
sub ssi_with_retries { |
|
my ($resource, $retries, %form) = @_; |
|
my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form); |
|
if ($response->is_error) { |
|
$ssi_error = 1; |
|
$ssi_error_resource = $resource; |
|
$ssi_error_message = $response->code . " " . $response->message; |
} |
} |
return $selected; |
|
} |
|
|
|
|
|
# ----- These first few routines are general use routines.---- |
|
|
|
# Return the number of occurences of a pattern in a string. |
|
|
|
sub occurence_count { |
return $content; |
my ($string, $pattern) = @_; |
|
|
|
my @matches = ($string =~ /$pattern/g); |
|
|
|
return scalar(@matches); |
|
} |
} |
|
# |
|
# Prodcuces an ssi retry failure error message to the user: |
|
# |
|
|
|
sub ssi_print_error { |
# Take a string known to have digits and convert all the |
my ($r) = @_; |
# digits into letters in the range J,A..I. |
$r->print('<h2>Unrecoverable network error</h2>'); |
|
$r->print('<p>Unable to perform a resource fetch from a server: <br />'); |
sub digits_to_letters { |
$r->print("Resource: $ssi_error_resource <br />"); |
my ($input) = @_; |
$r->print("Error: $ssi_error_message <br /> Try again later."); |
|
$r->print('If errors persist, contact LonCAPA support for assistance</p>'); |
my @alphabet = ('J', 'A'..'I'); |
|
|
|
my @input = split(//, $input); |
|
my $output =''; |
|
for (my $i = 0; $i < scalar(@input); $i++) { |
|
if ($input[$i] =~ /\d/) { |
|
$output .= $alphabet[$input[$i]]; |
|
} else { |
|
$output .= $input[$i]; |
|
} |
|
} |
|
return $output; |
|
} |
} |
|
|
# |
# |
Line 283 sub reset_caches {
|
Line 275 sub reset_caches {
|
|
|
my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); |
my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); |
$url=&Apache::lonnet::clutter($url); |
$url=&Apache::lonnet::clutter($url); |
my $subresult=&Apache::lonnet::ssi($url, |
my $subresult=&ssi_with_retries($url, $ssi_retries, |
('grade_target' => 'analyze'), |
('grade_target' => 'analyze'), |
('grade_domain' => $udom), |
('grade_domain' => $udom), |
('grade_symb' => $symb), |
('grade_symb' => $symb), |
Line 733 sub verifyreceipt {
|
Line 725 sub verifyreceipt {
|
$receipt =~ s/[^\-\d]//g; |
$receipt =~ s/[^\-\d]//g; |
my ($symb) = &get_symb($request); |
my ($symb) = &get_symb($request); |
|
|
my $title.='<h3><span class="LC_info">Verifying Submission Receipt '. |
my $title.= |
$receipt.'</h3></span>'."\n". |
'<h3><span class="LC_info">'. |
'<h4><b>Resource: </b>'.$env{'form.probTitle'}.'</h4><br /><br />'."\n"; |
&mt('Verifying Submission Receipt [_1]',$receipt). |
|
'</span></h3>'."\n". |
|
'<h4>'.&mt('<b>Resource: </b>[_1]',$env{'form.probTitle'}). |
|
'</h4>'."\n"; |
|
|
my ($string,$contents,$matches) = ('','',0); |
my ($string,$contents,$matches) = ('','',0); |
my (undef,undef,$fullname) = &getclasslist('all','0'); |
my (undef,undef,$fullname) = &getclasslist('all','0'); |
Line 745 sub verifyreceipt {
|
Line 740 sub verifyreceipt {
|
$env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } |
$env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } |
my $parts=['0']; |
my $parts=['0']; |
if ($receiptparts) { ($parts)=&response_type($symb); } |
if ($receiptparts) { ($parts)=&response_type($symb); } |
|
|
|
my $header = |
|
&Apache::loncommon::start_data_table(). |
|
&Apache::loncommon::start_data_table_header_row(). |
|
'<th> '.&mt('Fullname').' </th>'."\n". |
|
'<th> '.&mt('Username').' </th>'."\n". |
|
'<th> '.&mt('Domain').' </th>'; |
|
if ($receiptparts) { |
|
$header.='<th> '.&mt('Problem Part').' </th>'; |
|
} |
|
$header.= |
|
&Apache::loncommon::end_data_table_header_row(); |
|
|
foreach (sort |
foreach (sort |
{ |
{ |
if (lc($$fullname{$a}) ne lc($$fullname{$b})) { |
if (lc($$fullname{$a}) ne lc($$fullname{$b})) { |
Line 755 sub verifyreceipt {
|
Line 763 sub verifyreceipt {
|
my ($uname,$udom)=split(/\:/); |
my ($uname,$udom)=split(/\:/); |
foreach my $part (@$parts) { |
foreach my $part (@$parts) { |
if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { |
if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { |
$contents.='<tr bgcolor="#ffffe6"><td> '."\n". |
$contents.= |
|
&Apache::loncommon::start_data_table_row(). |
|
'<td> '."\n". |
'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. |
'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom. |
'\');" target="_self">'.$$fullname{$_}.'</a> </td>'."\n". |
'\');" target="_self">'.$$fullname{$_}.'</a> </td>'."\n". |
'<td> '.$uname.' </td>'. |
'<td> '.$uname.' </td>'. |
Line 763 sub verifyreceipt {
|
Line 773 sub verifyreceipt {
|
if ($receiptparts) { |
if ($receiptparts) { |
$contents.='<td> '.$part.' </td>'; |
$contents.='<td> '.$part.' </td>'; |
} |
} |
$contents.='</tr>'."\n"; |
$contents.= |
|
&Apache::loncommon::end_data_table_row()."\n"; |
|
|
$matches++; |
$matches++; |
} |
} |
} |
} |
} |
} |
if ($matches == 0) { |
if ($matches == 0) { |
$string = $title.'No match found for the above receipt.'; |
$string = $title.&mt('No match found for the above receipt.'); |
} else { |
} else { |
$string = &jscriptNform($symb).$title. |
$string = &jscriptNform($symb).$title. |
'The above receipt matches the following student'. |
'<p>'. |
($matches <= 1 ? '.' : 's.')."\n". |
&mt('The above receipt matches the following [numerate,_1,student].',$matches). |
'<table border="0"><tr><td bgcolor="#777777">'."\n". |
'</p>'. |
'<table border="0"><tr bgcolor="#e6ffff">'."\n". |
$header. |
'<td><b> Fullname </b></td>'."\n". |
$contents. |
'<td><b> Username </b></td>'."\n". |
&Apache::loncommon::end_data_table()."\n"; |
'<td><b> Domain </b></td>'; |
|
if ($receiptparts) { |
|
$string.='<td> Problem Part </td>'; |
|
} |
|
$string.='</tr>'."\n".$contents. |
|
'</table></td></tr></table>'."\n"; |
|
} |
} |
return $string.&show_grading_menu_form($symb); |
return $string.&show_grading_menu_form($symb); |
} |
} |
Line 1828 sub download_all_link {
|
Line 1833 sub download_all_link {
|
join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); |
join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); |
|
|
my $identifier = &Apache::loncommon::get_cgi_id(); |
my $identifier = &Apache::loncommon::get_cgi_id(); |
&Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students, |
&Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, |
'cgi.'.$identifier.'.symb' => $symb, |
'cgi.'.$identifier.'.symb' => $symb, |
'cgi.'.$identifier.'.parts' => $parts,); |
'cgi.'.$identifier.'.parts' => $parts,}); |
$r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'. |
$r->print('<a href="/cgi-bin/multidownload.pl?'.$identifier.'">'. |
&mt('Download All Submitted Documents').'</a>'); |
&mt('Download All Submitted Documents').'</a>'); |
return |
return |
Line 4029 sub csvuploadassign {
|
Line 4034 sub csvuploadassign {
|
$grades{$store_key}=$entries{$fields{$dest}}; |
$grades{$store_key}=$entries{$fields{$dest}}; |
} |
} |
} |
} |
if (! %grades) { push(@skipped,"$username:$domain no data to save"); } |
if (! %grades) { |
$grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; |
push(@skipped,&mt("[_1]: no data to save","$username:$domain")); |
my $result=&Apache::lonnet::cstore(\%grades,$symb, |
} else { |
|
$grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; |
|
my $result=&Apache::lonnet::cstore(\%grades,$symb, |
$env{'request.course.id'}, |
$env{'request.course.id'}, |
$domain,$username); |
$domain,$username); |
if ($result eq 'ok') { |
if ($result eq 'ok') { |
$request->print('.'); |
$request->print('.'); |
} else { |
} else { |
$request->print("<p> |
$request->print("<p><span class=\"LC_error\">". |
<span class=\"LC_error\"> |
&mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", |
Failed to save student $username:$domain. |
"$username:$domain",$result)."</span></p>"); |
Message when trying to save was ($result) |
} |
</span> |
$request->rflush(); |
</p>" ); |
$countdone++; |
} |
} |
$request->rflush(); |
|
$countdone++; |
|
} |
} |
$request->print("<br />Saved $countdone students\n"); |
$request->print('<br /><span class="LC_info">'.&mt("Saved [_1] students",$countdone)."</span>\n"); |
if (@skipped) { |
if (@skipped) { |
$request->print('<p><h4><b>Skipped Students</b></h4></p>'); |
$request->print('<p><span class="LC_warning">'.&mt('Skipped Students').'</span></p>'); |
foreach my $student (@skipped) { $request->print("$student<br />\n"); } |
foreach my $student (@skipped) { $request->print("$student<br />\n"); } |
} |
} |
if (@notallowed) { |
if (@notallowed) { |
$request->print('<p><span class="LC_error">Students Not Allowed to Modify</span></p>'); |
$request->print('<p><span class="LC_error">'.&mt('Students Not Allowed to Modify').'</span></p>'); |
foreach my $student (@notallowed) { $request->print("$student<br />\n"); } |
foreach my $student (@notallowed) { $request->print("$student<br />\n"); } |
} |
} |
$request->print("<br />\n"); |
$request->print("<br />\n"); |
Line 4243 sub displayPage {
|
Line 4248 sub displayPage {
|
my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; |
my $result='<h3><span class="LC_info"> '.$env{'form.title'}.'</span></h3>'; |
$result.='<h3> '.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)). |
$result.='<h3> '.&mt('Student: [_1]',&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom)). |
'</h3>'."\n"; |
'</h3>'."\n"; |
if (&Apache::lonnet::validCODE($env{'form.CODE'})) { |
$env{'form.CODE'} = uc($env{'form.CODE'}); |
|
if (&Apache::lonnet::validCODE(uc($env{'form.CODE'}))) { |
$result.='<h3> '.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n"; |
$result.='<h3> '.&mt('CODE: [_1]',$env{'form.CODE'}).'</h3>'."\n"; |
} else { |
} else { |
delete($env{'form.CODE'}); |
delete($env{'form.CODE'}); |
Line 4744 sub getSequenceDropDown {
|
Line 4750 sub getSequenceDropDown {
|
return $result; |
return $result; |
} |
} |
|
|
|
my %bubble_lines_per_response; # no. bubble lines for each response. |
|
# index is "symb.part_id" |
|
|
|
my %first_bubble_line; # First bubble line no. for each bubble. |
|
|
|
my %subdivided_bubble_lines; # no. bubble lines for optionresponse, |
|
# matchresponse or rankresponse, where |
|
# an individual response can have multiple |
|
# lines |
|
|
|
my %responsetype_per_response; # responsetype for each response |
|
|
|
# Save and restore the bubble lines array to the form env. |
|
|
|
|
|
sub save_bubble_lines { |
|
foreach my $line (keys(%bubble_lines_per_response)) { |
|
$env{"form.scantron.bubblelines.$line"} = $bubble_lines_per_response{$line}; |
|
$env{"form.scantron.first_bubble_line.$line"} = |
|
$first_bubble_line{$line}; |
|
$env{"form.scantron.sub_bubblelines.$line"} = |
|
$subdivided_bubble_lines{$line}; |
|
$env{"form.scantron.responsetype.$line"} = |
|
$responsetype_per_response{$line}; |
|
} |
|
} |
|
|
|
|
|
sub restore_bubble_lines { |
|
my $line = 0; |
|
%bubble_lines_per_response = (); |
|
while ($env{"form.scantron.bubblelines.$line"}) { |
|
my $value = $env{"form.scantron.bubblelines.$line"}; |
|
$bubble_lines_per_response{$line} = $value; |
|
$first_bubble_line{$line} = |
|
$env{"form.scantron.first_bubble_line.$line"}; |
|
$subdivided_bubble_lines{$line} = |
|
$env{"form.scantron.sub_bubblelines.$line"}; |
|
$responsetype_per_response{$line} = |
|
$env{"form.scantron.responsetype.$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 |
|
|
Line 4886 sub scantron_selectphase {
|
Line 4955 sub scantron_selectphase {
|
my $CODE_unique=&scantron_CODEunique(); |
my $CODE_unique=&scantron_CODEunique(); |
my $result; |
my $result; |
|
|
|
$ssi_error = 0; |
|
|
# Chunk of form to prompt for a file to grade and how: |
# Chunk of form to prompt for a file to grade and how: |
|
|
$result.= <<SCANTRONFORM; |
$result.= ' |
<table width="100%" border="0"> |
<br /> |
<tr> |
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process"> |
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantron_process"> |
<input type="hidden" name="command" value="scantron_warning" /> |
<td bgcolor="#777777"> |
'.$default_form_data.' |
<input type="hidden" name="command" value="scantron_warning" /> |
'.&Apache::loncommon::start_data_table('LC_scantron_action').' |
$default_form_data |
'.&Apache::loncommon::start_data_table_header_row().' |
<table width="100%" border="0"> |
<th colspan="2"> |
<tr bgcolor="#e6ffff"> |
'.&mt('Specify file and which Folder/Sequence to grade').' |
<td colspan="2"> |
</th> |
<b>Specify file and which Folder/Sequence to grade</b> |
'.&Apache::loncommon::end_data_table_header_row().' |
</td> |
'.&Apache::loncommon::start_data_table_row().' |
</tr> |
<td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td> |
<tr bgcolor="#ffffe6"> |
'.&Apache::loncommon::end_data_table_row().' |
<td> Sequence to grade: </td><td> $sequence_selector </td> |
'.&Apache::loncommon::start_data_table_row().' |
</tr> |
<td> '.&mt('Filename of scoring office file:').' </td><td> '.$file_selector.' </td> |
<tr bgcolor="#ffffe6"> |
'.&Apache::loncommon::end_data_table_row().' |
<td> Filename of scoring office file: </td><td> $file_selector </td> |
'.&Apache::loncommon::start_data_table_row().' |
</tr> |
<td> '.&mt('Format of data file:').' </td><td> '.$format_selector.' </td> |
<tr bgcolor="#ffffe6"> |
'.&Apache::loncommon::end_data_table_row().' |
<td> Format of data file: </td><td> $format_selector </td> |
'.&Apache::loncommon::start_data_table_row().' |
</tr> |
<td> '.&mt('Saved CODEs to validate against:').' </td><td> '.$CODE_selector.' </td> |
<tr bgcolor="#ffffe6"> |
'.&Apache::loncommon::end_data_table_row().' |
<td> Saved CODEs to validate against: </td><td> $CODE_selector</td> |
'.&Apache::loncommon::start_data_table_row().' |
</tr> |
<td> '.&mt('Each CODE is only to be used once:').'</td><td> '.$CODE_unique.' </td> |
<tr bgcolor="#ffffe6"> |
'.&Apache::loncommon::end_data_table_row().' |
<td> Each CODE is only to be used once:</td><td> $CODE_unique </td> |
'.&Apache::loncommon::start_data_table_row().' |
</tr> |
<td> '.&mt('Options:').' </td> |
<tr bgcolor="#ffffe6"> |
|
<td> Options: </td> |
|
<td> |
<td> |
<label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> Do only previously skipped records</label> <br /> |
<label><input type="checkbox" name="scantron_options_redo" value="redo_skipped"/> '.&mt('Do only previously skipped records').'</label> <br /> |
<label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> Remove all existing corrections</label> <br /> |
<label><input type="checkbox" name="scantron_options_ignore" value="ignore_corrections"/> '.&mt('Remove all existing corrections').'</label> <br /> |
<label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> Skip hidden resources when grading</label> |
<label><input type="checkbox" name="scantron_options_hidden" value="ignore_hidden"/> '.&mt('Skip hidden resources when grading').'</label> |
</td> |
</td> |
</tr> |
'.&Apache::loncommon::end_data_table_row().' |
<tr bgcolor="#ffffe6"> |
'.&Apache::loncommon::start_data_table_row().' |
<td colspan="2"> |
<td colspan="2"> |
<input type="submit" value="Grading: Validate Scantron Records" /> |
<input type="submit" value="'.&mt('Grading: Validate Scantron Records').'" /> |
</td> |
</td> |
</tr> |
'.&Apache::loncommon::end_data_table_row().' |
</table> |
'.&Apache::loncommon::end_data_table().' |
</td> |
</form> |
</form> |
'; |
</tr> |
|
SCANTRONFORM |
|
|
|
$r->print($result); |
$r->print($result); |
|
|
Line 4942 SCANTRONFORM
|
Line 5009 SCANTRONFORM
|
|
|
# Chunk of form to prompt for a scantron file upload. |
# Chunk of form to prompt for a scantron file upload. |
|
|
$r->print(<<SCANTRONFORM); |
$r->print(' |
<tr> |
<br /> |
<td bgcolor="#777777"> |
'.&Apache::loncommon::start_data_table('LC_scantron_action').' |
<table width="100%" border="0"> |
'.&Apache::loncommon::start_data_table_header_row().' |
<tr bgcolor="#e6ffff"> |
<th> |
<td> |
'.&mt('Specify a Scantron data file to upload.').' |
<b>Specify a Scantron data file to upload.</b> |
</th> |
</td> |
'.&Apache::loncommon::end_data_table_header_row().' |
</tr> |
'.&Apache::loncommon::start_data_table_row().' |
<tr bgcolor="#ffffe6"> |
|
<td> |
<td> |
SCANTRONFORM |
'); |
my $default_form_data=&defaultFormData(&get_symb($r,1)); |
my $default_form_data=&defaultFormData(&get_symb($r,1)); |
my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'}; |
my $cnum= $env{'course.'.$env{'request.course.id'}.'.num'}; |
$r->print(<<UPLOAD); |
$r->print(' |
<script type="text/javascript" language="javascript"> |
<script type="text/javascript" language="javascript"> |
function checkUpload(formname) { |
function checkUpload(formname) { |
if (formname.upfile.value == "") { |
if (formname.upfile.value == "") { |
alert("Please use the browse button to select a file from your local directory."); |
alert("'.&mt('Please use the browse button to select a file from your local directory.').'"); |
return false; |
return false; |
} |
} |
formname.submit(); |
formname.submit(); |
} |
} |
</script> |
</script> |
|
|
<form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'> |
<form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> |
$default_form_data |
'.$default_form_data.' |
<input name='courseid' type='hidden' value='$cnum' /> |
<input name="courseid" type="hidden" value="'.$cnum.'" /> |
<input name='domainid' type='hidden' value='$cdom' /> |
<input name="domainid" type="hidden" value="'.$cdom.'" /> |
<input name='command' value='scantronupload_save' type='hidden' /> |
<input name="command" value="scantronupload_save" type="hidden" /> |
File to upload:<input type="file" name="upfile" size="50" /> |
'.&mt('File to upload: [_1]','<input type="file" name="upfile" size="50" />').' |
<br /> |
<br /> |
<input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" /> |
<input type="button" onClick="javascript:checkUpload(this.form);" value="'.&mt('Upload Scantron Data').'" /> |
</form> |
</form> |
UPLOAD |
'); |
|
|
$r->print(<<SCANTRONFORM); |
$r->print(' |
</td> |
</td> |
</tr> |
'.&Apache::loncommon::end_data_table_row().' |
</table> |
'.&Apache::loncommon::end_data_table().' |
</td> |
'); |
</tr> |
|
SCANTRONFORM |
|
} |
} |
|
|
# Chunk of the form that prompts to view a scoring office file, |
# Chunk of the form that prompts to view a scoring office file, |
# corrected file, skipped records in a file. |
# corrected file, skipped records in a file. |
|
|
$r->print(<<SCANTRONFORM); |
$r->print(' |
<tr> |
<br /> |
<form action='/adm/grades' name='scantron_download'> |
<form action="/adm/grades" name="scantron_download"> |
<td bgcolor="#777777"> |
'.$default_form_data.' |
$default_form_data |
<input type="hidden" name="command" value="scantron_download" /> |
<input type="hidden" name="command" value="scantron_download" /> |
'.&Apache::loncommon::start_data_table('LC_scantron_action').' |
<table width="100%" border="0"> |
'.&Apache::loncommon::start_data_table_header_row().' |
<tr bgcolor="#e6ffff"> |
<th> |
<td colspan="2"> |
'.&mt('Download a scoring office file').' |
<b>Download a scoring office file</b> |
</th> |
</td> |
'.&Apache::loncommon::end_data_table_header_row().' |
</tr> |
'.&Apache::loncommon::start_data_table_row().' |
<tr bgcolor="#ffffe6"> |
<td> '.&mt('Filename of scoring office file: [_1]',$file_selector).' |
<td> Filename of scoring office file: </td><td> $file_selector </td> |
<br /> |
</tr> |
<input type="submit" value="'.&mt('Download: Show List of Associated Files').'" /> |
<tr bgcolor="#ffffe6"> |
'.&Apache::loncommon::end_data_table_row().' |
<td colspan="2"> |
'.&Apache::loncommon::end_data_table().' |
<input type="submit" value="Download: Show List of Associated Files" /> |
</form> |
</td> |
<br /> |
</tr> |
'); |
</table> |
|
</td> |
|
</form> |
|
</tr> |
|
SCANTRONFORM |
|
|
|
$r->print('<tr><td bgcolor="#777777">'); |
|
&Apache::lonpickcode::code_list($r,2); |
&Apache::lonpickcode::code_list($r,2); |
$r->print('</td></tr></table>'); |
|
$r->print($grading_menu_button); |
$r->print($grading_menu_button); |
return |
return |
} |
} |
Line 5099 sub get_scantron_config {
|
Line 5156 sub get_scantron_config {
|
$config{'IDstart'}=$config[5]; |
$config{'IDstart'}=$config[5]; |
$config{'IDlength'}=$config[6]; |
$config{'IDlength'}=$config[6]; |
$config{'Qstart'}=$config[7]; |
$config{'Qstart'}=$config[7]; |
$config{'Qlength'}=$config[8]; |
$config{'Qlength'}=$config[8]; |
$config{'Qoff'}=$config[9]; |
$config{'Qoff'}=$config[9]; |
$config{'Qon'}=$config[10]; |
$config{'Qon'}=$config[10]; |
$config{'PaperID'}=$config[11]; |
$config{'PaperID'}=$config[11]; |
Line 5173 sub username_to_idmap {
|
Line 5230 sub username_to_idmap {
|
- 'answer' |
- 'answer' |
'response' - new answer or 'none' if blank |
'response' - new answer or 'none' if blank |
'question' - the bubble line to change |
'question' - the bubble line to change |
|
'questionnum' - the question identifier, |
|
may include subquestion. |
|
|
Returns: |
Returns: |
$line - the modified scanline |
$line - the modified scanline |
Line 5185 sub username_to_idmap {
|
Line 5244 sub username_to_idmap {
|
|
|
sub scantron_fixup_scanline { |
sub scantron_fixup_scanline { |
my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; |
my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; |
|
|
|
|
if ($field eq 'ID') { |
if ($field eq 'ID') { |
if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { |
if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { |
return ($line,1,'New value too large'); |
return ($line,1,'New value too large'); |
Line 5217 sub scantron_fixup_scanline {
|
Line 5274 sub scantron_fixup_scanline {
|
$$scantron_config{'CODElength'})=$args->{'CODE'}; |
$$scantron_config{'CODElength'})=$args->{'CODE'}; |
} |
} |
} elsif ($field eq 'answer') { |
} elsif ($field eq 'answer') { |
&scantron_get_maxbubble(); # Need the bubble counter info. |
my $length=$scantron_config->{'Qlength'}; |
my $length =$scantron_config->{'Qlength'}; |
|
my $off=$scantron_config->{'Qoff'}; |
my $off=$scantron_config->{'Qoff'}; |
my $on=$scantron_config->{'Qon'}; |
my $on=$scantron_config->{'Qon'}; |
my $question_number = $args->{'question'} -1; |
my $answer=${off}x$length; |
my $first_position = $first_bubble_line{$question_number}; |
if ($args->{'response'} eq 'none') { |
my $bubble_count = $bubble_lines_per_response{$question_number}; |
&scan_data($scan_data, |
my $bubbles_per_line= $$scantron_config{'Qlength'}; |
"$whichline.no_bubble.".$args->{'questionnum'},'1'); |
my $answer=${off}x($bubbles_per_line*$bubble_count); |
} else { |
my $final_answer; |
if ($on eq 'letter') { |
if ($$scantron_config{'Qon'} eq 'letter' || |
my @alphabet=('A'..'Z'); |
$$scantron_config{'Qon'} eq 'number') { |
$answer=$alphabet[$args->{'response'}]; |
$bubbles_per_line = 10; |
} elsif ($on eq 'number') { |
} |
$answer=$args->{'response'}+1; |
if (defined $args->{'response'}) { |
if ($answer == 10) { $answer = '0'; } |
|
|
if ($args->{'response'} eq 'none') { |
|
&scan_data($scan_data, |
|
"$whichline.no_bubble.".$args->{'question'},'1'); |
|
} else { |
} else { |
my ($bubble_line, $bubble_number) = split(/:/,$args->{'response'}); |
substr($answer,$args->{'response'},1)=$on; |
if ($on eq 'letter') { |
|
my @alphabet=('A'..'Z'); |
|
$answer=$alphabet[$bubble_number]; |
|
} elsif ($on eq 'number') { |
|
$answer= $bubble_number+1; |
|
if ($answer == 10) { $answer = '0'; } |
|
} else { |
|
substr($answer,$bubble_number+$bubble_line*$bubbles_per_line,1)=$on; |
|
$final_answer = $answer; |
|
} |
|
&scan_data($scan_data, |
|
"$whichline.no_bubble.".$args->{'question'},undef,'1'); |
|
|
|
# Positional notation already has the right final answer length.. |
|
|
|
if (($on eq 'letter') || ($on eq 'number')) { |
|
for (my $l = 0; $l < $bubble_count; $l++) { |
|
if ($l eq $bubble_line) { |
|
$final_answer .= $answer; |
|
} else { |
|
$final_answer .= ' '; |
|
} |
|
} |
|
} |
|
} |
} |
# $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; |
&scan_data($scan_data, |
#substr($line,$where-1,$length)=$answer; |
"$whichline.no_bubble.".$args->{'questionnum'},undef,'1'); |
substr($line, |
|
$scantron_config->{'Qstart'}+$first_position-1, |
|
$bubbles_per_line*$length) = $final_answer; |
|
} |
} |
|
my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; |
|
substr($line,$where-1,$length)=$answer; |
} |
} |
return $line; |
return $line; |
} |
} |
Line 5302 sub scan_data {
|
Line 5329 sub scan_data {
|
return $scan_data->{$filename.'_'.$key}; |
return $scan_data->{$filename.'_'.$key}; |
} |
} |
|
|
|
# ----- These first few routines are general use routines.---- |
|
|
|
# Return the number of occurences of a pattern in a string. |
|
|
|
sub occurence_count { |
|
my ($string, $pattern) = @_; |
|
|
|
my @matches = ($string =~ /$pattern/g); |
|
|
|
return scalar(@matches); |
|
} |
|
|
|
|
|
# Take a string known to have digits and convert all the |
|
# digits into letters in the range J,A..I. |
|
|
|
sub digits_to_letters { |
|
my ($input) = @_; |
|
|
|
my @alphabet = ('J', 'A'..'I'); |
|
|
|
my @input = split(//, $input); |
|
my $output =''; |
|
for (my $i = 0; $i < scalar(@input); $i++) { |
|
if ($input[$i] =~ /\d/) { |
|
$output .= $alphabet[$input[$i]]; |
|
} else { |
|
$output .= $input[$i]; |
|
} |
|
} |
|
return $output; |
|
} |
|
|
=pod |
=pod |
|
|
=item scantron_parse_scanline |
=item scantron_parse_scanline |
Line 5404 sub scantron_parse_scanline {
|
Line 5464 sub scantron_parse_scanline {
|
$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 = $bubble_lines_per_response{$questnum}; |
my $answer_length = $$scantron_config{'Qlength'} * $answers_needed; |
my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed) |
|
|| 1; |
|
$questnum++; |
|
my $quest_id = $questnum; |
$questnum++; |
my $currentquest = substr($questions,0,$answer_length); |
my $currentquest = substr($questions,0,$answer_length); |
$questions = substr($questions,$answer_length); |
$questions = substr($questions,0,$answer_length)=''; |
if (length($currentquest) < $answer_length) { next; } |
if (length($currentquest) < $answer_length) { next; } |
|
|
if ($subdivided_bubble_lines{$questnum-1} =~ /,/) { |
# Qon letter implies for each slot in currentquest we have: |
my $subquestnum = 1; |
# ? or * for doubles a letter in A-Z for a bubble and |
my $subquestions = $currentquest; |
# about anything else (esp. a value of Qoff for missing |
my @subanswers_needed = |
# bubbles. |
split(/,/,$subdivided_bubble_lines{$questnum-1}); |
|
foreach my $subans (@subanswers_needed) { |
|
my $subans_length = |
if ($$scantron_config{'Qon'} eq 'letter') { |
($$scantron_config{'Qlength'} * $subans) || 1; |
|
my $currsubquest = substr($subquestions,0,$subans_length); |
if ($currentquest =~ /\?/ |
$subquestions = substr($subquestions,$subans_length); |
|| $currentquest =~ /\*/ |
$quest_id = "$questnum.$subquestnum"; |
|| (&occurence_count($currentquest, "[A-Z]") > 1)) { |
if (($$scantron_config{'Qon'} eq 'letter') || |
push(@{$record{'scantron.doubleerror'}},$questnum); |
($$scantron_config{'Qon'} eq 'number')) { |
for (my $ans = 0; $ans < $answers_needed; $ans++) { |
$ansnum = &scantron_validator_lettnum($ansnum, |
my $bubble = substr($currentquest, $ans, 1); |
$questnum,$quest_id,$subans,$currsubquest,$whichline, |
if ($bubble =~ /[A-Z]/ ) { |
\@alphabet,\%record,$scantron_config,$scan_data); |
$record{"scantron.$ansnum.answer"} = $bubble; |
} else { |
} else { |
$ansnum = &scantron_validator_positional($ansnum, |
$record{"scantron.$ansnum.answer"}=''; |
$questnum,$quest_id,$subans,$currsubquest,$whichline, \@alphabet,\%record,$scantron_config,$scan_data); |
} |
} |
$ansnum++; |
$subquestnum ++; |
} |
} |
|
} else { |
} elsif (!defined($currentquest) |
if (($$scantron_config{'Qon'} eq 'letter') || |
|| (&occurence_count($currentquest, $$scantron_config{'Qoff'}) == length($currentquest)) |
($$scantron_config{'Qon'} eq 'number')) { |
|| (&occurence_count($currentquest, "[A-Z]") == 0)) { |
$ansnum = &scantron_validator_lettnum($ansnum,$questnum, |
for (my $ans = 0; $ans < $answers_needed; $ans++ ) { |
$quest_id,$answers_needed,$currentquest,$whichline, |
$record{"scantron.$ansnum.answer"}=''; |
\@alphabet,\%record,$scantron_config,$scan_data); |
$ansnum++; |
} else { |
|
$ansnum = &scantron_validator_positional($ansnum,$questnum, |
} |
$quest_id,$answers_needed,$currentquest,$whichline, |
if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { |
\@alphabet,\%record,$scantron_config,$scan_data); |
push(@{$record{"scantron.missingerror"}},$questnum); |
} |
# $ansnum += $answers_needed; |
} |
} |
} |
} else { |
$record{'scantron.maxquest'}=$questnum; |
for (my $ans = 0; $ans < $answers_needed; $ans++) { |
return \%record; |
$record{"scantron.$ansnum.answer"} = substr($currentquest, $ans, 1); |
} |
$ansnum++; |
|
} |
|
} |
|
|
|
# Qon 'number' implies each slot gives a digit that indexes the |
|
# the bubbles filled or Qoff or a non number for unbubbled lines. |
|
# and *? for double bubbles on a line. |
|
# these answers are also stored as letters. |
|
|
|
} elsif ($$scantron_config{'Qon'} eq 'number') { |
|
if ($currentquest =~ /\?/ |
|
|| $currentquest =~ /\*/ |
|
|| (&occurence_count($currentquest, '\d') > 1)) { |
|
push(@{$record{'scantron.doubleerror'}},$questnum); |
|
for (my $ans = 0; $ans < $answers_needed; $ans++) { |
|
my $bubble = substr($currentquest, $ans, 1); |
|
if ($bubble =~ /\d/) { |
|
$record{"scantron.$ansnum.answer"} = $alphabet[$bubble]; |
|
} else { |
|
$record{"scantron.$ansnum.answer"}=' '; |
|
} |
|
$ansnum++; |
|
} |
|
|
|
} elsif (!defined($currentquest) |
|
|| (&occurence_count($currentquest,$$scantron_config{'Qoff'}) == length($currentquest)) |
|
|| (&occurence_count($currentquest, '\d') == 0)) { |
|
for (my $ans = 0; $ans < $answers_needed; $ans++ ) { |
|
$record{"scantron.$ansnum.answer"}=''; |
|
$ansnum++; |
|
|
|
} |
|
if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { |
|
push(@{$record{"scantron.missingerror"}},$questnum); |
|
$ansnum += $answers_needed; |
|
} |
|
|
|
} else { |
sub scantron_validator_lettnum { |
$currentquest = &digits_to_letters($currentquest); |
my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline, |
for (my $ans =0; $ans < $answers_needed; $ans++) { |
$alphabet,$record,$scantron_config,$scan_data) = @_; |
$record{"scantron.$ansnum.answer"} = substr($currentquest, $ans, 1); |
|
$ansnum++; |
# Qon 'letter' implies for each slot in currquest we have: |
} |
# ? or * for doubles, a letter in A-Z for a bubble, and |
} |
# about anything else (esp. a value of Qoff) for missing |
} else { |
# bubbles. |
|
# |
|
# Qon 'number' implies each slot gives a digit that indexes the |
|
# bubbles filled, or Qoff, or a non-number for unbubbled lines, |
|
# and * or ? for double bubbles on a single line. |
|
# |
|
|
# Otherwise there's a positional notation; |
my $matchon; |
# each bubble line requires Qlength items, and there are filled in |
if ($$scantron_config{'Qon'} eq 'letter') { |
# bubbles for each case where there 'Qon' characters. |
$matchon = '[A-Z]'; |
# |
} elsif ($$scantron_config{'Qon'} eq 'number') { |
|
$matchon = '\d'; |
|
} |
|
my $occurrences = 0; |
|
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'formularesponse') || |
|
($responsetype_per_response{$questnum-1} eq 'stringresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'imageresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'reactionresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'organicresponse')) { |
|
my @singlelines = split('',$currquest); |
|
foreach my $entry (@singlelines) { |
|
$occurrences = &occurence_count($entry,$matchon); |
|
if ($occurrences > 1) { |
|
last; |
|
} |
|
} |
|
} else { |
|
$occurrences = &occurence_count($currquest,$matchon); |
|
} |
|
if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) { |
|
push(@{$record->{'scantron.doubleerror'}},$quest_id); |
|
for (my $ans=0; $ans<$answers_needed; $ans++) { |
|
my $bubble = substr($currquest,$ans,1); |
|
if ($bubble =~ /$matchon/ ) { |
|
if ($$scantron_config{'Qon'} eq 'number') { |
|
if ($bubble == 0) { |
|
$bubble = 10; |
|
} |
|
$record->{"scantron.$ansnum.answer"} = |
|
$alphabet->[$bubble-1]; |
|
} else { |
|
$record->{"scantron.$ansnum.answer"} = $bubble; |
|
} |
|
} else { |
|
$record->{"scantron.$ansnum.answer"}=''; |
|
} |
|
$ansnum++; |
|
} |
|
} elsif (!defined($currquest) |
|
|| (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest)) |
|
|| (&occurence_count($currquest,$matchon) == 0)) { |
|
for (my $ans=0; $ans<$answers_needed; $ans++ ) { |
|
$record->{"scantron.$ansnum.answer"}=''; |
|
$ansnum++; |
|
} |
|
if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { |
|
push(@{$record->{'scantron.missingerror'}},$quest_id); |
|
} |
|
} else { |
|
if ($$scantron_config{'Qon'} eq 'number') { |
|
$currquest = &digits_to_letters($currquest); |
|
} |
|
for (my $ans=0; $ans<$answers_needed; $ans++) { |
|
my $bubble = substr($currquest,$ans,1); |
|
$record->{"scantron.$ansnum.answer"} = $bubble; |
|
$ansnum++; |
|
} |
|
} |
|
return $ansnum; |
|
} |
|
|
my @array=split($$scantron_config{'Qon'},$currentquest,-1); |
sub scantron_validator_positional { |
|
my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest, |
|
$whichline,$alphabet,$record,$scantron_config,$scan_data) = @_; |
|
|
# If the split only giveas us one element.. the full length of the |
# Otherwise there's a positional notation; |
# answser string, no bubbles are filled in: |
# each bubble line requires Qlength items, and there are filled in |
|
# bubbles for each case where there 'Qon' characters. |
|
# |
|
|
if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { |
my @array=split($$scantron_config{'Qon'},$currquest,-1); |
for (my $ans = 0; $ans < $answers_needed; $ans++ ) { |
|
$record{"scantron.$ansnum.answer"}=''; |
|
$ansnum++; |
|
|
|
} |
# If the split only gives us one element.. the full length of the |
if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) { |
# answer string, no bubbles are filled in: |
push(@{$record{"scantron.missingerror"}},$questnum); |
|
} |
|
|
|
# If the bubble is not the last position, there will be |
|
# 2 elements. If it is the last position, there will be 1 element. |
|
|
|
} elsif (scalar(@array) le 2) { |
if ($answers_needed eq '') { |
|
return; |
|
} |
|
|
my $location = length($array[0]); |
if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { |
my $line_num = int($location / $$scantron_config{'Qlength'}); |
for (my $ans=0; $ans<$answers_needed; $ans++ ) { |
my $bubble = $alphabet[$location % $$scantron_config{'Qlength'}]; |
$record->{"scantron.$ansnum.answer"}=''; |
|
$ansnum++; |
|
} |
|
if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { |
|
push(@{$record->{"scantron.missingerror"}},$quest_id); |
|
} |
|
} elsif (scalar(@array) == 2) { |
|
my $location = length($array[0]); |
|
my $line_num = int($location / $$scantron_config{'Qlength'}); |
|
my $bubble = $alphabet->[$location % $$scantron_config{'Qlength'}]; |
|
for (my $ans=0; $ans<$answers_needed; $ans++) { |
|
if ($ans eq $line_num) { |
|
$record->{"scantron.$ansnum.answer"} = $bubble; |
|
} else { |
|
$record->{"scantron.$ansnum.answer"} = ' '; |
|
} |
|
$ansnum++; |
|
} |
|
} else { |
|
# If there's more than one instance of a bubble character |
|
# That's a double bubble; with positional notation we can |
|
# record all the bubbles filled in as well as the |
|
# fact this response consists of multiple bubbles. |
|
# |
|
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'formularesponse') || |
|
($responsetype_per_response{$questnum-1} eq 'stringresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'imageresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'reactionresponse') || |
|
($responsetype_per_response{$questnum-1} eq 'organicresponse')) { |
|
my $doubleerror = 0; |
|
while (($currquest >= $$scantron_config{'Qlength'}) && |
|
(!$doubleerror)) { |
|
my $currline = substr($currquest,0,$$scantron_config{'Qlength'}); |
|
$currquest = substr($currquest,$$scantron_config{'Qlength'}); |
|
my @currarray = split($$scantron_config{'Qon'},$currline,-1); |
|
if (length(@currarray) > 2) { |
|
$doubleerror = 1; |
|
} |
|
} |
|
if ($doubleerror) { |
|
push(@{$record->{'scantron.doubleerror'}},$quest_id); |
|
} |
|
} else { |
|
push(@{$record->{'scantron.doubleerror'}},$quest_id); |
|
} |
|
my $item = $ansnum; |
|
for (my $ans=0; $ans<$answers_needed; $ans++) { |
|
$record->{"scantron.$item.answer"} = ''; |
|
$item ++; |
|
} |
|
|
for (my $ans = 0; $ans < $answers_needed; $ans++) { |
my @ans=@array; |
if ($ans eq $line_num) { |
my $i=0; |
$record{"scantron.$ansnum.answer"} = $bubble; |
my $increment = 0; |
} else { |
while ($#ans) { |
$record{"scantron.$ansnum.answer"} = ' '; |
$i+=length($ans[0]) + $increment; |
} |
my $line = int($i/$$scantron_config{'Qlength'} + $ansnum); |
$ansnum++; |
my $bubble = $i%$$scantron_config{'Qlength'}; |
} |
$record->{"scantron.$line.answer"}.=$alphabet->[$bubble]; |
} |
shift(@ans); |
# If there's more than one instance of a bubble character |
$increment = 1; |
# That's a double bubble; with positional notation we can |
} |
# record all the bubbles filled in as well as the |
$ansnum += $answers_needed; |
# fact this response consists of multiple bubbles. |
|
# |
|
else { |
|
push(@{$record{'scantron.doubleerror'}},$questnum); |
|
|
|
my $first_answer = $ansnum; |
|
for (my $ans =0; $ans < $answers_needed; $ans++) { |
|
my $item = $first_answer+$ans; |
|
$record{"scantron.$item.answer"} = ''; |
|
} |
|
|
|
my @ans=@array; |
|
my $i=0; |
|
my $increment = 0; |
|
while ($#ans) { |
|
$i+=length($ans[0]) + $increment; |
|
my $line = int($i/$$scantron_config{'Qlength'} + $first_answer); |
|
my $bubble = $i%$$scantron_config{'Qlength'}; |
|
$record{"scantron.$line.answer"}.=$alphabet[$bubble]; |
|
shift(@ans); |
|
$increment = 1; |
|
} |
|
$ansnum += $answers_needed; |
|
} |
|
} |
|
} |
} |
$record{'scantron.maxquest'}=$questnum; |
return $ansnum; |
return \%record; |
|
} |
} |
|
|
=pod |
=pod |
Line 5705 sub scantron_process_corrections {
|
Line 5815 sub scantron_process_corrections {
|
&scantron_fixup_scanline(\%scantron_config,$scan_data,$line, |
&scantron_fixup_scanline(\%scantron_config,$scan_data,$line, |
$which,'answer', |
$which,'answer', |
{ 'question'=>$question, |
{ 'question'=>$question, |
'response'=>$env{"form.scantron_correct_Q_$question"}}); |
'response'=>$env{"form.scantron_correct_Q_$question"}, |
|
'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}}); |
if ($err) { last; } |
if ($err) { last; } |
} |
} |
} |
} |
Line 5810 sub remember_current_skipped {
|
Line 5921 sub remember_current_skipped {
|
sub check_for_error { |
sub check_for_error { |
my ($r,$result)=@_; |
my ($r,$result)=@_; |
if ($result ne 'ok' && $result ne 'not_found' ) { |
if ($result ne 'ok' && $result ne 'not_found' ) { |
$r->print("An error occurred ($result) when trying to Remove the existing corrections."); |
$r->print(&mt("An error occurred ([_1]) when trying to remove the existing corrections.",$result)); |
} |
} |
} |
} |
|
|
Line 5834 sub scantron_warning_screen {
|
Line 5945 sub scantron_warning_screen {
|
$CODElist=$env{'form.scantron_CODElist'}; |
$CODElist=$env{'form.scantron_CODElist'}; |
if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; } |
if ($env{'form.scantron_CODElist'} eq '') { $CODElist='<span class="LC_warning">None</span>'; } |
$CODElist= |
$CODElist= |
'<tr><td><b>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>'; |
} |
} |
return (<<STUFF); |
return (' |
<p> |
<p> |
<span class="LC_warning">Please double check the information |
<span class="LC_warning"> |
below before clicking on '$button_text'</span> |
'.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).'</span> |
</p> |
</p> |
<table> |
<table> |
<tr><td><b>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>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.' |
</table> |
</table> |
<br /> |
<br /> |
<p> If this information is correct, please click on '$button_text'.</p> |
<p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'</p> |
<p> 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 /> |
STUFF |
'); |
} |
} |
|
|
=pod |
=pod |
Line 5873 sub scantron_do_warning {
|
Line 5984 sub scantron_do_warning {
|
if ( $env{'form.selectpage'} eq '' || |
if ( $env{'form.selectpage'} eq '' || |
$env{'form.scantron_selectfile'} eq '' || |
$env{'form.scantron_selectfile'} eq '' || |
$env{'form.scantron_format'} eq '' ) { |
$env{'form.scantron_format'} eq '' ) { |
$r->print("<p>You have forgetten to specify some information. Please go Back and try again.</p>"); |
$r->print("<p>".&mt('You have forgetten to specify some information. Please go Back and try again.')."</p>"); |
if ( $env{'form.selectpage'} eq '') { |
if ( $env{'form.selectpage'} eq '') { |
$r->print('<p><span class="LC_error">You have not selected a Sequence to grade</span></p>'); |
$r->print('<p><span class="LC_error">'.&mt('You have not selected a Sequence to grade').'</span></p>'); |
} |
} |
if ( $env{'form.scantron_selectfile'} eq '') { |
if ( $env{'form.scantron_selectfile'} eq '') { |
$r->print('<p><span class="LC_error">You have not selected a file that contains the student\'s response data.</span></p>'); |
$r->print('<p><span class="LC_error">'.&mt('You have not selected a file that contains the student\'s response data.').'</span></p>'); |
} |
} |
if ( $env{'form.scantron_format'} eq '') { |
if ( $env{'form.scantron_format'} eq '') { |
$r->print('<p><span class="LC_error">You have not selected a the format of the student\'s response data.</span></p>'); |
$r->print('<p><span class="LC_error">'.&mt('You have not selected a the format of the student\'s response data.').'</span></p>'); |
} |
} |
} else { |
} else { |
my $warning=&scantron_warning_screen('Grading: Validate Records'); |
my $warning=&scantron_warning_screen('Grading: Validate Records'); |
$r->print(<<STUFF); |
$r->print(' |
$warning |
'.$warning.' |
<input type="submit" name="submit" value="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" /> |
STUFF |
'); |
} |
} |
$r->print("</form><br />".&show_grading_menu_form($symb)); |
$r->print("</form><br />".&show_grading_menu_form($symb)); |
return ''; |
return ''; |
Line 5924 SCANTRONFORM
|
Line 6035 SCANTRONFORM
|
'<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n"; |
'<input type="hidden" name="scantron.bubblelines.'.$line.'" value="'.$env{"form.scantron.bubblelines.$line"}.'" />'."\n"; |
$chunk .= |
$chunk .= |
'<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n"; |
'<input type="hidden" name="scantron.first_bubble_line.'.$line.'" value="'.$env{"form.scantron.first_bubble_line.$line"}.'" />'."\n"; |
|
$chunk .= |
|
'<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n"; |
|
$chunk .= |
|
'<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n"; |
$result .= $chunk; |
$result .= $chunk; |
$line++; |
$line++; |
} |
} |
Line 5968 sub scantron_validate_file {
|
Line 6083 sub scantron_validate_file {
|
if ($env{'form.scantron_corrections'}) { |
if ($env{'form.scantron_corrections'}) { |
&scantron_process_corrections($r); |
&scantron_process_corrections($r); |
} |
} |
$r->print("<p>Gathering necessary info.</p>");$r->rflush(); |
$r->print('<p>'.&mt('Gathering necessary information.').'</p>');$r->rflush(); |
#get the student pick code ready |
#get the student pick code ready |
$r->print(&Apache::loncommon::studentbrowser_javascript()); |
$r->print(&Apache::loncommon::studentbrowser_javascript()); |
my $max_bubble=&scantron_get_maxbubble(); |
my $max_bubble=&scantron_get_maxbubble(); |
Line 5988 sub scantron_validate_file {
|
Line 6103 sub scantron_validate_file {
|
|
|
my $stop=0; |
my $stop=0; |
while (!$stop && $currentphase < scalar(@validate_phases)) { |
while (!$stop && $currentphase < scalar(@validate_phases)) { |
$r->print("<p> Validating ".$validate_phases[$currentphase]."</p>"); |
$r->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]; |
{ |
{ |
Line 5998 sub scantron_validate_file {
|
Line 6113 sub scantron_validate_file {
|
} |
} |
if (!$stop) { |
if (!$stop) { |
my $warning=&scantron_warning_screen('Start Grading'); |
my $warning=&scantron_warning_screen('Start Grading'); |
$r->print(<<STUFF); |
$r->print(&mt('Validation process complete.').'<br /> |
Validation process complete.<br /> |
'.$warning.' |
$warning |
<input type="submit" name="submit" value="'.&mt('Start Grading').'" /> |
<input type="submit" name="submit" value="Start Grading" /> |
|
<input type="hidden" name="command" value="scantron_process" /> |
<input type="hidden" name="command" value="scantron_process" /> |
STUFF |
'); |
|
|
} else { |
} else { |
$r->print('<input type="hidden" name="command" value="scantron_validate" />'); |
$r->print('<input type="hidden" name="command" value="scantron_validate" />'); |
Line 6011 STUFF
|
Line 6125 STUFF
|
} |
} |
if ($stop) { |
if ($stop) { |
if ($validate_phases[$currentphase] eq 'sequence') { |
if ($validate_phases[$currentphase] eq 'sequence') { |
$r->print('<input type="submit" name="submit" value="Ignore -> " />'); |
$r->print('<input type="submit" name="submit" value="'.&mt('Ignore ->').' " />'); |
$r->print(' this error <br />'); |
$r->print(' '.&mt('this error').' <br />'); |
|
|
$r->print(" <p>Or click the 'Grading Menu' button to start over.</p>"); |
$r->print(" <p>".&mt("Or click the 'Grading Menu' button to start over.")."</p>"); |
} else { |
} else { |
$r->print('<input type="submit" name="submit" value="Continue ->" />'); |
if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { |
$r->print(' using corrected info <br />'); |
$r->print('<input type="button" name="submitbutton" value="'.&mt('Continue ->').'" onclick="javascript:verify_bubble_radio(this.form)" />'); |
$r->print("<input type='submit' value='Skip' name='scantron_skip_record' />"); |
} else { |
$r->print(" this scanline saving it for later."); |
$r->print('<input type="submit" name="submit" value="'.&mt('Continue ->').'" />'); |
|
} |
|
$r->print(' '.&mt('using corrected info').' <br />'); |
|
$r->print("<input type='submit' value='".&mt("Skip")."' name='scantron_skip_record' />"); |
|
$r->print(" ".&mt("this scanline saving it for later.")); |
} |
} |
} |
} |
$r->print(" </form><br />".&show_grading_menu_form($symb)); |
$r->print(" </form><br />".&show_grading_menu_form($symb)); |
Line 6080 sub scantron_remove_scan_data {
|
Line 6198 sub scantron_remove_scan_data {
|
} |
} |
my $result; |
my $result; |
if (@todelete) { |
if (@todelete) { |
$result=&Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname); |
$result = &Apache::lonnet::del('nohist_scantrondata', |
|
\@todelete,$cdom,$cname); |
|
} else { |
|
$result = 'ok'; |
} |
} |
return $result; |
return $result; |
} |
} |
Line 6495 sub scantron_validate_ID {
|
Line 6616 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)=@_; |
|
|
#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 |
|
|
$r->print("<p><b>An error was detected ($error)</b>"); |
|
if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { |
if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { |
$r->print(" for PaperID <tt>". |
$r->print("<p>".&mt("<b>An error was detected ($error)</b>". |
$$scan_record{'scantron.PaperID'}."</tt> \n"); |
" for PaperID <tt>[_1]</tt>", |
|
$$scan_record{'scantron.PaperID'})."</p> \n"); |
} else { |
} else { |
$r->print(" in scanline $i <pre>". |
$r->print("<p>".&mt("<b>An error was detected ($error)</b>". |
$line."</pre> \n"); |
" in scanline [_1] <pre>[_2]</pre>", |
} |
$i,$line)."</p> \n"); |
my $message="<p>The ID on the form is <tt>". |
} |
$$scan_record{'scantron.ID'}."</tt><br />\n". |
my $message="<p>".&mt("The ID on the form is <tt>[_1]</tt><br />". |
"The name on the paper is ". |
"The name on the paper is [_2],[_3]", |
$$scan_record{'scantron.LastName'}.",". |
$$scan_record{'scantron.ID'}, |
$$scan_record{'scantron.FirstName'}."</p>"; |
$$scan_record{'scantron.LastName'}, |
|
$$scan_record{'scantron.FirstName'})."</p>"; |
|
|
$r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); |
$r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n"); |
$r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); |
$r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n"); |
|
# Array populated for doublebubble or |
|
my @lines_to_correct; # missingbubble errors to build javascript |
|
# to validate radio button checking |
|
|
if ($error =~ /ID$/) { |
if ($error =~ /ID$/) { |
if ($error eq 'incorrectID') { |
if ($error eq 'incorrectID') { |
$r->print("The encoded ID is not in the classlist</p>\n"); |
$r->print("<p>".&mt("The encoded ID is not in the classlist"). |
|
"</p>\n"); |
} elsif ($error eq 'duplicateID') { |
} elsif ($error eq 'duplicateID') { |
$r->print("The encoded ID has also been used by a previous paper $arg</p>\n"); |
$r->print("<p>".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."</p>\n"); |
} |
} |
$r->print($message); |
$r->print($message); |
$r->print("<p>How should I handle this? <br /> \n"); |
$r->print("<p>".&mt("How should I handle this?")." <br /> \n"); |
$r->print("\n<ul><li> "); |
$r->print("\n<ul><li> "); |
#FIXME it would be nice if this sent back the user ID and |
#FIXME it would be nice if this sent back the user ID and |
#could do partial userID matches |
#could do partial userID matches |
Line 6536 sub scantron_get_correction {
|
Line 6662 sub scantron_get_correction {
|
$r->print('</li>'); |
$r->print('</li>'); |
} elsif ($error =~ /CODE$/) { |
} elsif ($error =~ /CODE$/) { |
if ($error eq 'incorrectCODE') { |
if ($error eq 'incorrectCODE') { |
$r->print("</p><p>The encoded CODE is not in the list of possible CODEs</p>\n"); |
$r->print("<p>".&mt("The encoded CODE is not in the list of possible CODEs.")."</p>\n"); |
} elsif ($error eq 'duplicateCODE') { |
} elsif ($error eq 'duplicateCODE') { |
$r->print("</p><p>The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique</p>\n"); |
$r->print("<p>".&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))."</p>\n"); |
} |
} |
$r->print("<p>The CODE on the form is <tt>'". |
$r->print("<p>".&mt("The CODE on the form is <tt>'[_1]'</tt>", |
$$scan_record{'scantron.CODE'}."'</tt><br />\n"); |
$$scan_record{'scantron.CODE'})."<br />\n"); |
$r->print($message); |
$r->print($message); |
$r->print("<p>How should I handle this? <br /> \n"); |
$r->print("<p>".&mt("How should I handle this?")." <br /> \n"); |
$r->print("\n<br /> "); |
$r->print("\n<br /> "); |
my $i=0; |
my $i=0; |
if ($error eq 'incorrectCODE' |
if ($error eq 'incorrectCODE' |
Line 6553 sub scantron_get_correction {
|
Line 6679 sub scantron_get_correction {
|
foreach my $testcode (@{$closest}) { |
foreach my $testcode (@{$closest}) { |
my $checked=''; |
my $checked=''; |
if (!$i) { $checked=' checked="checked" '; } |
if (!$i) { $checked=' checked="checked" '; } |
$r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_closest_$i' $checked /> Use the similar CODE <b><tt>".$testcode."</tt></b> instead.</label><input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />"); |
$r->print(" |
|
<label> |
|
<input type='radio' name='scantron_CODE_resolution' value='use_closest_$i' $checked /> |
|
".&mt("Use the similar CODE [_1] instead.", |
|
"<b><tt>".$testcode."</tt></b>")." |
|
</label> |
|
<input type='hidden' name='scantron_CODE_closest_$i' value='$testcode' />"); |
$r->print("\n<br />"); |
$r->print("\n<br />"); |
$i++; |
$i++; |
} |
} |
Line 6561 sub scantron_get_correction {
|
Line 6693 sub scantron_get_correction {
|
} |
} |
if ($$scan_record{'scantron.CODE'}=~/\S/ ) { |
if ($$scan_record{'scantron.CODE'}=~/\S/ ) { |
my $checked; if (!$i) { $checked=' checked="checked" '; } |
my $checked; if (!$i) { $checked=' checked="checked" '; } |
$r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_unfound' $checked /> Use the CODE <b><tt>".$$scan_record{'scantron.CODE'}."</tt></b> that is was on the paper, ignoring the error.</label>"); |
$r->print(" |
|
<label> |
|
<input type='radio' name='scantron_CODE_resolution' value='use_unfound' $checked /> |
|
".&mt("Use the CODE [_1] that is was on the paper, ignoring the error.", |
|
"<b><tt>".$$scan_record{'scantron.CODE'}."</tt></b>")." |
|
</label>"); |
$r->print("\n<br />"); |
$r->print("\n<br />"); |
} |
} |
|
|
Line 6583 ENDSCRIPT
|
Line 6720 ENDSCRIPT
|
"&curCODE=".&escape($$scan_record{'scantron.CODE'}). |
"&curCODE=".&escape($$scan_record{'scantron.CODE'}). |
"&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); |
"&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); |
if ($env{'form.scantron_CODElist'} =~ /\S/) { |
if ($env{'form.scantron_CODElist'} =~ /\S/) { |
$r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_found' /> <a target='_blank' href='$href'>Select</a> a CODE from the list of all CODEs and use it.</label> Selected CODE is <input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />"); |
$r->print(" |
|
<label> |
|
<input type='radio' name='scantron_CODE_resolution' value='use_found' /> |
|
".&mt("[_1]Select[_2] a CODE from the list of all CODEs and use it.", |
|
"<a target='_blank' href='$href'>","</a>")." |
|
</label> |
|
".&mt("Selected CODE is [_1]","<input readonly='true' type='text' size='8' name='scantron_CODE_selectedvalue' onfocus=\"javascript:change_radio('use_found')\" onchange=\"javascript:change_radio('use_found')\" />")); |
$r->print("\n<br />"); |
$r->print("\n<br />"); |
} |
} |
$r->print("<label><input type='radio' name='scantron_CODE_resolution' value='use_typed' /> Use </label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" /> as the CODE."); |
$r->print(" |
|
<label> |
|
<input type='radio' name='scantron_CODE_resolution' value='use_typed' /> |
|
".&mt("Use [_1] as the CODE.", |
|
"</label><input type='text' size='8' name='scantron_CODE_newvalue' onfocus=\"javascript:change_radio('use_typed')\" onkeypress=\"javascript:change_radio('use_typed')\" />")); |
$r->print("\n<br /><br />"); |
$r->print("\n<br /><br />"); |
} elsif ($error eq 'doublebubble') { |
} elsif ($error eq 'doublebubble') { |
$r->print("<p>There have been multiple bubbles scanned for a some question(s)</p>\n"); |
$r->print("<p>".&mt("There have been multiple bubbles scanned for some question(s)")."</p>\n"); |
|
|
|
# The form field scantron_questions is acutally a list of line numbers. |
|
# represented by this form so: |
|
|
|
my $line_list = &questions_to_line_list($arg); |
|
|
$r->print('<input type="hidden" name="scantron_questions" value="'. |
$r->print('<input type="hidden" name="scantron_questions" value="'. |
join(',',@{$arg}).'" />'); |
$line_list.'" />'); |
$r->print($message); |
$r->print($message); |
$r->print("<p>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 $selected = &get_response_bubbles($scan_record, $question); |
my @linenums = &prompt_for_corrections($r,$question,$scan_config, |
my @select_array = split(/:/,$selected); |
$scan_record, $error); |
&scantron_bubble_selector($r,$scan_config,$question, |
push (@lines_to_correct,@linenums); |
@select_array); |
|
} |
} |
|
$r->print(&verify_bubbles_checked(@lines_to_correct)); |
} elsif ($error eq 'missingbubble') { |
} elsif ($error eq 'missingbubble') { |
$r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n"); |
$r->print("<p>".&mt("There have been <b>no</b> bubbles scanned for some question(s)")."</p>\n"); |
$r->print($message); |
$r->print($message); |
$r->print("<p>Please indicate which bubble should be used for grading</p>"); |
$r->print("<p>".&mt("Please indicate which bubble should be used for grading.")."</p>"); |
$r->print("Some questions have no scanned bubbles\n"); |
$r->print(&mt("Some questions have no scanned bubbles.")."\n"); |
|
|
|
# The form field scantron_questions is actually a list of line numbers not |
|
# a list of question numbers. Therefore: |
|
# |
|
|
|
my $line_list = &questions_to_line_list($arg); |
|
|
$r->print('<input type="hidden" name="scantron_questions" value="'. |
$r->print('<input type="hidden" name="scantron_questions" value="'. |
join(',',@{$arg}).'" />'); |
$line_list.'" />'); |
foreach my $question (@{$arg}) { |
foreach my $question (@{$arg}) { |
my $selected = &get_response_bubbles($scan_record, $question); |
my @linenums = &prompt_for_corrections($r,$question,$scan_config, |
my @select_array = split(/:/,$selected); # ought to be an array of empties. |
$scan_record, $error); |
&scantron_bubble_selector($r,$scan_config,$question, @select_array); |
push (@lines_to_correct,@linenums); |
} |
} |
|
$r->print(&verify_bubbles_checked(@lines_to_correct)); |
} else { |
} else { |
$r->print("\n<ul>"); |
$r->print("\n<ul>"); |
} |
} |
$r->print("\n</li></ul>"); |
$r->print("\n</li></ul>"); |
|
} |
|
|
|
sub verify_bubbles_checked { |
|
my (@ansnums) = @_; |
|
my $ansnumstr = join('","',@ansnums); |
|
my $warning = &mt("A bubble or 'No bubble' selection has not been made for one or more lines."); |
|
my $output = (<<ENDSCRIPT); |
|
<script type="text/javascript"> |
|
function verify_bubble_radio(form) { |
|
var ansnumArray = new Array ("$ansnumstr"); |
|
var need_bubble_count = 0; |
|
for (var i=0; i<ansnumArray.length; i++) { |
|
if (form.elements["scantron_correct_Q_"+ansnumArray[i]].length > 1) { |
|
var bubble_picked = 0; |
|
for (var j=0; j<form.elements["scantron_correct_Q_"+ansnumArray[i]].length; j++) { |
|
if (form.elements["scantron_correct_Q_"+ansnumArray[i]][j].checked == true) { |
|
bubble_picked = 1; |
|
} |
|
} |
|
if (bubble_picked == 0) { |
|
need_bubble_count ++; |
|
} |
|
} |
|
} |
|
if (need_bubble_count) { |
|
alert("$warning"); |
|
return; |
|
} |
|
form.submit(); |
|
} |
|
</script> |
|
ENDSCRIPT |
|
return $output; |
} |
} |
|
|
=pod |
=pod |
|
|
=item scantron_bubble_selector |
=item questions_to_line_list |
|
|
Generates the html radiobuttons to correct a single bubble line |
|
possibly showing the existing the selected bubbles if known |
|
|
|
Arguments: |
Converts a list of questions into a string of comma separated |
$r - Apache request object |
line numbers in the answer sheet used by the questions. This is |
$scan_config - hash from &get_scantron_config() |
used to fill in the scantron_questions form field. |
$quest - number of the bubble line to make a corrector for |
|
@lines - array of answer lines. |
|
|
|
=cut |
Arguments: |
|
questions - Reference to an array of questions. |
|
|
sub scantron_bubble_selector { |
=cut |
my ($r,$scan_config,$quest,@lines)=@_; |
|
my $max=$$scan_config{'Qlength'}; |
|
|
|
|
|
my $scmode=$$scan_config{'Qon'}; |
sub questions_to_line_list { |
|
my ($questions) = @_; |
|
my @lines; |
|
|
|
foreach my $item (@{$questions}) { |
|
my $question = $item; |
|
my ($first,$count,$last); |
|
if ($item =~ /^(\d+)\.(\d+)$/) { |
|
$question = $1; |
|
my $subquestion = $2; |
|
$first = $first_bubble_line{$question-1} + 1; |
|
my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); |
|
my $subcount = 1; |
|
while ($subcount<$subquestion) { |
|
$first += $subans[$subcount-1]; |
|
$subcount ++; |
|
} |
|
$count = $subans[$subquestion-1]; |
|
} else { |
|
$first = $first_bubble_line{$question-1} + 1; |
|
$count = $bubble_lines_per_response{$question-1}; |
|
} |
|
$last = $first+$count-1; |
|
push(@lines, ($first..$last)); |
|
} |
|
return join(',', @lines); |
|
} |
|
|
my $bubble_length = scalar(@lines); |
=pod |
|
|
|
=item prompt_for_corrections |
|
|
if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } |
Prompts for a potentially multiline correction to the |
|
user's bubbling (factors out common code from scantron_get_correction |
|
for multi and missing bubble cases). |
|
|
my $response = $quest-1; |
Arguments: |
my $lines = $bubble_lines_per_response{$response}; |
$r - Apache request object. |
|
$question - The question number to prompt for. |
|
$scan_config - The scantron file configuration hash. |
|
$scan_record - Reference to the hash that has the the parsed scanlines. |
|
$error - Type of error |
|
|
|
Implicit inputs: |
|
%bubble_lines_per_response - Starting line numbers for each question. |
|
Numbered from 0 (but question numbers are from |
|
1. |
|
%first_bubble_line - Starting bubble line for each question. |
|
%subdivided_bubble_lines - optionresponse, matchresponse and rankresponse |
|
type problems render as separate sub-questions, |
|
in exam mode. This hash contains a |
|
comma-separated list of the lines per |
|
sub-question. |
|
%responsetype_per_response - essayresponse, formularesponse, |
|
stringresponse, imageresponse, reactionresponse, |
|
and organicresponse type problem parts can have |
|
multiple lines per response if the weight |
|
assigned exceeds 10. In this case, only |
|
one bubble per line is permitted, but more |
|
than one line might contain bubbles, e.g. |
|
bubbling of: line 1 - J, line 2 - J, |
|
line 3 - B would assign 22 points. |
|
|
my $total_lines = $lines*2; |
=cut |
my @alphabet=('A'..'Z'); |
|
|
|
$r->print("<table border='1'><tr><td rowspan='".$total_lines."'>$quest</td>"); |
sub prompt_for_corrections { |
|
my ($r, $question, $scan_config, $scan_record, $error) = @_; |
|
my ($current_line,$lines); |
|
my @linenums; |
|
my $questionnum = $question; |
|
if ($question =~ /^(\d+)\.(\d+)$/) { |
|
$question = $1; |
|
$current_line = $first_bubble_line{$question-1} + 1 ; |
|
my $subquestion = $2; |
|
my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); |
|
my $subcount = 1; |
|
while ($subcount<$subquestion) { |
|
$current_line += $subans[$subcount-1]; |
|
$subcount ++; |
|
} |
|
$lines = $subans[$subquestion-1]; |
|
} else { |
|
$current_line = $first_bubble_line{$question-1} + 1 ; |
|
$lines = $bubble_lines_per_response{$question-1}; |
|
} |
|
if ($lines > 1) { |
|
$r->print(&mt('The group of bubble lines below responds to a single question.').'<br />'); |
|
if (($responsetype_per_response{$question-1} eq 'essayresponse') || |
|
($responsetype_per_response{$question-1} eq 'formularesponse') || |
|
($responsetype_per_response{$question-1} eq 'stringresponse') || |
|
($responsetype_per_response{$question-1} eq 'imageresponse') || |
|
($responsetype_per_response{$question-1} eq 'reactionresponse') || |
|
($responsetype_per_response{$question-1} 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 scantron sheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during scantron 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 { |
|
$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++) { |
|
my $selected = $$scan_record{"scantron.$current_line.answer"}; |
|
&scantron_bubble_selector($r,$scan_config,$current_line, |
|
$questionnum,$error,split('', $selected)); |
|
push (@linenums,$current_line); |
|
$current_line++; |
|
} |
|
if ($lines > 1) { |
|
$r->print("<hr /><br />"); |
|
} |
|
return @linenums; |
|
} |
|
|
for (my $l = 0; $l < $lines; $l++) { |
=pod |
if ($l != 0) { |
|
$r->print('<tr>'); |
|
} |
|
my @selected = split(//,$lines[$l]); |
|
for (my $i=0;$i<$max;$i++) { |
|
$r->print("\n".'<td align="center">'); |
|
if ($selected[0] eq $alphabet[$i]) { |
|
$r->print('X'); |
|
shift(@selected) ; |
|
} else { |
|
$r->print(' '); |
|
} |
|
$r->print('</td>'); |
|
|
|
} |
|
|
|
if ($l == 0) { |
=item scantron_bubble_selector |
my $lspan = $total_lines * 2; # 2 table rows per bubble line. |
|
|
Generates the html radiobuttons to correct a single bubble line |
|
possibly showing the existing the selected bubbles if known |
|
|
$r->print('<td rowspan='.$lspan.'><label><input type="radio" name="scantron_correct_Q_'. |
Arguments: |
$quest.'" value="none" /> No bubble </label></td>'); |
$r - Apache request object |
|
$scan_config - hash from &get_scantron_config() |
} |
$line - Number of the line being displayed. |
|
$questionnum - Question number (may include subquestion) |
|
$error - Type of error. |
|
@selected - Array of bubbles picked on this line. |
|
|
$r->print('</tr><tr>'); |
=cut |
|
|
# FIXME: This may have to be a bit more clever for |
sub scantron_bubble_selector { |
# multiline questions (different values e.g..). |
my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_; |
|
my $max=$$scan_config{'Qlength'}; |
|
|
for (my $i=0;$i<$max;$i++) { |
my $scmode=$$scan_config{'Qon'}; |
my $value = "$l:$i"; # Relative bubble line #: Bubble in line. |
if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } |
$r->print("\n". |
|
'<td><label><input type="radio" name="scantron_correct_Q_'. |
|
$quest.'" value="'.$value.'" />'.$alphabet[$i]."</label></td>"); |
|
} |
|
$r->print('</tr>'); |
|
|
|
|
my @alphabet=('A'..'Z'); |
} |
$r->print(&Apache::loncommon::start_data_table(). |
$r->print('</table>'); |
&Apache::loncommon::start_data_table_row()); |
|
$r->print('<td rowspan="2" class="LC_leftcol_header">'.$line.'</td>'); |
|
for (my $i=0;$i<$max+1;$i++) { |
|
$r->print("\n".'<td align="center">'); |
|
if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) } |
|
else { $r->print(' '); } |
|
$r->print('</td>'); |
|
} |
|
$r->print(&Apache::loncommon::end_data_table_row(). |
|
&Apache::loncommon::start_data_table_row()); |
|
for (my $i=0;$i<$max;$i++) { |
|
$r->print("\n". |
|
'<td><label><input type="radio" name="scantron_correct_Q_'. |
|
$line.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>"); |
|
} |
|
my $nobub_checked = ' '; |
|
if ($error eq 'missingbubble') { |
|
$nobub_checked = ' checked = "checked" '; |
|
} |
|
$r->print("\n".'<td><label><input type="radio" name="scantron_correct_Q_'. |
|
$line.'" value="none"'.$nobub_checked.'/>'.&mt('No bubble'). |
|
'</label>'."\n".'<input type="hidden" name="scantron_questionnum_Q_'. |
|
$line.'" value="'.$questionnum.'" /></td>'); |
|
$r->print(&Apache::loncommon::end_data_table_row(). |
|
&Apache::loncommon::end_data_table()); |
} |
} |
|
|
=pod |
=pod |
Line 6874 sub scantron_validate_doublebubble {
|
Line 7167 sub scantron_validate_doublebubble {
|
#get scantron line setup |
#get scantron line setup |
my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); |
my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); |
my ($scanlines,$scan_data)=&scantron_getfile(); |
my ($scanlines,$scan_data)=&scantron_getfile(); |
|
|
&scantron_get_maxbubble(); # parse needs the bubble line array. |
&scantron_get_maxbubble(); # parse needs the bubble line array. |
|
|
for (my $i=0;$i<=$scanlines->{'count'};$i++) { |
for (my $i=0;$i<=$scanlines->{'count'};$i++) { |
Line 6901 sub scantron_validate_doublebubble {
|
Line 7193 sub scantron_validate_doublebubble {
|
for what the current value of the problem counter is. |
for what the current value of the problem counter is. |
|
|
Caches the results to $env{'form.scantron_maxbubble'}, |
Caches the results to $env{'form.scantron_maxbubble'}, |
$env{'form.scantron.bubble_lines.n'} and |
$env{'form.scantron.bubble_lines.n'}, |
$env{'form.scantron.first_bubble_line.n'} |
$env{'form.scantron.first_bubble_line.n'} and |
|
$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 reponse 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 |
|
(for optionresponse, matchresponse, and rankresponse items), for response n. |
|
|
=cut |
=cut |
|
|
sub scantron_get_maxbubble { |
sub scantron_get_maxbubble { |
if (defined($env{'form.scantron_maxbubble'}) && |
if (defined($env{'form.scantron_maxbubble'}) && |
$env{'form.scantron_maxbubble'}) { |
$env{'form.scantron_maxbubble'}) { |
&restore_bubble_lines(); |
&restore_bubble_lines(); |
Line 6930 sub scantron_get_maxbubble {
|
Line 7225 sub scantron_get_maxbubble {
|
my $total_lines = 0; |
my $total_lines = 0; |
%bubble_lines_per_response = (); |
%bubble_lines_per_response = (); |
%first_bubble_line = (); |
%first_bubble_line = (); |
|
%subdivided_bubble_lines = (); |
|
%responsetype_per_response = (); |
|
|
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 $symb = $resource->symb(); |
# Need to retrieve part IDs and response IDs because essayresponse, |
&Apache::lonxml::clear_bubble_lines_for_part(); |
# reactionresponse and organicresponse items are not included in |
my $result=&Apache::lonnet::ssi($resource->src(), |
# $analysis{'parts'} from lonnet::ssi. |
|
my %possible_part_ids; |
|
if (ref($resource->parts()) eq 'ARRAY') { |
|
foreach my $part (@{$resource->parts()}) { |
|
my @resp_ids = $resource->responseIds($part); |
|
foreach my $id (@resp_ids) { |
|
$possible_part_ids{$part.'.'.$id} = 1; |
|
} |
|
} |
|
} |
|
my $result=&ssi_with_retries($resource->src(), $ssi_retries, |
('symb' => $resource->symb()), |
('symb' => $resource->symb()), |
('grade_target' => 'analyze'), |
('grade_target' => 'analyze'), |
('grade_courseid' => $cid), |
('grade_courseid' => $cid), |
Line 6946 sub scantron_get_maxbubble {
|
Line 7252 sub scantron_get_maxbubble {
|
my (undef, $an) = |
my (undef, $an) = |
split(/_HASH_REF__/,$result, 2); |
split(/_HASH_REF__/,$result, 2); |
|
|
my %analysis = &Apache::lonnet::str2hash($an); |
my @parts; |
|
|
|
|
|
|
foreach my $part_id (@{$analysis{'parts'}}) { |
my %analysis = &Apache::lonnet::str2hash($an); |
|
|
|
if (ref($analysis{'parts'}) eq 'ARRAY') { |
|
@parts = @{$analysis{'parts'}}; |
|
} |
|
# Add part_ids for any essayresponse items. |
|
foreach my $part_id (keys(%possible_part_ids)) { |
|
if (($analysis{$part_id.'.type'} eq 'essayresponse') || |
|
($analysis{$part_id.'.type'} eq 'reactionresponse') || |
|
($analysis{$part_id.'.type'} eq 'organicresponse')) { |
|
if (!grep(/^\Q$part_id\E$/,@parts)) { |
|
push (@parts,$part_id); |
|
} |
|
} |
|
} |
|
|
my $lines = $analysis{"$part_id.bubble_lines"};; |
foreach my $part_id (@parts) { |
|
my $lines = $analysis{"$part_id.bubble_lines"}; |
|
|
# TODO - make this a persistent hash not an array. |
# TODO - make this a persistent hash not an array. |
|
|
|
# optionresponse, matchresponse and rankresponse type items |
|
# render as separate sub-questions in exam mode. |
|
if (($analysis{$part_id.'.type'} eq 'optionresponse') || |
|
($analysis{$part_id.'.type'} eq 'matchresponse') || |
|
($analysis{$part_id.'.type'} eq 'rankresponse')) { |
|
my ($numbub,$numshown); |
|
if ($analysis{$part_id.'.type'} eq 'optionresponse') { |
|
if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') { |
|
$numbub = scalar(@{$analysis{$part_id.'.options'}}); |
|
} |
|
} elsif ($analysis{$part_id.'.type'} eq 'matchresponse') { |
|
if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') { |
|
$numbub = scalar(@{$analysis{$part_id.'.items'}}); |
|
} |
|
} elsif ($analysis{$part_id.'.type'} eq 'rankresponse') { |
|
if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') { |
|
$numbub = scalar(@{$analysis{$part_id.'.foils'}}); |
|
} |
|
} |
|
if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') { |
|
$numshown = scalar(@{$analysis{$part_id.'.shown'}}); |
|
} |
|
my $bubbles_per_line = 10; |
|
my $inner_bubble_lines = int($numshown/$bubbles_per_line); |
|
if (($numshown % $bubbles_per_line) != 0) { |
|
$inner_bubble_lines++; |
|
} |
|
for (my $i=0; $i<$numshown; $i++) { |
|
$subdivided_bubble_lines{$response_number} .= |
|
$inner_bubble_lines.','; |
|
} |
|
$subdivided_bubble_lines{$response_number} =~ s/,$//; |
|
} |
|
|
$first_bubble_line{$response_number} = $bubble_line; |
$first_bubble_line{$response_number} = $bubble_line; |
$bubble_lines_per_response{$response_number} = $lines; |
$bubble_lines_per_response{$response_number} = $lines; |
|
$responsetype_per_response{$response_number} = |
|
$analysis{$part_id.'.type'}; |
$response_number++; |
$response_number++; |
|
|
$bubble_line += $lines; |
$bubble_line += $lines; |
Line 7007 sub scantron_validate_missingbubbles {
|
Line 7360 sub scantron_validate_missingbubbles {
|
# Probably here's where the error is... |
# Probably here's where the error is... |
|
|
foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { |
foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { |
if ($missing > $max_bubble) { next; } |
my $lastbubble; |
|
if ($missing =~ /^(\d+)\.(\d+)$/) { |
|
my $question = $1; |
|
my $subquestion = $2; |
|
if (!defined($first_bubble_line{$question -1})) { next; } |
|
my $first = $first_bubble_line{$question-1}; |
|
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 { |
|
if (!defined($first_bubble_line{$missing - 1})) { next; } |
|
$lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1}; |
|
} |
|
if ($lastbubble > $max_bubble) { next; } |
push(@to_correct,$missing); |
push(@to_correct,$missing); |
} |
} |
if (@to_correct) { |
if (@to_correct) { |
Line 7046 sub scantron_validate_missingbubbles {
|
Line 7417 sub scantron_validate_missingbubbles {
|
|
|
sub scantron_process_students { |
sub scantron_process_students { |
my ($r) = @_; |
my ($r) = @_; |
|
|
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); |
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'}); |
my ($symb)=&get_symb($r); |
my ($symb)=&get_symb($r); |
if (!$symb) {return '';} |
if (!$symb) { |
|
return ''; |
|
} |
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'}); |
Line 7080 SCANTRONFORM
|
Line 7454 SCANTRONFORM
|
my ($uname,$udom,$started); |
my ($uname,$udom,$started); |
|
|
&scantron_get_maxbubble(); # Need the bubble lines array to parse. |
&scantron_get_maxbubble(); # Need the bubble lines array to parse. |
|
|
|
|
|
# If an ssi failed in scantron_get_maxbubble, put an error message out to |
|
# the user and return. |
|
|
|
if ($ssi_error) { |
|
$r->print("</form>"); |
|
&ssi_print_error($r); |
|
$r->print(&show_grading_menu_form($symb)); |
|
return ''; # Dunno why the other returns return '' rather than just returning. |
|
} |
|
|
while ($i<$scanlines->{'count'}) { |
while ($i<$scanlines->{'count'}) { |
($uname,$udom)=('',''); |
($uname,$udom)=('',''); |
Line 7107 SCANTRONFORM
|
Line 7492 SCANTRONFORM
|
($uname,$udom)=split(/:/,$uname); |
($uname,$udom)=split(/:/,$uname); |
|
|
&Apache::lonxml::clear_problem_counter(); |
&Apache::lonxml::clear_problem_counter(); |
&Apache::lonnet::appenv(%$scan_record); |
&Apache::lonnet::appenv($scan_record); |
|
|
if (&scantron_clear_skip($scanlines,$scan_data,$i)) { |
if (&scantron_clear_skip($scanlines,$scan_data,$i)) { |
&scantron_putfile($scanlines,$scan_data); |
&scantron_putfile($scanlines,$scan_data); |
Line 7128 SCANTRONFORM
|
Line 7513 SCANTRONFORM
|
$form{'CODE'}=$scan_record->{'scantron.CODE'}; |
$form{'CODE'}=$scan_record->{'scantron.CODE'}; |
} else { |
} else { |
$form{'CODE'}=''; |
$form{'CODE'}=''; |
|
} |
|
my $result=&ssi_with_retries($resource->src(), $ssi_retries, %form); |
|
if ($ssi_error) { |
|
$ssi_error = 0; # So end of handler error message does not trigger. |
|
$r->print("</form>"); |
|
&ssi_print_error($r); |
|
$r->print(&show_grading_menu_form($symb)); |
|
return ''; # Why return ''? Beats me. |
} |
} |
my $result=&Apache::lonnet::ssi($resource->src(),%form); |
|
if ($result ne '') { |
|
} |
|
if (&Apache::loncommon::connection_aborted($r)) { last; } |
if (&Apache::loncommon::connection_aborted($r)) { last; } |
} |
} |
$completedstudents{$uname}={'line'=>$line}; |
$completedstudents{$uname}={'line'=>$line}; |
Line 7166 sub scantron_upload_scantron_data {
|
Line 7557 sub scantron_upload_scantron_data {
|
my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, |
my $domsel=&Apache::loncommon::select_dom_form($env{'request.role.domain'}, |
'domainid'); |
'domainid'); |
my $default_form_data=&defaultFormData(&get_symb($r,1)); |
my $default_form_data=&defaultFormData(&get_symb($r,1)); |
$r->print(<<UPLOAD); |
$r->print(' |
<script type="text/javascript" language="javascript"> |
<script type="text/javascript" language="javascript"> |
function checkUpload(formname) { |
function checkUpload(formname) { |
if (formname.upfile.value == "") { |
if (formname.upfile.value == "") { |
Line 7177 sub scantron_upload_scantron_data {
|
Line 7568 sub scantron_upload_scantron_data {
|
} |
} |
</script> |
</script> |
|
|
<form enctype='multipart/form-data' action='/adm/grades' name='rules' method='post'> |
<form enctype="multipart/form-data" action="/adm/grades" name="rules" method="post"> |
$default_form_data |
'.$default_form_data.' |
<table> |
<table> |
<tr><td>$select_link </td></tr> |
<tr><td>'.$select_link.' </td></tr> |
<tr><td>Course ID: </td><td><input name='courseid' type='text' /> </td></tr> |
<tr><td>'.&mt('Course ID:').' </td> |
<tr><td>Course Name: </td><td><input name='coursename' type='text' /></td></tr> |
<td><input name="courseid" type="text" /> </td></tr> |
<tr><td>Domain: </td><td>$domsel </td></tr> |
<tr><td>'.&mt('Course Name:').' </td> |
<tr><td>File to upload:</td><td><input type="file" name="upfile" size="50" /></td></tr> |
<td><input name="coursename" type="text" /> </td></tr> |
|
<tr><td>'.&mt('Domain:').' </td> |
|
<td>'.$domsel.' </td></tr> |
|
<tr><td>'.&mt('File to upload:').'</td> |
|
<td><input type="file" name="upfile" size="50" /></td></tr> |
</table> |
</table> |
<input name='command' value='scantronupload_save' type='hidden' /> |
<input name="command" value="scantronupload_save" type="hidden" /> |
<input type="button" onClick="javascript:checkUpload(this.form);" value="Upload Scantron Data" /> |
<input type="button" onClick="javascript:checkUpload(this.form);" value="'.&mt('Upload Scantron Data').'" /> |
</form> |
</form> |
UPLOAD |
'); |
return ''; |
return ''; |
} |
} |
|
|
Line 7208 sub scantron_upload_scantron_data_save {
|
Line 7603 sub scantron_upload_scantron_data_save {
|
my $doanotherupload= |
my $doanotherupload= |
'<br /><form action="/adm/grades" method="post">'."\n". |
'<br /><form action="/adm/grades" method="post">'."\n". |
'<input type="hidden" name="command" value="scantronupload" />'."\n". |
'<input type="hidden" name="command" value="scantronupload" />'."\n". |
'<input type="submit" name="submit" value="Do Another Upload" />'."\n". |
'<input type="submit" name="submit" value="'.&mt('Do Another Upload').'" />'."\n". |
'</form>'."\n"; |
'</form>'."\n"; |
if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && |
if (!&Apache::lonnet::allowed('usc',$env{'form.domainid'}) && |
!&Apache::lonnet::allowed('usc', |
!&Apache::lonnet::allowed('usc', |
$env{'form.domainid'}.'_'.$env{'form.courseid'})) { |
$env{'form.domainid'}.'_'.$env{'form.courseid'})) { |
$r->print("You are not allowed to upload Scantron data to the requested course.<br />"); |
$r->print(&mt("You are not allowed to upload Scantron data to the requested course.")."<br />"); |
if ($symb) { |
if ($symb) { |
$r->print(&show_grading_menu_form($symb)); |
$r->print(&show_grading_menu_form($symb)); |
} else { |
} else { |
Line 7222 sub scantron_upload_scantron_data_save {
|
Line 7617 sub scantron_upload_scantron_data_save {
|
return ''; |
return ''; |
} |
} |
my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); |
my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); |
$r->print("Doing upload to ".$coursedata{'description'}." <br />"); |
$r->print(&mt("Doing upload to [_1]",$coursedata{'description'})." <br />"); |
my $fname=$env{'form.upfile.filename'}; |
my $fname=$env{'form.upfile.filename'}; |
#FIXME |
#FIXME |
#copied from lonnet::userfileupload() |
#copied from lonnet::userfileupload() |
Line 7240 sub scantron_upload_scantron_data_save {
|
Line 7635 sub scantron_upload_scantron_data_save {
|
my $uploadedfile=$fname; |
my $uploadedfile=$fname; |
$fname='scantron_orig_'.$fname; |
$fname='scantron_orig_'.$fname; |
if (length($env{'form.upfile'}) < 2) { |
if (length($env{'form.upfile'}) < 2) { |
$r->print("<span class=\"LC_error\">Error:</span> The file you attempted to upload, <tt>".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</tt>, contained no information. Please check that you entered the correct filename."); |
$r->print(&mt("<span class=\"LC_error\">Error:</span> The file you attempted to upload, [_1] contained no information. Please check that you entered the correct filename.",'<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</span>")); |
} else { |
} else { |
my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname); |
my $result=&Apache::lonnet::finishuserfileupload($env{'form.courseid'},$env{'form.domainid'},'upfile',$fname); |
if ($result =~ m|^/uploaded/|) { |
if ($result =~ m|^/uploaded/|) { |
$r->print("<span class=\"LC_success\">Success:</span> Successfully uploaded ".(length($env{'form.upfile'})-1)." bytes of data into location <tt>".$result."</tt>"); |
$r->print(&mt("<span class=\"LC_success\">Success:</span> Successfully uploaded [_1] bytes of data into location [_2]", |
|
(length($env{'form.upfile'})-1), |
|
'<span class="LC_filename">'.$result."</span>")); |
} else { |
} else { |
$r->print("<span class=\"LC_error\">Error:</span> An error (".$result.") occurred when attempting to upload the file, <tt>".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</tt>"); |
$r->print(&mt("<span class=\"LC_error\">Error:</span> An error ([_1]) occurred when attempting to upload the file, [_2]", |
|
$result, |
|
'<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</span>")); |
|
|
} |
} |
} |
} |
if ($symb) { |
if ($symb) { |
Line 7290 sub scantron_download_scantron_data {
|
Line 7690 sub scantron_download_scantron_data {
|
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(<<ERROR); |
$r->print(' |
<p> |
<p> |
The requested file name was invalid. |
'.&mt('The requested file name was invalid.').' |
</p> |
</p> |
ERROR |
'); |
$r->print(&show_grading_menu_form(&get_symb($r,1))); |
$r->print(&show_grading_menu_form(&get_symb($r,1))); |
return; |
return; |
} |
} |
Line 7304 ERROR
|
Line 7704 ERROR
|
&Apache::lonnet::allowuploaded('/adm/grades',$orig); |
&Apache::lonnet::allowuploaded('/adm/grades',$orig); |
&Apache::lonnet::allowuploaded('/adm/grades',$corrected); |
&Apache::lonnet::allowuploaded('/adm/grades',$corrected); |
&Apache::lonnet::allowuploaded('/adm/grades',$skipped); |
&Apache::lonnet::allowuploaded('/adm/grades',$skipped); |
$r->print(<<DOWNLOAD); |
$r->print(' |
<p> |
<p> |
<a href="$orig">Original</a> file as uploaded by the scantron office. |
'.&mt('[_1]Original[_2] file as uploaded by the scantron office.', |
|
'<a href="'.$orig.'">','</a>').' |
</p> |
</p> |
<p> |
<p> |
<a href="$corrected">Corrections</a>, a file of corrected records that were used in grading. |
'.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', |
|
'<a href="'.$corrected.'">','</a>').' |
</p> |
</p> |
<p> |
<p> |
<a href="$skipped">Skipped</a>, a file of records that were skipped. |
'.&mt('[_1]Skipped[_2], a file of records that were skipped.', |
|
'<a href="'.$skipped.'">','</a>').' |
</p> |
</p> |
DOWNLOAD |
'); |
$r->print(&show_grading_menu_form(&get_symb($r,1))); |
$r->print(&show_grading_menu_form(&get_symb($r,1))); |
return ''; |
return ''; |
} |
} |
Line 7421 sub grading_menu {
|
Line 7824 sub grading_menu {
|
$menudata->{'url'}.'" >'. |
$menudata->{'url'}.'" >'. |
$menudata->{'name'}."</a></h3>\n"; |
$menudata->{'name'}."</a></h3>\n"; |
} else { |
} else { |
$Str .=' <h3><input type="button" value="'.&mt('Verify Receipt').'" '. |
$Str .='<hr /><input type="button" value="'.&mt('Verify Receipt').'" '. |
$menudata->{'jscript'}. |
$menudata->{'jscript'}. |
' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '. |
' onClick="javascript:checkChoice(document.forms.gradingMenu,\'5\',\'verify\')" '. |
' /></h3>'; |
' /> '. |
$Str .= (' 'x8). |
&Apache::lonnet::recprefix($env{'request.course.id'}). |
&mt(' receipt: [_1]', |
'-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')" />'; |
&Apache::lonnet::recprefix($env{'request.course.id'}). |
|
'-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')" />'); |
|
} |
} |
$Str .= ' '.(' 'x8).$menudata->{'short_description'}. |
$Str .= ' '.(' 'x8).$menudata->{'short_description'}. |
"\n"; |
"\n"; |
Line 7635 GRADINGMENUJS
|
Line 8036 GRADINGMENUJS
|
</div> |
</div> |
</div> |
</div> |
</form>'; |
</form>'; |
|
$result .= &show_grading_menu_form($symb); |
return $result; |
return $result; |
} |
} |
|
|
Line 7913 ENDHEADER
|
Line 8315 ENDHEADER
|
} |
} |
$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 corrion(s)',$number).'<br />'. |
|
'<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', |
$env{'form.pcorrect'},$env{'form.pincorrect'}). |
$env{'form.pcorrect'},$env{'form.pincorrect'}). |
'<br />'; |
'<br />'; |
Line 8162 sub handler {
|
Line 8562 sub handler {
|
&Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); |
&Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); |
} |
} |
|
|
|
$ssi_error = 0; |
$request->print(&Apache::loncommon::start_page('Grading')); |
$request->print(&Apache::loncommon::start_page('Grading')); |
if ($symb eq '' && $command eq '') { |
if ($symb eq '' && $command eq '') { |
if ($env{'user.adv'}) { |
if ($env{'user.adv'}) { |
Line 8175 sub handler {
|
Line 8575 sub handler {
|
if ($tsymb) { |
if ($tsymb) { |
my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); |
my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb); |
if (&Apache::lonnet::allowed('mgr',$tcrsid)) { |
if (&Apache::lonnet::allowed('mgr',$tcrsid)) { |
$request->print(&Apache::lonnet::ssi_body('/res/'.$url, |
$request->print(&ssi_with_retries('/res/'.$url, $ssi_retries, |
('grade_username' => $tuname, |
('grade_username' => $tuname, |
'grade_domain' => $tudom, |
'grade_domain' => $tudom, |
'grade_courseid' => $tcrsid, |
'grade_courseid' => $tcrsid, |
Line 8262 sub handler {
|
Line 8662 sub handler {
|
$request->print("Access Denied ($command)"); |
$request->print("Access Denied ($command)"); |
} |
} |
} |
} |
|
if ($ssi_error) { |
|
&ssi_print_error($request); |
|
} |
$request->print(&Apache::loncommon::end_page()); |
$request->print(&Apache::loncommon::end_page()); |
&reset_caches(); |
&reset_caches(); |
return ''; |
return ''; |