[system] / branches / gage_dev / pg / lib / WeBWorK / PG / Translator.pm Repository:
ViewVC logotype

Diff of /branches/gage_dev/pg/lib/WeBWorK/PG/Translator.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 6164 Revision 6244
… …
9use warnings; 9use warnings;
10use Opcode; 10use Opcode;
11use Safe; 11use Safe;
12use Net::SMTP; 12use Net::SMTP;
13use WeBWorK::PG::IO; 13use WeBWorK::PG::IO;
14
15#use PadWalker; # used for processing error messages
16#use Data::Dumper;
14 17
15 18
16# loading GD within the Safe compartment has occasionally caused infinite recursion 19# loading GD within the Safe compartment has occasionally caused infinite recursion
17# Putting these use statements here seems to avoid this problem 20# Putting these use statements here seems to avoid this problem
18# It is not clear that this is essential once things are working properly. 21# It is not clear that this is essential once things are working properly.
… …
387# 390#
388# PG.pl, IO.pl and dangerousMacros.pl are loaded without restriction 391# PG.pl, IO.pl and dangerousMacros.pl are loaded without restriction
389# All other files are loaded with restriction 392# All other files are loaded with restriction
390# 393#
391 # construct a regex that matches only these three files safely 394 # construct a regex that matches only these three files safely
392 my @unrestricted_files = qw/PG.pl dangerousMacros.pl IO.pl/; 395 my @unrestricted_files = (); # no longer needed? FIXME w/PG.pl dangerousMacros.pl IO.pl/;
393 my $unrestricted_files = join("|", map { quotemeta } @unrestricted_files); 396 my $unrestricted_files = join("|", map { quotemeta } @unrestricted_files);
394 397
395 my $store_mask; 398 my $store_mask;
396 if ($fileName =~ /^($unrestricted_files)$/) { 399 if ($fileName =~ /^($unrestricted_files)$/) {
397 $store_mask = $cached_safe_cmpt->mask(); 400 $store_mask = $cached_safe_cmpt->mask();
… …
534 my $safe_cmpt_package_name = $safe_cmpt->root(); 537 my $safe_cmpt_package_name = $safe_cmpt->root();
535 538
536 my $macro_file_name = fileFromPath($filePath); 539 my $macro_file_name = fileFromPath($filePath);
537 $macro_file_name =~s/\.pl//; # trim off the extenstion 540 $macro_file_name =~s/\.pl//; # trim off the extenstion
538 my $export_subroutine_name = "_${macro_file_name}_export"; 541 my $export_subroutine_name = "_${macro_file_name}_export";
539 my $init_subroutine_name = "_${macro_file_name}_init"; 542 my $init_subroutine_name = "${safe_cmpt_package_name}::_${macro_file_name}_init";
543
540 my $local_errors = ""; 544 my $local_errors = "";
541 no strict; 545 no strict;
542 # warn "dangerousMacros main:: contains <br>\n ".join("<br>\n ", %main::) if $debugON; 546 # warn "dangerousMacros main:: contains <br>\n ".join("<br>\n ", %main::) if $debugON;
543 my $init_subroutine = eval { \&{"${safe_cmpt_package_name}::$init_subroutine_name"} }; 547 my $init_subroutine = eval { \&{$init_subroutine_name} };
548 warn "No init routine for $init_subroutine_name: $@" if $debugON and $@;
544 use strict; 549 use strict;
545 my $macro_file_loaded = defined(&$init_subroutine); 550 my $macro_file_loaded = ref($init_subroutine) =~ /CODE/;
546 551
547 #print STDERR "$macro_file_name has not yet been loaded\n" unless $macro_file_loaded; 552 #print STDERR "$macro_file_name has not yet been loaded\n" unless $macro_file_loaded;
548 unless ($macro_file_loaded) { 553 unless ($macro_file_loaded) {
549 ## load the $filePath file 554 ## load the $filePath file
550 ## Using rdo insures that the $filePath file is loaded for every problem, allowing initializations to occur. 555 ## Using rdo insures that the $filePath file is loaded for every problem, allowing initializations to occur.
551 ## Ordinary mortals should not be fooling with the fundamental macros in these files. 556 ## Ordinary mortals should not be fooling with the fundamental macros in these files.
552 my $local_errors = ""; 557 my $local_errors = "";
553 if (-r $filePath ) { 558 if (-r $filePath ) {
554 my $rdoResult = $safe_cmpt->rdo($filePath); 559 my $rdoResult = $safe_cmpt->rdo($filePath);
555 #warn "There were problems compiling the file: $filePath: <BR>--$@" if $@; 560 #warn "unrestricted load: $filePath\n";
556 $local_errors ="\nThere were problems compiling the file:\n $filePath\n $@\n" if $@; 561 $local_errors ="\nThere were problems compiling the file:\n $filePath\n $@\n" if $@;
557 $self ->{errors} .= $local_errors if $local_errors; 562 $self ->{errors} .= $local_errors if $local_errors;
558 use strict; 563 use strict;
559 } else { 564 } else {
560 $local_errors = "Can't open file $filePath for reading\n"; 565 $local_errors = "Can't open file $filePath for reading\n";
… …
562 } 567 }
563 $safe_cmpt -> mask($store_mask); 568 $safe_cmpt -> mask($store_mask);
564 569
565 } 570 }
566 # try again to define the initization subroutine 571 # try again to define the initization subroutine
567 $init_subroutine = eval { \&{"${safe_cmpt_package_name}::$init_subroutine_name"} }; 572 $init_subroutine = eval { \&{"$init_subroutine_name"} };
568 $macro_file_loaded = defined(&$init_subroutine ); 573 $macro_file_loaded = ref($init_subroutine) =~ /CODE/;
569 if ( $macro_file_loaded ) { 574 if ( $macro_file_loaded ) {
570 575
571 # warn "unrestricted load: initializing $macro_file_name $init_subroutine" ; 576 #warn "unrestricted load: initializing $macro_file_name $init_subroutine" ;
572 &$init_subroutine(); 577 &$init_subroutine();
573 } 578 }
574 $local_errors .= "\nUnknown error. Unable to load $filePath\n" if ($local_errors eq '' and not $macro_file_loaded); 579 $local_errors .= "\nUnknown error. Unable to load $filePath\n" if ($local_errors eq '' and not $macro_file_loaded);
575 #print STDERR "$filePath is properly loaded\n\n" if $macro_file_loaded; 580 #print STDERR "$filePath is properly loaded\n\n" if $macro_file_loaded;
576 $local_errors; 581 $local_errors;
… …
737the PG root directory by [PG]. 742the PG root directory by [PG].
738 743
739=cut 744=cut
740 745
741sub PG_errorMessage { 746sub PG_errorMessage {
742 my $return = shift; my $frame = 2; 747 my $return = shift; my $frame = 2; # return can be 'message' or 'traceback'
743 my $message = join("\n",@_); $message =~ s/\.?\s+$//; 748 my $message = join("\n",@_); $message =~ s/\.?\s+$//;
744 my $files = eval ('$main::__files__'); $files = {} unless $files; 749 my $files = eval ('$main::__files__'); $files = {} unless $files;
745 my $tmpl = $files->{tmpl} || '$'; 750 my $tmpl = $files->{tmpl} || '$';
746 my $root = $files->{root} || '$'; 751 my $root = $files->{root} || '$';
747 my $pg = $files->{pg} || '$'; 752 my $pg = $files->{pg} || '$';
… …
781 # report the full traceback 786 # report the full traceback
782 # 787 #
783 return join("\n",@trace,''); 788 return join("\n",@trace,'');
784} 789}
785 790
791=head2 PG_undef_var_check
792
793=pod
794
795 Produces warnings of this type in order to help you guess which local variable is undefined
796 Warning: Use of uninitialized value in concatenation (.) or string at mpu.cgi line 25.
797 Possible variables are:
798 '$GLOBAL_VARIABLE' => \'global',
799 '$t' => \undef,
800 '$s' => \'regular output'
801
802
803
804
805=cut
806
807sub PG_undef_var_check {
808 if($_[0] !~ /^Use of uninitialized value/) {
809 return @_;
810 } else {
811 # If there are objects, the output can be VERY large when you increase this
812 local $Data::Dumper::Maxdepth = 2;
813 # takes all lexical variables from caller-nemaspace
814 my $possibles = Data::Dumper::Dumper({ %{PadWalker::peek_my(1)}, %{PadWalker::peek_our(1)} });
815
816 $possibles ne "\$VAR1 = {};\n" ? ($possibles =~ s/^.*?\n(.*)\n.*?\n$/$1/ms) : ($possibles = '');
817 return "Warning: " . join(', ', @_) . "Possible variables are:\n$possibles\n";
818 }
819
820}
786############################################################################ 821############################################################################
787 822
788=head2 Translate 823=head2 Translate
789 824
790 825
… …
908 943
909=cut 944=cut
910 945
911 my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF) 946 my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF)
912 =$safe_cmpt->reval(" $evalString"); 947 =$safe_cmpt->reval(" $evalString");
913 948 #warn "using safe compartment ", $safe_cmpt->root;
914# This section could use some more error messages. In particular if a problem doesn't produce the right output, the user needs 949# This section could use some more error messages. In particular if a problem doesn't produce the right output, the user needs
915# information about which problem was at fault. 950# information about which problem was at fault.
916# 951#
917# 952#
918 953
… …
1148 $temp_ans = '' unless defined($temp_ans); #make sure that answer is always defined 1183 $temp_ans = '' unless defined($temp_ans); #make sure that answer is always defined
1149 # in case the answer evaluator forgets to check 1184 # in case the answer evaluator forgets to check
1150 $self->{safe}->share('$rf_fun','$temp_ans'); 1185 $self->{safe}->share('$rf_fun','$temp_ans');
1151 1186
1152 # clear %errorTable for each problem 1187 # clear %errorTable for each problem
1153 %errorTable = (); 1188 %errorTable = (); # is the error table being used? perhaps by math objects?
1154 1189
1155 my $rh_ans_evaluation_result; 1190 my $rh_ans_evaluation_result;
1156 if (ref($rf_fun) eq 'CODE' ) { 1191 if (ref($rf_fun) eq 'CODE' ) {
1157 $rh_ans_evaluation_result = $self->{safe} ->reval( '&{ $rf_fun }($temp_ans, ans_label => \''.$ans_name.'\')' ) ; 1192 $rh_ans_evaluation_result = $self->{safe} ->reval( '&{ $rf_fun }($temp_ans, ans_label => \''.$ans_name.'\')' ) ;
1158 warn "Error in Translator.pm::process_answers: Answer $ans_name: |$temp_ans|\n $@\n" if $@; 1193 warn "Error in Translator.pm::process_answers: Answer $ans_name: |$temp_ans|\n $@\n" if $@;
1159 } elsif (ref($rf_fun) =~ /AnswerEvaluator/) { 1194 } elsif (ref($rf_fun) =~ /AnswerEvaluator/) {
1160 $rh_ans_evaluation_result = $self->{safe} ->reval('$rf_fun->evaluate($temp_ans, ans_label => \''.$ans_name.'\')'); 1195 $rh_ans_evaluation_result = $self->{safe} ->reval('$rf_fun->evaluate($temp_ans, ans_label => \''.$ans_name.'\')');
1161 $@ = $errorTable{$@} if $@ && defined($errorTable{$@}); 1196 $@ = $errorTable{$@} if $@ && defined($errorTable{$@}); #Are we redefining error messages here?
1162 warn "Error in Translator.pm::process_answers: Answer $ans_name: |$temp_ans|\n $@\n" if $@; 1197 warn "Error in Translator.pm::process_answers: Answer $ans_name: |$temp_ans|\n $@\n" if $@;
1163 warn "Evaluation error: Answer $ans_name:<BR>\n", 1198 warn "Evaluation error: Answer $ans_name:<BR>\n",
1164 $rh_ans_evaluation_result->error_flag(), " :: ", 1199 $rh_ans_evaluation_result->error_flag(), " :: ",
1165 $rh_ans_evaluation_result->error_message(),"<BR>\n" 1200 $rh_ans_evaluation_result->error_message(),"<BR>\n"
1166 if defined($rh_ans_evaluation_result) 1201 if defined($rh_ans_evaluation_result)
… …
1560 1595
1561 local $SIG{__WARN__} = "DEFAULT"; 1596 local $SIG{__WARN__} = "DEFAULT";
1562 local $SIG{__DIE__} = "DEFAULT"; 1597 local $SIG{__DIE__} = "DEFAULT";
1563 1598
1564 no strict; 1599 no strict;
1565 my $out = eval ("package main; be_strict();" . $string ); 1600 my $out = eval ("package main; be_strict();\n" . $string );
1566 my $errors =$@; 1601 my $errors =$@;
1567 my $full_error_report = "PG_macro_file_eval detected error at line $line of file $file \n" 1602 my $full_error_report = "PG_macro_file_eval detected error at line $line of file $file \n"
1568 . $errors . 1603 . $errors .
1569 "The calling package is $pck\n" if defined($errors) && $errors =~/\S/; 1604 "The calling package is $pck\n" if defined($errors) && $errors =~/\S/;
1570 use strict; 1605 use strict;
Legend:
Removed from v.6164  
changed lines
  Added in v.6244
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9