Problem!.
$self->{envir} ->{'probNum'}.
qq!\nERROR caught by PGtranslator while processing problem file:! .
$self->{envir}->{'probFileName'}.
"\n****************\r\n" .
$self -> {errors}."\r\n" .
"**************** \r\n");
}
=pod
(6) B
Returns:
$PG_PROBLEM_TEXT_ARRAY_REF -- Reference to a string containing the rendered text.
$PG_HEADER_TEXT_REF -- Reference to a string containing material to placed in the header (for use by JavaScript)
$PG_ANSWER_HASH_REF -- Reference to an array containing the answer evaluators.
$PG_FLAGS_REF -- Reference to a hash containing flags and other references:
'error_flag' is set to 1 if there were errors in rendering
=cut
## we need to make sure that the other output variables are defined
## If the eval failed with errors, one or more of these variables won't be defined.
$PG_ANSWER_HASH_REF = {} unless defined($PG_ANSWER_HASH_REF);
$PG_HEADER_TEXT_REF = \( "" ) unless defined($PG_HEADER_TEXT_REF);
$PG_FLAGS_REF = {} unless defined($PG_FLAGS_REF);
$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_HEADER_TEXT_REF } = $PG_HEADER_TEXT_REF;
$self ->{ rh_correct_answers } = $PG_ANSWER_HASH_REF;
$self ->{ PG_FLAGS_REF } = $PG_FLAGS_REF;
$SIG{__DIE__} = $save_SIG_die_trap;
$self ->{errors};
} # end translate
=head2 Answer evaluation methods
=cut
=head3 access methods
$obj->rh_student_answers
=cut
sub rh_evaluated_answers {
my $self = shift;
my @in = @_;
return $self->{rh_evaluated_answers} if @in == 0;
if ( ref($in[0]) eq 'HASH' ) {
$self->{rh_evaluated_answers} = { %{ $in[0] } }; # store a copy of the hash
} else {
$self->{rh_evaluated_answers} = { @in }; # store a copy of the hash
}
$self->{rh_evaluated_answers};
}
sub rh_problem_result {
my $self = shift;
my @in = @_;
return $self->{rh_problem_result} if @in == 0;
if ( ref($in[0]) eq 'HASH' ) {
$self->{rh_problem_result} = { %{ $in[0] } }; # store a copy of the hash
} else {
$self->{rh_problem_result} = { @in }; # store a copy of the hash
}
$self->{rh_problem_result};
}
sub rh_problem_state {
my $self = shift;
my @in = @_;
return $self->{rh_problem_state} if @in == 0;
if ( ref($in[0]) eq 'HASH' ) {
$self->{rh_problem_state} = { %{ $in[0] } }; # store a copy of the hash
} else {
$self->{rh_problem_state} = { @in }; # store a copy of the hash
}
$self->{rh_problem_state};
}
=head3 process_answers
$obj->process_answers()
=cut
sub process_answers{
my $self = shift;
my @in = shift;
my %h_student_answers;
if (ref($in[0]) eq 'HASH' ) {
%h_student_answers = %{ $in[0] };
} else {
%h_student_answers = @in;
}
my $rh_correct_answers = $self->rh_correct_answers();
my @answer_entry_order = ( defined($self->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ?
@{$self->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}} : keys %{$rh_correct_answers};
# apply each instructors answer to the corresponding student answer
foreach my $ans_name ( @answer_entry_order ) {
my ($ans, $errors) = $self->filter_answer( $h_student_answers{$ans_name} );
no strict;
# evaluate the answers inside the safe compartment.
local($rf_fun,$temp_ans) = (undef,undef);
if ( defined($rh_correct_answers ->{$ans_name} ) ) {
$rf_fun = $rh_correct_answers->{$ans_name};
} else {
warn "There is no answer evaluator for the question labeled $ans_name";
}
$temp_ans = $ans;
$temp_ans = '' unless defined($temp_ans); #make sure that answer is always defined
# in case the answer evaluator forgets to check
$self->{safe}->share('$rf_fun','$temp_ans');
# reset the error detection
my $save_SIG_die_trap = $SIG{__DIE__};
$SIG{__DIE__} = sub {CORE::die(@_) };
my $rh_ans_evaluation_result;
if (ref($rf_fun) eq 'CODE' ) {
$rh_ans_evaluation_result = $self->{safe} ->reval( '&{ $rf_fun }($temp_ans)' ) ;
warn "Error in PGtranslator.pm::process_answers: Answer $ans_name:.
=cut
sub send_mail_to {
my $user_address = shift; # user must be an instructor
my %options = @_;
my $subject = '';
$subject = $options{'subject'} if defined($options{'subject'});
my $msg_body = '';
$msg_body =$options{'body'} if defined($options{'body'});
my @mail_to_allowed_list = ();
@mail_to_allowed_list = @{ $options{'ALLOW_MAIL_TO'} } if defined($options{'ALLOW_MAIL_TO'});
my $out;
# check whether user is an instructor
my $mailing_allowed_flag =0;
while (@mail_to_allowed_list) {
if ($user_address eq shift @mail_to_allowed_list ) {
$mailing_allowed_flag =1;
last;
}
}
if ($mailing_allowed_flag) {
## mail header text:
my $email_msg ="To: $user_address\n" .
"X-Remote-Host: $REMOTE_HOST($REMOTE_ADDR)\n" .
"Subject: $subject\n\n" . $msg_body;
my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>10) ||
warn "Couldn't contact SMTP server.";
$smtp->mail($Global::webmaster);
if ( $smtp->recipient($user_address)) { # this one's okay, keep going
$smtp->data( $email_msg) ||
warn("Unknown problem sending message data to SMTP server.");
} else { # we have a problem a problem with this address
$smtp->reset;
warn "SMTP server doesn't like this address: <$user_address>.";
}
$smtp->quit;
} else {
Global::wwerror("$0","There has been an error in creating this problem.\n" .
"Please notify your instructor.\n\n" .
"Mail is not permitted to address $user_address.\n" .
"Permitted addresses are specified in the courseWeBWorK.ph file.",
"","","");
$out = 0;
}
$out;
}
# only files are loaded first from the macroDirectory and then from the courseScriptsDirectory
# files cannot be loaded from other directories.
#
# # these have been copied over from FILE.pl. I don't know if they need to be duplicated or not.
# ## these call backs come from PGchoice -- mostly from within the alias command.
#
=head2 read_whole_problem_file
read_whole_problem_file($filePath);
Returns: A reference to a string containing
the contents of the file.
Don't use for huge files. The file name will have .pg appended to it if it doesn't
already end in .pg. Files may become double spaced.? Check the join below. This is
used in importing additional .pg files as is done in the
sample problems translated from CAPA.
=cut
sub read_whole_problem_file {
my $filePath = shift;
$filePath =~s/^\s*//; # get rid of initial spaces
$filePath =~s/\s*$//; # get rid of final spaces
$filePath = "$filePath.pg" unless $filePath =~ /\.pg$/;
read_whole_file($filePath);
}
sub read_whole_file {
my $filePath = shift;
local (*INPUT);
open(INPUT, "<$filePath")|| die "$0: readWholeProblemFile subroutine: .
=cut
sub convertPath {
&main::convertPath;
}
=head2 surePathToTmpFile
surePathToTmpFile($path)
Returns: $path
Defined in FILE.pl
Creates all of the subdirectories between the directory specified
by C<&getCourseTempDirectory> and the address of the path.
Uses
&createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
The path may begin with the correct path to the temporary
directory. Any other prefix causes a path relative to the temporary
directory to be created.
The quality of the error checking could be improved. :-)
=cut
sub surePathToTmpFile {
&main::surePathToTmpFile;
}
=head2 fileFromPath
$fileName = fileFromPath($path)
Defined in C.
Uses C<&getDirDelim()> to determine the path delimiter. Returns the last segment
of the path (after the last delimiter.)
=cut
sub fileFromPath {
&main::fileFromPath;
}
=head2 directoryFromPath
$directoryPath = directoryFromPath($path)
Defined in C.
Uses C<&getDirDelim()> to determine the path delimiter. Returns the initial segments
of the of the path (up to the last delimiter.)
=cut
sub directoryFromPath {
&main::directoryFromPath;
}
=head2 createFile
createFile($filePath);
Calls C version of createFile with
C
=cut
sub createFile {
my $filePath = shift;
&main::createFile($filePath, 0660,0);
}
# This sort can cause troubles because of its special use of $a and $b
# Putting it in dangerousMacros.pl worked frequently, but not always.
# In particular ANS( ans_eva1 ans_eval2) caused trouble.
# One answer at a time did not --- very strange.
=head2 PGsort
Because of the way sort is optimized in Perl, the symbols $a and $b
have special significance.
C$b} @list>
C
sorts the list numerically and lexically respectively.
If C is used in a problem, before the sort routine is defined in a macro, then
things get badly confused. To correct this, the following macros are defined in
dangerougMacros.pl which is evaluated before the problem template is read.
PGsort sub { $_[0] <=> $_[1] }, @list;
PGsort sub { $_[0] cmp $_[1] }, @list;
provide slightly slower, but safer, routines for the PG language. (The subroutines
for ordering are B. Note the commas!)
=cut
sub PGsort {
my $sort_order = shift;
die "Must supply an ordering function with PGsort: PGsort sub {\$a cmp \$b }, \@list\n" unless ref($sort_order) eq 'CODE';
sort {&$sort_order($a,$b)} @_;
}
=head2 includePGtext
includePGtext($string_ref, $envir_ref)
Calls C recursively with the $safeCompartment variable set to 0
so that the rendering continues in the current safe compartment. The output
is the same as the output from createPGtext. This is used in processing
some of the sample CAPA files.
=cut
#this is a method for importing additional PG files from within one PG file.
# sub includePGtext {
# my $self = shift;
# my $string_ref =shift;
# my $envir_ref = shift;
# $self->environment($envir_ref);
# $self->createPGtext($string_ref);
# }
# evaluation macros
no strict; # this is important -- I guess because eval operates on code which is not written with strict in mind.
=head2 PG_restricted_eval
PG_restricted_eval($string)
Evaluated in package 'main'. Result of last statement is returned.
When called from within a safe compartment the safe compartment package
is 'main'.
=cut
sub PG_restricted_eval {
local($string) = shift; # local seems to be essential to make sure that the right version of $string is evaluated
# Using my, things would work unless the contents of $string contained '$string'
# Wheeeeeeeeeeee!!!!!!
my ($pck,$file,$line) = caller;
my $save_SIG_warn_trap = $SIG{__WARN__};
$SIG{__WARN__} = sub { CORE::die @_};
my $save_SIG_die_trap = $SIG{__DIE__};
$SIG{__DIE__}= sub {CORE::die @_};
no strict;
my $out = eval ("package main; " . $string );
my $errors =$@;
my $full_error_report = "PG_restricted_eval detected error at line $line of file $file \n"
. $errors .
"The calling package is $pck\n" if defined($errors) && $errors =~/\S/;
use strict;
$SIG{__DIE__} = $save_SIG_die_trap;
$SIG{__WARN__} = $save_SIG_warn_trap;
return (wantarray) ? ($out, $errors,$full_error_report) : $out;
}
=head2 PG_answer_eval
PG_answer_eval($string)
Evaluated in package defined by the current safe compartment.
Result of last statement is returned.
When called from within a safe compartment the safe compartment package
is 'main'.
There is still some confusion about how these two evaluation subroutines work
and how best to define them. It is useful to have two evaluation procedures
since at some point one might like to make the answer evaluations more stringent.
=cut
sub PG_answer_eval {
local($string) = shift; # I made this local just in case -- see PG_estricted_eval
my $errors = '';
my $full_error_report = '';
my ($pck,$file,$line) = caller;
# Because of the global variable $PG::compartment_name and $PG::safe_cmpt
# only one problem safe compartment can be active at a time.
# This might cause problems at some point. In that case a cleverer way
# of insuring that the package stays in scope until the answer is evaluated
# will be required.
# This is pretty tricky and doesn't always work right.
# We seem to need PG_priv instead of main when PG_answer_eval is called within a completion
# 'package PG_priv; '
my $save_SIG_warn_trap = $SIG{__WARN__};
$SIG{__WARN__} = sub { CORE::die @_};
my $save_SIG_die_trap = $SIG{__DIE__};
$SIG{__DIE__}= sub {CORE::die @_};
my $save_SIG_FPE_trap= $SIG{'FPE'};
#$SIG{'FPE'} = \&main::PG_floating_point_exception_handler;
#$SIG{'FPE'} = sub {exit(0)};
no strict;
my $out = eval('package main;'.$string);
$out = '' unless defined($out);
$errors .=$@;
$full_error_report = "ERROR: at line $line of file $file
$errors
The calling package is $pck\n" if defined($errors) && $errors =~/\S/;
use strict;
$SIG{__DIE__} = $save_SIG_die_trap;
$SIG{__WARN__} = $save_SIG_warn_trap;
$SIG{'FPE'} = $save_SIG_FPE_trap;
return (wantarray) ? ($out, $errors,$full_error_report) : $out;
}
sub dumpvar {
my ($packageName) = @_;
local(*alias);
sub emit {
print @_;
}
*stash = *{"${packageName}::"};
$, = " ";
emit "Content-type: text/html\n\n\n";
while ( ($varName, $globValue) = each %stash) {
emit "$varName\n";
*alias = $globValue;
next if $varName=~/main/;
if (defined($alias) ) {
emit " \$$varName $alias \n";
}
if ( defined(@alias) ) {
emit " \@$varName @alias \n";
}
if (defined(%alias) ) {
emit " %$varName \n";
foreach $key (keys %alias) {
emit " $key => $alias{$key}\n";
}
}
}
emit " ";
}
use strict;
#### for error checking and debugging purposes
sub pretty_print_rh {
my $rh = shift;
foreach my $key (sort keys %{$rh}) {
warn " $key => ",$rh->{$key},"\n";
}
}
# end evaluation subroutines
1;