diff --git a/.github/workflows/unit-tests.yml b/.github/workflows/unit-tests.yml index 02962164ea..f407120912 100644 --- a/.github/workflows/unit-tests.yml +++ b/.github/workflows/unit-tests.yml @@ -28,6 +28,7 @@ jobs: libhtml-parser-perl \ libjson-perl \ libjson-xs-perl \ + libmojolicious-perl \ libtest2-suite-perl \ libtie-ixhash-perl \ libuuid-tiny-perl \ diff --git a/cpanfile b/cpanfile index cf158276ba..e0e274fa98 100644 --- a/cpanfile +++ b/cpanfile @@ -17,6 +17,7 @@ on runtime => sub { requires 'JSON'; requires 'JSON::XS'; requires 'Locale::Maketext'; + requires 'Mojolicious'; requires 'Tie::IxHash'; requires 'Types::Serialiser'; requires 'UUID::Tiny'; diff --git a/docker/pg.Dockerfile b/docker/pg.Dockerfile index ae2fcbc7e5..46c7de14e3 100644 --- a/docker/pg.Dockerfile +++ b/docker/pg.Dockerfile @@ -20,6 +20,7 @@ RUN apt-get update \ libhtml-parser-perl \ libjson-perl \ libjson-xs-perl \ + libmojolicious-perl \ libtest2-suite-perl \ libtie-ixhash-perl \ libuuid-tiny-perl \ diff --git a/htdocs/js/InputColor/color.js b/htdocs/js/InputColor/color.js index 025301ac18..25fa134837 100644 --- a/htdocs/js/InputColor/color.js +++ b/htdocs/js/InputColor/color.js @@ -42,7 +42,7 @@ answerInput.focus(); }); } else { - answerLink.href = ''; + answerLink.removeAttribute('href'); } }; diff --git a/lib/PGcore.pm b/lib/PGcore.pm index c57cbb95ba..28421c1190 100755 --- a/lib/PGcore.pm +++ b/lib/PGcore.pm @@ -97,6 +97,7 @@ sub new { PG_alias => undef, PG_problem_grader => undef, displayMode => undef, + content_post_processors => [], envir => $envir, WARNING_messages => [], DEBUG_messages => [], @@ -563,6 +564,12 @@ sub get_persistent_data { return $self->{PERSISTENCE_HASH}{$label}; } +sub add_content_post_processor { + my ($self, $handler) = @_; + push(@{ $self->{content_post_processors} }, $handler) if ref($handler) eq 'CODE'; + return; +} + sub check_answer_hash { my $self = shift; foreach my $key (keys %{ $self->{PG_ANSWERS_HASH} }) { diff --git a/lib/WeBWorK/PG.pm b/lib/WeBWorK/PG.pm index 475f8d1fb3..87880142fc 100644 --- a/lib/WeBWorK/PG.pm +++ b/lib/WeBWorK/PG.pm @@ -139,7 +139,7 @@ sub new_helper ($invocant, %options) { } } - $translator->translate(); + $translator->translate; # IMPORTANT: The translator environment should not be trusted after the problem code runs. @@ -172,6 +172,8 @@ sub new_helper ($invocant, %options) { ); } + $translator->post_process_content; + # HTML_dpng uses an ImageGenerator. We have to render the queued equations. if ($image_generator) { my $sourceFile = "$options{templateDirectory}$options{sourceFilePath}"; diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index f1563f7d12..e8440e88c7 100644 --- a/lib/WeBWorK/PG/Translator.pm +++ b/lib/WeBWorK/PG/Translator.pm @@ -15,50 +15,40 @@ package WeBWorK::PG::Translator; -use strict; -use warnings; - -use utf8; -use v5.12; -binmode(STDOUT, ":encoding(UTF-8)"); - -use Opcode; -use Carp; - -use WWSafe; -use PGUtil qw(pretty_print); -use WeBWorK::PG::IO qw(fileFromPath); - =head1 NAME WeBWorK::PG::Translator - Evaluate PG code and evaluate answers safely =head1 SYNPOSIS - my $pt = new WeBWorK::PG::Translator; # create a translator + my $pt = WeBWorK::PG::Translator->new; # create a translator $pt->environment(\%envir); # provide the environment variable for the problem - $pt->initialize(); # initialize the translator - $pt-> set_mask(); # set the operation mask for the translator safe compartment + $pt->initialize; # initialize the translator + $pt->set_mask; # set the operation mask for the translator safe compartment + $pt->source_string($source); # provide the source string for the problem + # or + $pt->source_file($sourceFilePath); # provide the proble file containing the source # Load the unprotected macro files. # These files are evaluated with the Safe compartment wide open. # Other macros are loaded from within the problem using loadMacros. - $pt->unrestricted_load("${courseScriptsDirectory}PG.pl"); + # This should not be done if the safe cache is used which is only the case if $ENV{MOJO_MODE} exists. + $pt->unrestricted_load("${pgMacrosDirectory}PG.pl"); - $pt->translate(); # translate the problem (the following pieces of information are created) + $pt->translate; # translate the problem (the following pieces of information are created) - $PG_PROBLEM_TEXT_ARRAY_REF = $pt->ra_text(); # output text for the body of the HTML file (in array form) - $PG_PROBLEM_TEXT_REF = $pt->r_text(); # output text for the body of the HTML file - $PG_HEADER_TEXT_REF = $pt->r_header; # text for the header of the HTML file - $PG_POST_HEADER_TEXT_REF = $pt->r_post_header + $PG_PROBLEM_TEXT_REF = $pt->r_text; # reference to output text for the body of problem + $PG_HEADER_TEXT_REF = $pt->r_header; # reference to text for the header in HTML output + $PG_POST_HEADER_TEXT_REF = $pt->r_post_header; $PG_ANSWER_HASH_REF = $pt->rh_correct_answers; # a hash of answer evaluators $PG_FLAGS_REF = $pt->rh_flags; # misc. status flags. - $pt->process_answers; # evaluates all of the answers + $pt->process_answers; # evaluates all of the answers + my $rh_answer_results = $pt->rh_evaluated_answers; # provides a hash of the results of evaluating the answers. + my $rh_problem_result = $pt->grade_problem(%options); # grades the problem. - my $rh_answer_results = $pt->rh_evaluated_answers; # provides a hash of the results of evaluating the answers. - my $rh_problem_result = $pt->grade_problem; # grades the problem using the default problem grading method. + $pt->post_process_content; # Execute macro or problem hooks that further modify the problem content. =head1 DESCRIPTION @@ -66,6 +56,21 @@ This module defines an object which will translate a problem written in the Prob =cut +use strict; +use warnings; + +use utf8; +use v5.12; +binmode(STDOUT, ":encoding(UTF-8)"); + +use Opcode; +use Carp; +use Mojo::DOM; + +use WWSafe; +use PGUtil qw(pretty_print); +use WeBWorK::PG::IO qw(fileFromPath); + =head2 be_strict This creates a substitute for C which cannot be used in PG problem @@ -146,15 +151,18 @@ BEGIN { } # Also define in Main:: for PG modules. - sub Main::be_strict { return &be_strict; } + sub Main::be_strict { return be_strict(); } } =head2 evaluate_modules - Usage: $obj->evaluate_modules('WWPlot', 'Fun', 'Circle'); +Adds modules to the list of modules which can be used by the PG problems. + +For example, + + $obj->evaluate_modules('LaTeXImage', 'DragNDrop'); -Adds the modules WWPlot.pm, Fun.pm and Circle.pm in the courseScripts directory to the list of modules -which can be used by the PG problems. +adds modules to the C and C modules. =cut @@ -179,13 +187,13 @@ sub evaluate_modules { =head2 load_extra_packages - Usage: $obj->load_extra_packages('AlgParserWithImplicitExpand', - 'Expr','ExprWithImplicitExpand'); +Loads extra packages for modules that contain more than one package. Works in +conjunction with evaluate_modules. It is assumed that the file containing the +extra packages (along with the base package name which is the same as the name +of the file minus the .pm extension) has already been loaded using +evaluate_modules. -Loads extra packages for modules that contain more than one package. Works in conjunction with -evaluate_modules. It is assumed that the file containing the extra packages (along with the base -package name which is the same as the name of the file minus the .pm extension) has already been -loaded using evaluate_modules + Usage: $obj->load_extra_packages('AlgParserWithImplicitExpand', 'ExprWithImplicitExpand'); =cut @@ -209,7 +217,7 @@ sub load_extra_packages { =head2 new - Creates the translator object. +Creates the translator object. =cut @@ -220,25 +228,24 @@ sub new { my $safe_cmpt = exists($ENV{MOJO_MODE}) ? $WeBWorK::Translator::safeCache : WWSafe->new; my $self = { - preprocess_code => \&default_preprocess_code, - postprocess_code => \&default_postprocess_code, - envir => undef, - PG_PROBLEM_TEXT_ARRAY_REF => [], - PG_PROBLEM_TEXT_REF => 0, - PG_HEADER_TEXT_REF => 0, - PG_POST_HEADER_TEXT_REF => 0, - PG_ANSWER_HASH_REF => {}, - PG_FLAGS_REF => {}, - rh_pgcore => undef, - safe => $safe_cmpt, - safe_compartment_name => $safe_cmpt->root, - errors => '', - source => '', - rh_correct_answers => {}, - rh_student_answers => {}, - rh_evaluated_answers => {}, - rh_problem_result => {}, - rh_problem_state => { + preprocess_code => \&default_preprocess_code, + postprocess_code => \&default_postprocess_code, + envir => undef, + PG_PROBLEM_TEXT_REF => 0, + PG_HEADER_TEXT_REF => 0, + PG_POST_HEADER_TEXT_REF => 0, + PG_ANSWER_HASH_REF => {}, + PG_FLAGS_REF => {}, + rh_pgcore => undef, + safe => $safe_cmpt, + safe_compartment_name => $safe_cmpt->root, + errors => '', + source => '', + rh_correct_answers => {}, + rh_student_answers => {}, + rh_evaluated_answers => {}, + rh_problem_result => {}, + rh_problem_state => { recorded_score => 0, num_of_correct_ans => 0, num_of_incorrect_ans => 0, @@ -249,38 +256,19 @@ sub new { return bless $self, $class; } -=pod +=head2 initialize -(b) The following routines defined within the PG module are shared: +The following translator methods are shared to the safe compartment: - &be_strict - &read_whole_problem_file - &surePathToTmpFile - &fileFromPath - &directoryFromPath - &PG_answer_eval - &PG_restricted_eval - &send_mail_to - -In addition the environment hash C<%envir> is shared. This variable is unpacked -when PG.pl is run and provides most of the environment variables for each problem -template. - -=for html - environment variables - -(c) Sharing macros: + &PG_answer_eval + &PG_restricted_eval + &PG_macro_file_eval + &be_strict -The macros shared with the safe compartment are +Also all methods that are exported by WeBWorK::PG::IO are shared. - '&read_whole_problem_file' - '&surePathToTmpFile' - '&fileFromPath' - '&directoryFromPath' - '&PG_answer_eval' - '&PG_restricted_eval' - '&be_strict' - '&send_mail_to' +In addition the environment hash C<%envir> is shared. This variable is unpacked +when PG.pl is run. =cut @@ -443,11 +431,6 @@ sub nameSpace { return $self->{safe}->root; } -sub a_text { - my $self = shift; - return @{ $self->{PG_PROBLEM_TEXT_ARRAY_REF} }; -} - sub header { my $self = shift; return ${ $self->{PG_HEADER_TEXT_REF} }; @@ -473,11 +456,6 @@ sub h_answers { return %{ $self->{PG_ANSWER_HASH_REF} }; } -sub ra_text { - my $self = shift; - return $self->{PG_PROBLEM_TEXT_ARRAY_REF}; -} - sub r_text { my $self = shift; return $self->{PG_PROBLEM_TEXT_REF}; @@ -524,10 +502,10 @@ sub errors { =head2 set_mask -(e) Now we close the safe compartment. Only the certain operations can be used -within PG problems and the PG macro files. These include the subroutines -shared with the safe compartment as defined above and most Perl commands which -do not involve file access, access to the system or evaluation. +Limit allowed operations in the safe compartment. Only the certain operations +can be used within PG problems and the PG macro files. These include the +subroutines shared with the safe compartment as defined above and most Perl +commands which do not involve file access, access to the system or evaluation. Specifically the following are allowed: @@ -644,7 +622,7 @@ sub PG_errorMessage { =head2 Translate -(3) B +B The input text is subjected to some global replacements. @@ -701,26 +679,23 @@ Note that there are several other replacements that are now done that are not documented here. See the C method for all replacements that are done. -(4) B +B Evaluate the text within the safe compartment. Save the errors. The safe compartment is a new one unless the $safeCompartment was set to zero in which case the previously defined safe compartment is used. (See item 1.) -(5) B +B The error provided by Perl is truncated slightly and returned. In the text string which would normally contain the rendered problem. The original text string is given line numbers and concatenated to the errors. -(6) B +B Sets the following hash keys of the translator object: - PG_PROBLEM_TEXT_ARRAY_REF: Reference to an array of strings containing the - rendered text. - PG_PROBLEM_TEXT_REF: Reference to a string resulting from joining the above - array with the empty string. + PG_PROBLEM_TEXT_REF: Reference to a string containing the rendered text. PG_HEADER_TEXT_REF: Reference to a string containing material to be placed in the header. PG_POST_HEADER_TEXT_REF: Reference to a string containing material to @@ -737,10 +712,9 @@ Sets the following hash keys of the translator object: my %XML = ('&' => '&', '<' => '<', '>' => '>', '"' => '"', '\'' => '''); sub translate { - my $self = shift; - my @PROBLEM_TEXT_OUTPUT = (); - my $safe_cmpt = $self->{safe}; - my $evalString = $self->{source}; + my $self = shift; + my $safe_cmpt = $self->{safe}; + my $evalString = $self->{source}; $self->{errors} .= qq{ERROR: This problem file was empty!\n} unless ($evalString); $self->{errors} .= qq{ERROR: You must define the environment before translating.} unless defined($self->{envir}); @@ -783,6 +757,7 @@ sub translate { # WARNING and DEBUG tracks are being handled elsewhere (in Problem.pm?) $self->{errors} .= "ERRORS from evaluating PG file:\n$@\n" if $@; + my @PROBLEM_TEXT_OUTPUT; push(@PROBLEM_TEXT_OUTPUT, split(/^/, $$PG_PROBLEM_TEXT_REF)) if ref($PG_PROBLEM_TEXT_REF) eq 'SCALAR'; # This is better than using defined($$PG_PROBLEM_TEXT_REF) # Because more pleasant feedback is given when the problem doesn't render. @@ -836,11 +811,10 @@ sub translate { } } - $PG_FLAGS_REF->{'error_flag'} = 1 if $self->{errors}; + $PG_FLAGS_REF->{error_flag} = 1 if $self->{errors}; my $PG_PROBLEM_TEXT = join("", @PROBLEM_TEXT_OUTPUT); - $self->{PG_PROBLEM_TEXT_REF} = \$PG_PROBLEM_TEXT; - $self->{PG_PROBLEM_TEXT_ARRAY_REF} = \@PROBLEM_TEXT_OUTPUT; + $self->{PG_PROBLEM_TEXT_REF} = \$PG_PROBLEM_TEXT; # Make sure that these variables are defined. If the eval failed with # errors, one or more of these variables won't be defined. @@ -858,7 +832,7 @@ sub translate { =cut -=head3 access methods +=head3 access methods $obj->rh_student_answers @@ -1200,6 +1174,68 @@ sub avg_problem_grader { return (\%problem_result, \%problem_state); } +=head2 post_process_content + +Call hooks added via macros or the problem via C to +post process content. Hooks are called in the order they were added. + +This method should be called in the rendering process after answer processing +has occurred. + +If the display mode is TeX, then each hook subroutine is passed a reference to +the problem text string generated in the C method. + +For all other display modes each hook subroutine is passed two Mojo::DOM +objects. The first containing the parsed problem text string, and the second +contains the parsed header text string, both of which were generated in the +C method. After all hooks are called and modifications are made to +the Mojo::DOM contents by the hooks, the Mojo::DOM objects are converted back to +strings and the translator problem text and header references are updated with +the contents of those strings. + +=cut + +sub post_process_content { + my $self = shift; + + my $outer_sig_warn = $SIG{__WARN__}; + my @warnings; + local $SIG{__WARN__} = sub { push(@warnings, $_[0]) }; + + my $outer_sig_die = $SIG{__DIE__}; + local $SIG{__DIE__} = sub { + ref $outer_sig_die eq "CODE" + ? $outer_sig_die->(PG_errorMessage('traceback', $_[0])) + : die PG_errorMessage('traceback', $_[0]); + }; + + if ($self->{rh_pgcore}{displayMode} eq 'TeX') { + our $PG_PROBLEM_TEXT_REF = $self->{PG_PROBLEM_TEXT_REF}; + $self->{safe}->share('$PG_PROBLEM_TEXT_REF'); + $self->{safe}->reval('for (@{ $main::PG->{content_post_processors} }) { $_->($PG_PROBLEM_TEXT_REF); }', 1); + warn "ERRORS from post processing PG text:\n$@\n" if $@; + } else { + $self->{safe}->share_from('main', [qw(%Mojo::Base:: %Mojo::Collection:: %Mojo::DOM::)]); + our $problemDOM = Mojo::DOM->new(${ $self->{PG_PROBLEM_TEXT_REF} }); + $problemDOM->xml(1) if $self->{rh_pgcore}{displayMode} eq 'PTX'; + our $pageHeader = Mojo::DOM->new(${ $self->{PG_HEADER_TEXT_REF} }); + $self->{safe}->share('$problemDOM', '$pageHeader'); + $self->{safe}->reval('for (@{ $main::PG->{content_post_processors} }) { $_->($problemDOM, $pageHeader); }', 1); + warn "ERRORS from post processing PG text:\n$@\n" if $@; + + $self->{PG_PROBLEM_TEXT_REF} = \($problemDOM->to_string); + $self->{PG_HEADER_TEXT_REF} = \($pageHeader->to_string); + } + + if (@warnings) { + ref $outer_sig_warn eq "CODE" + ? $outer_sig_warn->(PG_errorMessage('message', @warnings)) + : warn PG_errorMessage('message', @warnings); + } + + return; +} + =head2 PG_restricted_eval PG_restricted_eval($string) @@ -1228,7 +1264,7 @@ sub PG_restricted_eval { my $out = PG_restricted_eval_helper($string); my $err = $@; - my $err_report = $err if $err =~ /\S/; + my $err_report = $err =~ /\S/ ? $err : undef; return wantarray ? ($out, $err, $err_report) : $out; } diff --git a/macros/PG.pl b/macros/PG.pl index 913b9c1636..c30fbdfb83 100644 --- a/macros/PG.pl +++ b/macros/PG.pl @@ -578,6 +578,12 @@ sub get_persistent_data { return $PG->get_persistent_data($label); } +sub add_content_post_processor { + my $handler = shift; + $PG->add_content_post_processor($handler); + return; +} + =head2 RECORD_FORM_LABEL Stores the label of a form field in the "extra" answers list. This is used to @@ -826,7 +832,7 @@ =head2 ENDDOCUMENT sub ENDDOCUMENT { # Insert MathQuill responses if MathQuill is enabled. Add responses to each answer's response group that store the # latex form of the students' answers and add corresponding hidden input boxes to the page. - if ($envir{useMathQuill}) { + if ($envir{useMathQuill} && $main::displayMode ne 'PTX') { for my $answerLabel (keys %{ $PG->{PG_ANSWERS_HASH} }) { my $answerGroup = $PG->{PG_ANSWERS_HASH}{$answerLabel}; my $mq_opts = $answerGroup->{ans_eval}{rh_ans}{mathQuillOpts} // {}; @@ -875,147 +881,111 @@ sub ENDDOCUMENT { my $answer_value = ''; $answer_value = $inputs_ref->{$name} if defined($inputs_ref->{$name}); RECORD_EXTRA_ANSWERS($name); - $answer_value = encode_pg_and_html($answer_value); - my $data_mq_opts = - scalar(keys %$mq_part_opts) - ? qq!data-mq-opts="@{[encode_pg_and_html(JSON->new->encode($mq_part_opts))]}"! - : ""; - TEXT(MODES( - TeX => "", - PTX => "", - HTML => qq!! - )); + my $data_mq_opts = scalar(keys %$mq_part_opts) ? JSON->new->encode($mq_part_opts) : ''; + add_content_post_processor(sub { + my $problemContents = shift; + return if $main::displayMode eq 'TeX'; + my $input = $problemContents->at(qq{input[name="$response"]}); + return unless $input; + $input->append( + Mojo::DOM->new_tag( + 'input', + type => 'hidden', + name => $name, + id => $name, + value => $answer_value, + $data_mq_opts ? (data => { mq_opts => $data_mq_opts }) : '' + )->to_string + ); + }); } } } - # check that answers match - # gather up PG_FLAGS elements - - $PG->{flags}->{showPartialCorrectAnswers} = defined($showPartialCorrectAnswers) ? $showPartialCorrectAnswers : 1; - $PG->{flags}->{recordSubmittedAnswers} = defined($recordSubmittedAnswers) ? $recordSubmittedAnswers : 1; - $PG->{flags}->{refreshCachedImages} = defined($refreshCachedImages) ? $refreshCachedImages : 0; - $PG->{flags}->{hintExists} = defined($hintExists) ? $hintExists : 0; - $PG->{flags}->{solutionExists} = defined($solutionExists) ? $solutionExists : 0; - $PG->{flags}->{comment} = defined($pgComment) ? $pgComment : ''; - - # install problem grader - if (defined($PG->{flags}->{PROBLEM_GRADER_TO_USE})) { - # problem grader defined within problem -- no further action needed + # Gather flags + $PG->{flags}{showPartialCorrectAnswers} = $showPartialCorrectAnswers // 1; + $PG->{flags}{recordSubmittedAnswers} = $recordSubmittedAnswers // 1; + $PG->{flags}{refreshCachedImages} = $refreshCachedImages // 0; + $PG->{flags}{hintExists} = $hintExists // 0; + $PG->{flags}{solutionExists} = $solutionExists // 0; + $PG->{flags}{comment} = $pgComment // ''; + + # Install problem grader. + # WeBWorK::PG::Translator will install its default problem grader if none of the conditions below are true. + if (defined($PG->{flags}{PROBLEM_GRADER_TO_USE})) { + # Problem grader defined within problem. No further action needed. } elsif (defined($rh_envir->{PROBLEM_GRADER_TO_USE})) { - if (ref($rh_envir->{PROBLEM_GRADER_TO_USE}) eq 'CODE') { # user defined grader - $PG->{flags}->{PROBLEM_GRADER_TO_USE} = $rh_envir->{PROBLEM_GRADER_TO_USE}; + if (ref($rh_envir->{PROBLEM_GRADER_TO_USE}) eq 'CODE') { + # User defined grader. + $PG->{flags}{PROBLEM_GRADER_TO_USE} = $rh_envir->{PROBLEM_GRADER_TO_USE}; } elsif ($rh_envir->{PROBLEM_GRADER_TO_USE} eq 'std_problem_grader') { - if (defined(&std_problem_grader)) { - $PG->{flags}->{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl - } # std_problem_grader is the default in any case so don't give a warning. + $PG->{flags}{PROBLEM_GRADER_TO_USE} = \&std_problem_grader if (defined(&std_problem_grader)); } elsif ($rh_envir->{PROBLEM_GRADER_TO_USE} eq 'avg_problem_grader') { - if (defined(&avg_problem_grader)) { - $PG->{flags}->{PROBLEM_GRADER_TO_USE} = \&avg_problem_grader; # defined in PGanswermacros.pl - } + $PG->{flags}{PROBLEM_GRADER_TO_USE} = \&avg_problem_grader if (defined(&avg_problem_grader)); } else { - warn "Error: " . $PG->{flags}->{PROBLEM_GRADER_TO_USE} . "is not a known program grader."; + warn "Error: $PG->{flags}{PROBLEM_GRADER_TO_USE} is not a known problem grader."; } } elsif (defined(&std_problem_grader)) { - $PG->{flags}->{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl - } else { - # PGtranslator will install its default problem grader + $PG->{flags}{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; } - # add javaScripts - if ($rh_envir->{displayMode} eq 'HTML_jsMath') { - TEXT(''); - } elsif ($rh_envir->{displayMode} eq 'HTML_asciimath') { - TEXT(''); - my $STRING = join("", @{ $PG->{HEADER_ARRAY} }); - unless ($STRING =~ m/mathplayer/) { - HEADER_TEXT('' . "\n" - . ''); - } - - } TEXT(MODES(%{ $rh_envir->{problemPostamble} })); - @PG_ANSWERS = (); if ($inputs_ref->{showResourceInfo} && $rh_envir->{show_resource_info}) { - my %resources = %{ $PG->{PG_alias}->{resource_list} }; - my $str = ''; - my @resource_names = (); - foreach my $key (keys %resources) { - $str .= knowlLink("$key$BR", value => "$key$BR" . pretty_print($resources{$key}) . "$BR$BR", base64 => 0); - push @resource_names, $key; - } - if ($str eq '') { - $str = "No auxiliary resources
"; + if (keys %{ $PG->{PG_alias}{resource_list} }) { + $PG->debug_message( + '

Resources

    ' . join( + '', + map { + '
  • ' . knowlLink($_, value => pretty_print($PG->{PG_alias}{resource_list}{$_})) . '
    • ' + } + sort keys %{ $PG->{PG_alias}{resource_list} } + ) + . '
' + ); } else { - my $summary = "## RESOURCES('" . join("','", @resource_names) . "')$BR\n"; - $PG->debug_message($summary . $str); + $PG->debug_message('No auxiliary resources.'); } } + if ($inputs_ref->{showPGInfo} && $rh_envir->{show_pg_info}) { my $context = $$Value::context->{flags}; $PG->debug_message( - $HR, "Form variables", $BR, pretty_print($inputs_ref), $HR, "Environment variables", - $BR, pretty_print(\%envir), $HR, "Context flags", $BR, pretty_print($context), + "$HR

Form variables

" . pretty_print($inputs_ref) . '
', + "$HR

Environment variables

" . pretty_print(\%envir) . '
', + "$HR

Context flags

" . pretty_print($context) . '
' ); } - #warn keys %{ $PG->{PG_ANSWERS_HASH} }; - @PG_ANSWER_ENTRY_ORDER = (); - my $ans_debug = 0; - foreach my $key (keys %{ $PG->{PG_ANSWERS_HASH} }) { - $answergroup = $PG->{PG_ANSWERS_HASH}->{$key}; - #warn "$key is defined =", defined($answergroup), "PG object is $PG"; - ################# + my (%PG_ANSWERS_HASH, @PG_ANSWER_ENTRY_ORDER); + for my $key (keys %{ $PG->{PG_ANSWERS_HASH} }) { + my $answergroup = $PG->{PG_ANSWERS_HASH}{$key}; + # EXTRA ANSWERS KLUDGE - ################# - # The first response in each answer group is placed in @PG_ANSER_ENTRY_ORDER and %PG_ANSWERS_HASH - # The remainder of the response keys are placed in the EXTRA ANSWERS ARRAY - if (defined($answergroup)) { - my @response_keys = $answergroup->{response}->response_labels; + # The first response label in each answer group is placed in the @PG_ANSWER_ENTRY_ORDER array, and the first + # response evaluator is placed in %PG_ANSWERS_HASH identified by its label. The remainder of the response + # labels are placed in the @KEPT_EXTRA_ANSWERS array. + if (defined $answergroup) { if ($inputs_ref->{showAnsGroupInfo} && $rh_envir->{show_answer_group_info}) { $PG->debug_message(pretty_print($answergroup)); $PG->debug_message(pretty_print($answergroup->{response})); } - my $response_key = $response_keys[0]; - my $answer_key = $answergroup->{ans_label}; - #unshift @response_keys, $response_key unless ($response_key eq $answer_group->{ans_label}); - # don't save the first response key if it is the same as the ans_label - # maybe we should insure that the first response key is always the same as the answer label? - # warn "first response key label and answer key label don't agree" - # unless ($response_key eq $answer_key); - - # even if no answer blank is printed for it? or a hidden answer blank? - # this is still a KLUDGE - # for compatibility the first response key is closer to the old method than the $ans_label - # this is because a response key might indicate an array but an answer label won't - #push @PG_ANSWERS, $response_key,$answergroup->{ans_eval}; - $PG_ANSWERS_HASH{$answer_key} = $answergroup->{ans_eval}; - push @PG_ANSWER_ENTRY_ORDER, $answer_key; - # @KEPT_EXTRA_ANSWERS could be replaced by saving all of the responses for this answergroup - push @KEPT_EXTRA_ANSWERS, @response_keys; + + $PG_ANSWERS_HASH{ $answergroup->{ans_label} } = $answergroup->{ans_eval}; + push @PG_ANSWER_ENTRY_ORDER, $answergroup->{ans_label}; + + push @KEPT_EXTRA_ANSWERS, $answergroup->{response}->response_labels; } else { - warn "$key is ", join("|", %{ $PG->{PG_ANSWERS_HASH}->{$key} }); + warn "$key does not have a valid answer group."; } } - $PG->{flags}->{KEPT_EXTRA_ANSWERS} = \@KEPT_EXTRA_ANSWERS; - $PG->{flags}->{ANSWER_ENTRY_ORDER} = \@PG_ANSWER_ENTRY_ORDER; - - # these should not be needed any longer since PG_alias warning queue is attached to PGcore's - # $PG->warning_message( @{ $PG->{PG_alias}->{flags}->{WARNING_messages}} ); - # $PG->debug_message( @{ $PG->{PG_alias}->{flags}->{DEBUG_messages}} ); - - warn "KEPT_EXTRA_ANSWERS", join(" ", @KEPT_EXTRA_ANSWERS), $BR if $ans_debug == 1; - warn "PG_ANSWER_ENTRY_ORDER", join(" ", @PG_ANSWER_ENTRY_ORDER), $BR if $ans_debug == 1; - # not needed for the moment: - # warn "DEBUG messages", join( "$BR",@{$PG->get_debug_messages} ) if $ans_debug==1; - warn "INTERNAL_DEBUG messages", join("$BR", @{ $PG->get_internal_debug_messages }) if $ans_debug == 1; - $STRINGforOUTPUT = join("", @{ $PG->{OUTPUT_ARRAY} }); - $STRINGforHEADER_TEXT = join("", @{ $PG->{HEADER_ARRAY} }); - $STRINGforPOSTHEADER_TEXT = join("", @{ $PG->{POST_HEADER_ARRAY} }); - # warn pretty_print($PG->{PG_ANSWERS_HASH}); - #warn "printing another warning"; + $PG->{flags}{KEPT_EXTRA_ANSWERS} = \@KEPT_EXTRA_ANSWERS; + $PG->{flags}{ANSWER_ENTRY_ORDER} = \@PG_ANSWER_ENTRY_ORDER; + + my $STRINGforOUTPUT = join('', @{ $PG->{OUTPUT_ARRAY} }); + my $STRINGforHEADER_TEXT = join('', @{ $PG->{HEADER_ARRAY} }); + my $STRINGforPOSTHEADER_TEXT = join('', @{ $PG->{POST_HEADER_ARRAY} }); (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT, \$STRINGforPOSTHEADER_TEXT, \%PG_ANSWERS_HASH, $PG->{flags}, $PG); } diff --git a/t/pg_problems/problem_file.t b/t/pg_problems/problem_file.t index 03ab3842a0..c823c31591 100644 --- a/t/pg_problems/problem_file.t +++ b/t/pg_problems/problem_file.t @@ -23,11 +23,11 @@ is( qq{
\n} . qq{Enter a value for .\n} . qq{
\n} - . qq{} - . qq{\n} - . qq{
\n} - . qq{}, + . qq{} + . qq{} + . qq{\n} + . qq{\n}, 'body_text has correct content' );