|
version 1.508, 2008/02/05 18:32:34
|
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 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 5556 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 6030 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 6792 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 6832 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 7113 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 7145 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 7170 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 7186 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 7199 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 7323 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 7357 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 7384 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 7405 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 7710 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 8450 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 8463 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 8550 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 ''; |
![[BACK]](/icons/back.gif){kind=icon}
Return to grades.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework