version 1.504, 2008/02/02 02:28:02
|
version 1.519, 2008/05/01 16:03:34
|
Line 47 use LONCAPA;
|
Line 47 use LONCAPA;
|
use POSIX qw(floor); |
use POSIX qw(floor); |
|
|
|
|
|
|
my %perm=(); |
my %perm=(); |
|
|
|
# These variables are used to recover from ssi errors |
|
|
|
my $ssi_retries = 5; |
|
my $ssi_error; |
|
my $ssi_error_resource; |
|
my $ssi_error_message; |
|
|
|
|
|
# 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. |
|
|
|
|
|
# |
|
# ssi_with_retries - Does the server side include of a resource. |
|
# 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 occurred. |
|
# 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 occurred this becomes true. |
|
# It is up to the caller to initialize this to false |
|
# if desired. |
|
# ssi_error_resource - If an unrecoverable error occurred, this is the value |
|
# of the resource that could not be rendered by the ssi |
|
# call. |
|
# ssi_error_message - 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 $content; |
|
|
|
} |
|
# |
|
# Prodcuces an ssi retry failure error message to the user: |
|
# |
|
|
|
sub ssi_print_error { |
|
my ($r) = @_; |
|
my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk'); |
|
$r->print(' |
|
<br /> |
|
<h2>'.&mt('An unrecoverable network error occurred:').'</h2> |
|
<p> |
|
'.&mt('Unable to retrieve a resource from a server:').'<br /> |
|
'.&mt('Resource:').' '.$ssi_error_resource.'<br /> |
|
'.&mt('Error:').' '.$ssi_error_message.' |
|
</p> |
|
<p>'. |
|
&mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'<br />'. |
|
&mt('If the error persists, please contact the [_1] for assistance.',$helpurl). |
|
'</p>'); |
|
return; |
|
} |
|
|
# |
# |
# --- Retrieve the parts from the metadata file.--- |
# --- Retrieve the parts from the metadata file.--- |
sub getpartlist { |
sub getpartlist { |
Line 201 sub reset_caches {
|
Line 284 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, |
('grade_courseid' => |
'grade_courseid' => |
$env{'request.course.id'}), |
$env{'request.course.id'}, |
('grade_username' => $uname)); |
'grade_username' => $uname)); |
(undef,$subresult)=split(/_HASH_REF__/,$subresult,2); |
(undef,$subresult)=split(/_HASH_REF__/,$subresult,2); |
my %analyze=&Apache::lonnet::str2hash($subresult); |
my %analyze=&Apache::lonnet::str2hash($subresult); |
return $analyze_cache{$key} = \%analyze; |
return $analyze_cache{$key} = \%analyze; |
Line 1759 sub download_all_link {
|
Line 1842 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 2685 sub check_and_remove_from_queue {
|
Line 2768 sub check_and_remove_from_queue {
|
|
|
sub handback_files { |
sub handback_files { |
my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; |
my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; |
my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio'; |
my $portfolio_root = '/userfiles/portfolio'; |
my ($partlist,$handgrade,$responseType) = &response_type($symb); |
my ($partlist,$handgrade,$responseType) = &response_type($symb); |
|
|
my @part_response_id = &flatten_responseType($responseType); |
my @part_response_id = &flatten_responseType($responseType); |
Line 2703 sub handback_files {
|
Line 2786 sub handback_files {
|
my ($answer_name,$answer_ver,$answer_ext) = |
my ($answer_name,$answer_ver,$answer_ext) = |
&file_name_version_ext($answer_file); |
&file_name_version_ext($answer_file); |
my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); |
my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); |
my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root); |
my $getpropath = 1; |
|
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath); |
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); |
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); |
# fix file name |
# fix file name |
my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); |
my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); |
Line 2839 sub version_portfiles {
|
Line 2923 sub version_portfiles {
|
my $version_parts = join('|',@$v_flag); |
my $version_parts = join('|',@$v_flag); |
my @returned_keys; |
my @returned_keys; |
my $parts = join('|', @$parts_graded); |
my $parts = join('|', @$parts_graded); |
my $portfolio_root = &propath($domain,$stu_name). |
my $portfolio_root = '/userfiles/portfolio'; |
'/userfiles/portfolio'; |
|
foreach my $key (keys(%$record)) { |
foreach my $key (keys(%$record)) { |
my $new_portfiles; |
my $new_portfiles; |
if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { |
if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { |
Line 2851 sub version_portfiles {
|
Line 2934 sub version_portfiles {
|
my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); |
my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); |
my ($answer_name,$answer_ver,$answer_ext) = |
my ($answer_name,$answer_ver,$answer_ext) = |
&file_name_version_ext($answer_file); |
&file_name_version_ext($answer_file); |
my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root); |
my $getpropath = 1; |
|
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$directory,$domain,$stu_name,$getpropath); |
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); |
my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); |
my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); |
my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); |
if ($new_answer ne 'problem getting file') { |
if ($new_answer ne 'problem getting file') { |
Line 3960 sub csvuploadassign {
|
Line 4044 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 4681 my %bubble_lines_per_response; # no.
|
Line 4765 my %bubble_lines_per_response; # no.
|
|
|
my %first_bubble_line; # First bubble line no. for each bubble. |
my %first_bubble_line; # First bubble line no. for each bubble. |
|
|
my %subdivided_bubble_lines; # no. bubble lines for optionresponse |
my %subdivided_bubble_lines; # no. bubble lines for optionresponse, |
# or matchresponse where an individual |
# matchresponse or rankresponse, where |
# response can have multiple lines |
# an individual response can have multiple |
|
# lines |
|
|
my %responsetype_per_response; # responsetype for each response |
my %responsetype_per_response; # responsetype for each response |
|
|
Line 4750 sub get_response_bubbles {
|
Line 4835 sub get_response_bubbles {
|
sub scantron_filenames { |
sub scantron_filenames { |
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
|
my $getpropath = 1; |
my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, |
my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, |
&propath($cdom,$cname)); |
$getpropath); |
my @possiblenames; |
my @possiblenames; |
foreach my $filename (sort(@files)) { |
foreach my $filename (sort(@files)) { |
($filename)=split(/&/,$filename); |
($filename)=split(/&/,$filename); |
Line 4794 sub scantron_uploads {
|
Line 4880 sub scantron_uploads {
|
=cut |
=cut |
|
|
sub scantron_scantab { |
sub scantron_scantab { |
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); |
|
my $result='<select name="scantron_format">'."\n"; |
my $result='<select name="scantron_format">'."\n"; |
$result.='<option></option>'."\n"; |
$result.='<option></option>'."\n"; |
foreach my $line (<$fh>) { |
my @lines = &get_scantronformat_file(); |
my ($name,$descrip)=split(/:/,$line); |
if (@lines > 0) { |
if ($name =~ /^\#/) { next; } |
foreach my $line (@lines) { |
$result.='<option value="'.$name.'">'.$descrip.'</option>'."\n"; |
next if (($line =~ /^\#/) || ($line eq '')); |
|
my ($name,$descrip)=split(/:/,$line); |
|
$result.='<option value="'.$name.'">'.$descrip.'</option>'."\n"; |
|
} |
} |
} |
$result.='</select>'."\n"; |
$result.='</select>'."\n"; |
|
|
return $result; |
return $result; |
} |
} |
|
|
|
=pod |
|
|
|
=item get_scantronformat_file |
|
|
|
Returns an array containing lines from the scantron format file for |
|
the domain of the course. |
|
|
|
If a url for a custom.tab file is listed in domain's configuration.db, |
|
lines are from this file. |
|
|
|
Otherwise, if a default.tab has been published in RES space by the |
|
domainconfig user, lines are from this file. |
|
|
|
Otherwise, fall back to getting lines from the legacy file on the |
|
local server: /home/httpd/lonTabs/default_scantronformat.tab |
|
|
|
=cut |
|
|
|
sub get_scantronformat_file { |
|
my $cdom= $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
my %domconfig = &Apache::lonnet::get_dom('configuration',['scantron'],$cdom); |
|
my $gottab = 0; |
|
my @lines; |
|
if (ref($domconfig{'scantron'}) eq 'HASH') { |
|
if ($domconfig{'scantron'}{'scantronformat'} ne '') { |
|
my $formatfile = &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.$domconfig{'scantron'}{'scantronformat'}); |
|
if ($formatfile ne '-1') { |
|
@lines = split("\n",$formatfile,-1); |
|
$gottab = 1; |
|
} |
|
} |
|
} |
|
if (!$gottab) { |
|
my $confname = $cdom.'-domainconfig'; |
|
my $default = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cdom.'/'.$confname.'/default.tab'; |
|
my $formatfile = &Apache::lonnet::getfile($default); |
|
if ($formatfile ne '-1') { |
|
@lines = split("\n",$formatfile,-1); |
|
$gottab = 1; |
|
} |
|
} |
|
if (!$gottab) { |
|
my @domains = &Apache::lonnet::current_machine_domains(); |
|
if (grep(/^\Q$cdom\E$/,@domains)) { |
|
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); |
|
@lines = <$fh>; |
|
close($fh); |
|
} else { |
|
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab'); |
|
@lines = <$fh>; |
|
close($fh); |
|
} |
|
} |
|
return @lines; |
|
} |
|
|
=pod |
=pod |
|
|
=item scantron_CODElist |
=item scantron_CODElist |
Line 4880 sub scantron_selectphase {
|
Line 5023 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.= ' |
$result.= ' |
Line 5063 sub scantron_selectphase {
|
Line 5208 sub scantron_selectphase {
|
|
|
sub get_scantron_config { |
sub get_scantron_config { |
my ($which) = @_; |
my ($which) = @_; |
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); |
my @lines = &get_scantronformat_file(); |
my %config; |
my %config; |
#FIXME probably should move to XML it has already gotten a bit much now |
#FIXME probably should move to XML it has already gotten a bit much now |
foreach my $line (<$fh>) { |
foreach my $line (@lines) { |
my ($name,$descrip)=split(/:/,$line); |
my ($name,$descrip)=split(/:/,$line); |
if ($name ne $which ) { next; } |
if ($name ne $which ) { next; } |
chomp($line); |
chomp($line); |
Line 5457 sub scantron_validator_lettnum {
|
Line 5602 sub scantron_validator_lettnum {
|
my $occurrences = 0; |
my $occurrences = 0; |
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || |
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || |
($responsetype_per_response{$questnum-1} eq 'formularesponse') || |
($responsetype_per_response{$questnum-1} eq 'formularesponse') || |
($responsetype_per_response{$questnum-1} eq 'stringresponse')) { |
($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); |
my @singlelines = split('',$currquest); |
foreach my $entry (@singlelines) { |
foreach my $entry (@singlelines) { |
$occurrences = &occurence_count($entry,$matchon); |
$occurrences = &occurence_count($entry,$matchon); |
Line 5524 sub scantron_validator_positional {
|
Line 5672 sub scantron_validator_positional {
|
# If the split only gives us one element.. the full length of the |
# If the split only gives us one element.. the full length of the |
# answer string, no bubbles are filled in: |
# answer string, no bubbles are filled in: |
|
|
|
if ($answers_needed eq '') { |
|
return; |
|
} |
|
|
if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { |
if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { |
for (my $ans=0; $ans<$answers_needed; $ans++ ) { |
for (my $ans=0; $ans<$answers_needed; $ans++ ) { |
$record->{"scantron.$ansnum.answer"}=''; |
$record->{"scantron.$ansnum.answer"}=''; |
Line 5552 sub scantron_validator_positional {
|
Line 5704 sub scantron_validator_positional {
|
# |
# |
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || |
if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || |
($responsetype_per_response{$questnum-1} eq 'formularesponse') || |
($responsetype_per_response{$questnum-1} eq 'formularesponse') || |
($responsetype_per_response{$questnum-1} eq 'stringresponse')) { |
($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; |
my $doubleerror = 0; |
while (($currquest >= $$scantron_config{'Qlength'}) && |
while (($currquest >= $$scantron_config{'Qlength'}) && |
(!$doubleerror)) { |
(!$doubleerror)) { |
Line 6026 sub scantron_validate_file {
|
Line 6181 sub scantron_validate_file {
|
} |
} |
if (!$stop) { |
if (!$stop) { |
my $warning=&scantron_warning_screen('Start Grading'); |
my $warning=&scantron_warning_screen('Start Grading'); |
$r->print(' |
$r->print(&mt('Validation process complete.').'<br /> |
<b>'.&mt('Validation process complete.').'<b><br /> |
|
'.$warning.' |
'.$warning.' |
<input type="submit" name="submit" value="'.&mt('Start Grading').'" /> |
<input type="submit" name="submit" value="'.&mt('Start Grading').'" /> |
<input type="hidden" name="command" value="scantron_process" /> |
<input type="hidden" name="command" value="scantron_process" /> |
Line 6762 sub questions_to_line_list {
|
Line 6916 sub questions_to_line_list {
|
$first = $first_bubble_line{$question-1} + 1; |
$first = $first_bubble_line{$question-1} + 1; |
$count = $bubble_lines_per_response{$question-1}; |
$count = $bubble_lines_per_response{$question-1}; |
} |
} |
my $last = $first+$count-1; |
$last = $first+$count-1; |
push(@lines, ($first..$last)); |
push(@lines, ($first..$last)); |
} |
} |
return join(',', @lines); |
return join(',', @lines); |
Line 6788 for multi and missing bubble cases).
|
Line 6942 for multi and missing bubble cases).
|
Numbered from 0 (but question numbers are from |
Numbered from 0 (but question numbers are from |
1. |
1. |
%first_bubble_line - Starting bubble line for each question. |
%first_bubble_line - Starting bubble line for each question. |
%subdivided_bubble_lines - optionresponse and matchresponse type |
%subdivided_bubble_lines - optionresponse, matchresponse and rankresponse |
problems render as separate sub-questions, |
type problems render as separate sub-questions, |
in exam mode. This hash contains a |
in exam mode. This hash contains a |
comma-separated list of the lines per |
comma-separated list of the lines per |
sub-question. |
sub-question. |
%responsetype_per_response - essayresponse, forumalaresponse, and |
%responsetype_per_response - essayresponse, formularesponse, |
stringresponse type problem parts can have |
stringresponse, imageresponse, reactionresponse, |
|
and organicresponse type problem parts can have |
multiple lines per response if the weight |
multiple lines per response if the weight |
assigned exceeds 10. In this case, only |
assigned exceeds 10. In this case, only |
one bubble per line is permitted, but more |
one bubble per line is permitted, but more |
Line 6828 sub prompt_for_corrections {
|
Line 6983 sub prompt_for_corrections {
|
$r->print(&mt('The group of bubble lines below responds to a single question.').'<br />'); |
$r->print(&mt('The group of bubble lines below responds to a single question.').'<br />'); |
if (($responsetype_per_response{$question-1} eq 'essayresponse') || |
if (($responsetype_per_response{$question-1} eq 'essayresponse') || |
($responsetype_per_response{$question-1} eq 'formularesponse') || |
($responsetype_per_response{$question-1} eq 'formularesponse') || |
($responsetype_per_response{$question-1} eq 'stringresponse')) { |
($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 />'); |
$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 { |
} else { |
$r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />"); |
$r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />"); |
Line 7109 sub scantron_validate_doublebubble {
|
Line 7267 sub scantron_validate_doublebubble {
|
which are the total number of bubble, lines, the number of bubble |
which are the total number of bubble, lines, the number of bubble |
lines for response n and number of the first bubble line for response n, |
lines for response n and number of the first bubble line for response n, |
and a comma separated list of numbers of bubble lines for sub-questions |
and a comma separated list of numbers of bubble lines for sub-questions |
(for optionresponse items only), for response n. |
(for optionresponse, matchresponse, and rankresponse items), for response n. |
|
|
=cut |
=cut |
|
|
Line 7141 sub scantron_get_maxbubble {
|
Line 7299 sub scantron_get_maxbubble {
|
my $response_number = 0; |
my $response_number = 0; |
my $bubble_line = 0; |
my $bubble_line = 0; |
foreach my $resource (@resources) { |
foreach my $resource (@resources) { |
# Need to retrieve part IDs and response IDs because essayresponse |
my $symb = $resource->symb(); |
# items are not included in $analysis{'parts'} from lonnet::ssi. |
# Need to retrieve part IDs and response IDs because essayresponse, |
|
# reactionresponse and organicresponse items are not included in |
|
# $analysis{'parts'} from lonnet::ssi. |
my %possible_part_ids; |
my %possible_part_ids; |
if (ref($resource->parts()) eq 'ARRAY') { |
if (ref($resource->parts()) eq 'ARRAY') { |
foreach my $part (@{$resource->parts()}) { |
foreach my $part (@{$resource->parts()}) { |
my @resp_ids = $resource->responseIds($part); |
if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) { |
foreach my $id (@resp_ids) { |
my @resp_ids = $resource->responseIds($part); |
$possible_part_ids{$part.'.'.$id} = 1; |
foreach my $id (@resp_ids) { |
|
$possible_part_ids{$part.'.'.$id} = 1; |
|
} |
} |
} |
} |
} |
} |
} |
my $result=&Apache::lonnet::ssi($resource->src(), |
my $result=&ssi_with_retries($resource->src(), $ssi_retries, |
('symb' => $resource->symb()), |
('symb' => $symb, |
('grade_target' => 'analyze'), |
'grade_target' => 'analyze', |
('grade_courseid' => $cid), |
'grade_courseid' => $cid, |
('grade_domain' => $udom), |
'grade_domain' => $udom, |
('grade_username' => $uname)); |
'grade_username' => $uname)); |
my (undef, $an) = |
my (undef, $an) = |
split(/_HASH_REF__/,$result, 2); |
split(/_HASH_REF__/,$result, 2); |
|
|
Line 7166 sub scantron_get_maxbubble {
|
Line 7328 sub scantron_get_maxbubble {
|
my %analysis = &Apache::lonnet::str2hash($an); |
my %analysis = &Apache::lonnet::str2hash($an); |
|
|
if (ref($analysis{'parts'}) eq 'ARRAY') { |
if (ref($analysis{'parts'}) eq 'ARRAY') { |
@parts = @{$analysis{'parts'}}; |
foreach my $part (@{$analysis{'parts'}}) { |
|
my ($id,$respid) = split(/\./,$part); |
|
if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { |
|
push(@parts,$part); |
|
} |
|
} |
} |
} |
# Add part_ids for any essayresponse items. |
# Add part_ids for any essayresponse items. |
foreach my $part_id (keys(%possible_part_ids)) { |
foreach my $part_id (keys(%possible_part_ids)) { |
if ($analysis{$part_id.'.type'} eq 'essayresponse') { |
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)) { |
if (!grep(/^\Q$part_id\E$/,@parts)) { |
push (@parts,$part_id); |
push (@parts,$part_id); |
} |
} |
Line 7182 sub scantron_get_maxbubble {
|
Line 7351 sub scantron_get_maxbubble {
|
|
|
# TODO - make this a persistent hash not an array. |
# TODO - make this a persistent hash not an array. |
|
|
# optionresponse and matchresponse type items render as |
# optionresponse, matchresponse and rankresponse type items |
# separate sub-questions in exam mode. |
# render as separate sub-questions in exam mode. |
if (($analysis{$part_id.'.type'} eq 'optionresponse') || |
if (($analysis{$part_id.'.type'} eq 'optionresponse') || |
($analysis{$part_id.'.type'} eq 'matchresponse')) { |
($analysis{$part_id.'.type'} eq 'matchresponse') || |
|
($analysis{$part_id.'.type'} eq 'rankresponse')) { |
my ($numbub,$numshown); |
my ($numbub,$numshown); |
if ($analysis{$part_id.'.type'} eq 'optionresponse') { |
if ($analysis{$part_id.'.type'} eq 'optionresponse') { |
if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') { |
if (ref($analysis{$part_id.'.options'}) eq 'ARRAY') { |
Line 7195 sub scantron_get_maxbubble {
|
Line 7365 sub scantron_get_maxbubble {
|
if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') { |
if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') { |
$numbub = scalar(@{$analysis{$part_id.'.items'}}); |
$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') { |
if (ref($analysis{$part_id.'.shown'}) eq 'ARRAY') { |
$numshown = scalar(@{$analysis{$part_id.'.shown'}}); |
$numshown = scalar(@{$analysis{$part_id.'.shown'}}); |
Line 7262 sub scantron_validate_missingbubbles {
|
Line 7436 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 7301 sub scantron_validate_missingbubbles {
|
Line 7493 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 7335 SCANTRONFORM
|
Line 7530 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 7362 SCANTRONFORM
|
Line 7568 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 7383 SCANTRONFORM
|
Line 7589 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 7688 sub grading_menu {
|
Line 7900 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 8428 sub handler {
|
Line 8638 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 8441 sub handler {
|
Line 8651 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 8528 sub handler {
|
Line 8738 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 ''; |