From 3b696b42a5ce9d729e7c52c6907f3abb87b0728c Mon Sep 17 00:00:00 2001 From: Geoff Goehle Date: Mon, 20 Jun 2016 20:57:44 -0400 Subject: [PATCH 1/9] Add UTF8 to xmlrpc --- lib/WeBWorK/PG/IO.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WeBWorK/PG/IO.pm b/lib/WeBWorK/PG/IO.pm index 0990606be6..feecdfa0f8 100644 --- a/lib/WeBWorK/PG/IO.pm +++ b/lib/WeBWorK/PG/IO.pm @@ -139,7 +139,7 @@ sub read_whole_file { unless path_is_course_subdir($filePath); local (*INPUT); - open(INPUT, "<$filePath") || die "$0: read_whole_file subroutine:
Can't read file $filePath"; + open(INPUT, "<:utf8", $filePath) || die "$0: read_whole_file subroutine:
Can't read file $filePath"; local($/)=undef; my $string = ; # can't append spaces because this causes trouble with <<'EOF' \nEOF construction close(INPUT); From d2d636c1f79a66ccd0d719c9f576db0820a041d6 Mon Sep 17 00:00:00 2001 From: Geoff Goehle Date: Fri, 15 Jul 2016 12:02:18 -0400 Subject: [PATCH 2/9] Add utf8 encoding to the base64 methods. --- lib/PGcore.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/PGcore.pm b/lib/PGcore.pm index fc4794fea9..b2f12f80bd 100755 --- a/lib/PGcore.pm +++ b/lib/PGcore.pm @@ -29,6 +29,7 @@ use Tie::IxHash; use WeBWorK::Debug; use MIME::Base64(); use PGUtil(); +use Encode qw(encode_utf8 decode_utf8); ################################## # PGcore object @@ -563,13 +564,15 @@ sub PG_restricted_eval { sub decode_base64 ($) { my $self = shift; my $str = shift; - MIME::Base64::decode_base64($str); + $str = MIME::Base64::decode_base64($str); + decode_utf8($str); } sub encode_base64 ($;$) { my $self = shift; my $str = shift; my $option = shift; + $str = encode_utf8($str); MIME::Base64::encode_base64($str); } From 539406cc210c8c6d421f3650797f13e6245e712c Mon Sep 17 00:00:00 2001 From: Geoff Goehle Date: Wed, 17 Aug 2016 16:43:46 -0400 Subject: [PATCH 3/9] picked an ascii character for the verb escape character so that it doesn't interfere with utf8 --- lib/Value/String.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Value/String.pm b/lib/Value/String.pm index 438a10f8b0..bf9022f705 100644 --- a/lib/Value/String.pm +++ b/lib/Value/String.pm @@ -72,7 +72,7 @@ sub compare { # # Mark a string to be display verbatim # -sub verb {shift; return "\\verb".chr(0x85).(shift).chr(0x85)} +sub verb {shift; return "\\verb".chr(0x1F).(shift).chr(0x1F)} # # Put normal strings into \text{} and others into \verb From a561c0e75a0db16ab71bf89818ba421c7bf0d30c Mon Sep 17 00:00:00 2001 From: Michael Gage Date: Mon, 31 Jul 2017 14:04:53 -0400 Subject: [PATCH 4/9] Add additional utf8 related changes to PG files. --- lib/PGcore.pm | 3 ++- lib/PGloadfiles.pm | 2 +- lib/WeBWorK/PG/IO.pm | 4 ++-- lib/WeBWorK/PG/Translator.pm | 8 +++++--- macros/PG.pl | 2 +- 5 files changed, 11 insertions(+), 8 deletions(-) diff --git a/lib/PGcore.pm b/lib/PGcore.pm index 7c4f1137f1..198d5e3f04 100755 --- a/lib/PGcore.pm +++ b/lib/PGcore.pm @@ -30,7 +30,8 @@ use WeBWorK::Debug; use MIME::Base64(); use PGUtil(); use Encode qw(encode_utf8 decode_utf8); - +use utf8; +binmode(STDOUT, ":uft8"); ################################## # PGcore object ################################## diff --git a/lib/PGloadfiles.pm b/lib/PGloadfiles.pm index 1445cc734e..a262b75c72 100644 --- a/lib/PGloadfiles.pm +++ b/lib/PGloadfiles.pm @@ -232,7 +232,7 @@ sub compile_file { local($/); $/ = undef; # allows us to treat the file as a single line - open(MACROFILE, "<$filePath") || die "Cannot open file: $filePath"; + open(MACROFILE, "<:utf8", $filePath) || die "Cannot open file: $filePath"; my $string = 'BEGIN {push @__eval__, __FILE__};' . "\n" . ; #warn "compiling $string"; my ($result,$error,$fullerror) = $self->PG_macro_file_eval($string); diff --git a/lib/WeBWorK/PG/IO.pm b/lib/WeBWorK/PG/IO.pm index feecdfa0f8..74ce7251cf 100644 --- a/lib/WeBWorK/PG/IO.pm +++ b/lib/WeBWorK/PG/IO.pm @@ -139,7 +139,7 @@ sub read_whole_file { unless path_is_course_subdir($filePath); local (*INPUT); - open(INPUT, "<:utf8", $filePath) || die "$0: read_whole_file subroutine:
Can't read file $filePath"; + open(INPUT, "<:encoding(utf8)", $filePath) || die "$0: read_whole_file subroutine:
Can't read file $filePath"; local($/)=undef; my $string = ; # can't append spaces because this causes trouble with <<'EOF' \nEOF construction close(INPUT); @@ -201,7 +201,7 @@ sub createFile { die 'Path is unsafe' unless path_is_course_subdir($fileName); - open(TEMPCREATEFILE, ">$fileName") + open(TEMPCREATEFILE, ">:encoding(UTF-8)",$fileName) or die "Can't open $fileName: $!"; my @stat = stat TEMPCREATEFILE; close(TEMPCREATEFILE); diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index c3028b3b9f..3fae095d0b 100644 --- a/lib/WeBWorK/PG/Translator.pm +++ b/lib/WeBWorK/PG/Translator.pm @@ -14,7 +14,9 @@ use Net::SMTP; use PGcore; use PGUtil qw(pretty_print); use WeBWorK::PG::IO qw(fileFromPath); - +use utf8; +use v5.12; +binmode(STDOUT,":utf8"); #use PadWalker; # used for processing error messages #use Data::Dumper; @@ -388,7 +390,7 @@ sub pre_load_macro_files { local(*MACROFILE); local($/); $/ = undef; # allows us to treat the file as a single line - open(MACROFILE, "<$filePath") || die "Cannot open file: $filePath"; + open(MACROFILE, "<:encoding(utf8)", $filePath) || die "Cannot open file: $filePath"; my $string = ; close(MACROFILE); @@ -524,7 +526,7 @@ sub source_file { local($/); $/ = undef; # allows us to treat the file as a single line my $err = ""; - if ( open(SOURCEFILE, "<$filePath") ) { + if ( open(SOURCEFILE, "<:encoding(utf8)", $filePath) ) { $self -> {source} = ; close(SOURCEFILE); } else { diff --git a/macros/PG.pl b/macros/PG.pl index b65f163754..bdcafefd81 100644 --- a/macros/PG.pl +++ b/macros/PG.pl @@ -8,7 +8,7 @@ $main::VERSION ="WW2"; sub _PG_init{ - $main::VERSION ="WW2.9+"; + $main::VERSION ="WW2.13"; # # Set up MathObject context for use in problems # that don't load MathObjects.pl From 414b3569d63bb4e6c28b801ffc993d583d6af0d1 Mon Sep 17 00:00:00 2001 From: Nathan Wallach Date: Wed, 9 May 2018 17:11:30 +0300 Subject: [PATCH 5/9] Added functions SET_PROBLEM_LANGUAGE() SET_PROBLEM_TEXTDIRECTION() which create records in PG->{flags} with settings which will influence the HTML lang and dir attributes set for the HTML element containing the problem. This allows proper detection of the language of the problem in the browser, when it is not the primary course language, and to override the direction for cases when a LTR problem is being viewed/assigned in a course in a RTL course, or visa-versa. The flag values set in the problem are processed in the subroutine output_problem_lang_and_dir() in webwork2/lib/WeBWorK/ContentGenerator/Problem.pm if there is no override set in the course configuration. --- macros/PG.pl | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/macros/PG.pl b/macros/PG.pl index b36e3f617e..156f02ba48 100644 --- a/macros/PG.pl +++ b/macros/PG.pl @@ -142,6 +142,62 @@ sub POST_HEADER_TEXT { $PG->POST_HEADER_TEXT(@_); } +# We expect valid HTML language codes, but there can also include a region code, or other +# settings. +# See https://www.w3.org/International/questions/qa-choosing-language-tags +# Example settings: en-US, en-UK, he-IL +# Some special language codes (zh-Hans) are longer +# http://www.rfc-editor.org/rfc/bcp/bcp47.txt +# https://www.w3.org/International/articles/language-tags/ +# https://www.w3.org/International/questions/qa-lang-2or3.en.html +# http://www.iana.org/assignments/language-subtag-registry/language-subtag-registry +# https://www.w3schools.com/tags/ref_language_codes.asp +# https://www.w3schools.com/tags/ref_country_codes.asp +# Tester at https://r12a.github.io/app-subtags/ + +sub SET_PROBLEM_LANGUAGE { + my $requested_lang = shift; + + # Clean it up for safety + my $selected_lang = $requested_lang; + $selected_lang =~ s/[^a-zA-Z0-9-]//g ; # Drop any characters not permitted. + + if ( $selected_lang ne $requested_lang ) { + warn "PROBLEM_LANGUAGE was edited. Requested: $requested_lang which was replaced by $selected_lang"; + } + $PG->{flags}->{"language"} = $selected_lang; +} + +# SET_PROBLEM_TEXTDIRECTION to set the HTML DIRection attribute to be applied +# to the DIV element containing this problem. + +# We only permit valid settings for the HTML direction attribute: +# dir="ltr|rtl|auto" +# https://www.w3schools.com/tags/att_global_dir.asp + +# It is likely that only problems written in RTL scripts +# will need to call the following function to set the base text direction +# for the problem. + +# Note the flag may not be set, and then webwork2 will use default behavior. + +sub SET_PROBLEM_TEXTDIRECTION { + my $requested_dir = shift; + + # Only allow valid values: + + if ( $requested_dir =~ /^ltr$/i ) { + $PG->{flags}->{"textdirection"} = "ltr"; + } elsif ( $requested_dir =~ /^rtl$/i ) { + $PG->{flags}->{"textdirection"} = "trl"; + } elsif ( $requested_dir =~ /^auto$/i ) { + $PG->{flags}->{"textdirection"} = "auto"; # NOT RECOMMENDED + } else { + warn " INVALID setting for PROBLEM_TEXTDIRECTION: $requested_dir was DROPPED."; + } +} + + sub AskSage { my $python = shift; my $options = shift; From 67fcefcc2de85e6518a7db52997d703383873435 Mon Sep 17 00:00:00 2001 From: Nathan Wallach Date: Wed, 9 May 2018 20:58:54 +0300 Subject: [PATCH 6/9] Added SET_PROBLEM_LANGUAGE() SET_PROBLEM_TEXTDIRECTION() functions which set flags for the problem language and textdirection which can be accessed inside the webwork2 code to allow using this data to set the HTML lang and dir tags as needed on DIV elements which envelop the problem text. --- macros/PG.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/macros/PG.pl b/macros/PG.pl index 156f02ba48..3b96047001 100644 --- a/macros/PG.pl +++ b/macros/PG.pl @@ -189,7 +189,7 @@ sub SET_PROBLEM_TEXTDIRECTION { if ( $requested_dir =~ /^ltr$/i ) { $PG->{flags}->{"textdirection"} = "ltr"; } elsif ( $requested_dir =~ /^rtl$/i ) { - $PG->{flags}->{"textdirection"} = "trl"; + $PG->{flags}->{"textdirection"} = "rtl"; } elsif ( $requested_dir =~ /^auto$/i ) { $PG->{flags}->{"textdirection"} = "auto"; # NOT RECOMMENDED } else { From c8d0c3ca9b65ed40ee39e249c29ad762be52cea1 Mon Sep 17 00:00:00 2001 From: Michael Gage Date: Thu, 25 Oct 2018 21:04:56 -0400 Subject: [PATCH 7/9] Replace "<:encoding(utf8)" by "<::utf8" this may be due to an obsolete Encoding.pm file --- lib/WeBWorK/PG/IO.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/WeBWorK/PG/IO.pm b/lib/WeBWorK/PG/IO.pm index 74ce7251cf..ecd8c5cffd 100644 --- a/lib/WeBWorK/PG/IO.pm +++ b/lib/WeBWorK/PG/IO.pm @@ -5,6 +5,7 @@ package WeBWorK::PG::IO; use parent qw(Exporter); +use Encode qw( encode decode); use JSON qw(decode_json); use PGUtil qw(not_null); use WeBWorK::Utils qw(path_is_subdir); @@ -139,7 +140,7 @@ sub read_whole_file { unless path_is_course_subdir($filePath); local (*INPUT); - open(INPUT, "<:encoding(utf8)", $filePath) || die "$0: read_whole_file subroutine:
Can't read file $filePath"; + open(INPUT, "<:utf8", $filePath) || die "$0: read_whole_file subroutine:
Can't read file $filePath"; local($/)=undef; my $string = ; # can't append spaces because this causes trouble with <<'EOF' \nEOF construction close(INPUT); From 4f2e82f013e284343a90ff5aac514ce547d3d8c4 Mon Sep 17 00:00:00 2001 From: Michael Gage Date: Sun, 27 Jan 2019 20:36:43 -0500 Subject: [PATCH 8/9] Move unrelated test units out of the way so that it doesn't confuse reviewers of multilingual --- t/pg_test_problems/chem_react1.pg | 57 ------------ t/pg_test_problems/chem_react2.pg | 56 ----------- t/pg_test_problems/matrix_inverse.pg | 70 -------------- t/pg_test_problems/matrix_inverse2.pg | 83 ----------------- t/pg_test_problems/test_units1.pg | 96 ------------------- t/test_units.t | 129 -------------------------- 6 files changed, 491 deletions(-) delete mode 100644 t/pg_test_problems/chem_react1.pg delete mode 100644 t/pg_test_problems/chem_react2.pg delete mode 100644 t/pg_test_problems/matrix_inverse.pg delete mode 100644 t/pg_test_problems/matrix_inverse2.pg delete mode 100644 t/pg_test_problems/test_units1.pg delete mode 100755 t/test_units.t diff --git a/t/pg_test_problems/chem_react1.pg b/t/pg_test_problems/chem_react1.pg deleted file mode 100644 index 9fe95de5e6..0000000000 --- a/t/pg_test_problems/chem_react1.pg +++ /dev/null @@ -1,57 +0,0 @@ -DOCUMENT(); -loadMacros( -"PGstandard.pl", -"MathObjects.pl", -"contextReaction.pl" -); -# -# -TEXT(&beginproblem); -# -$showPartialCorrectAnswers = 1; -Context("Reaction"); -# -$named_reactants ="Silver nitrate + Sodium chloride"; -$named_products = "Silver chloride + Sodium nitrate"; -# -# ID react, prod for complete molecular, total ionic, and net ionic equations. -# -$COMPLETE_REACTION=Formula("AgNO_{3} (aq) + NaCl (aq) --> AgCl (s) + NaNO_{3} (aq)"); -# -$TOTAL_IONIC = Formula("Ag^{+1}(aq) + NO_{3}^{-1}(aq) + Na^{+1}(aq) + Cl^{-1}(aq) --> AgCl(s)+Na^{+1}(aq) + NO_{3}^{-1}(aq)"); -# -$NET_IONIC=Formula("Ag^{+1}(aq) + Cl^{-1}(aq) --> AgCl(s)"); -# -COMMENT("Reaction arrow is --> NOTE: two dashes and >. Charges for ions should be entered +1, +2, -1, -2, etc. Note the order and the 1 for the + and - cases"); -Context()->texStrings; -BEGIN_TEXT -$BBOLD Answers should be entered using guidlines discussed in lecture. $EBOLD $BR -Consider the reaction shown below.$BR -$named_reactants \(\longrightarrow\) $named_products $BR -Write the complete molecular reaction equation.$BR -\{ans_rule(60)\}$BR -Write the total ionic equation.$BR -\{ans_rule(60)\}$BR -Write the net ionic equation for the reaction.$BR -\{ans_rule(60)\} -END_TEXT - -BEGIN_TEXT - -Solutions: -\($COMPLETE_REACTION\) -$PAR -\($TOTAL_IONIC\) -$PAR -\($NET_IONIC\) - -END_TEXT - -Context()->normalStrings; - -# -ANS($COMPLETE_REACTION->cmp); -ANS($TOTAL_IONIC->cmp); -ANS($NET_IONIC->cmp); -# -ENDDOCUMENT(); \ No newline at end of file diff --git a/t/pg_test_problems/chem_react2.pg b/t/pg_test_problems/chem_react2.pg deleted file mode 100644 index 5e2bba3fb5..0000000000 --- a/t/pg_test_problems/chem_react2.pg +++ /dev/null @@ -1,56 +0,0 @@ -DOCUMENT(); -loadMacros( -"PGstandard.pl", -"MathObjects.pl", -"contextReaction.pl" -); -# -# -TEXT(&beginproblem); -# -$showPartialCorrectAnswers = 1; -Context("Reaction"); -Context()->variables->add('e' => $context::Reaction::ELEMENT); -# -$named_reactants ="Zinc + Copper(II) sulfate"; -$named_products = "Zinc sulfate + Copper"; -# -$COMPLETE_REACTION=Formula("Zn(s) + CuSO_{4}(aq) --> ZnSO_{4}(aq) + Cu(s)"); -# -$OXIDATION = Formula("Zn(s) --> Zn^{+2} + 2e^{-1}"); -# -$REDUCTION=Formula("Cu^{+2} + 2e^{-1} --> Cu(s)"); -# -COMMENT("Reaction arrow is --> NOTE: two dashes and >. Charges for ions should be entered +1, +2, -1, -2, etc. Note the order and the 1 for the + and - cases. Electrons are added as e^{-1}"); -Context()->texStrings; -BEGIN_TEXT -$BBOLD Answers should be entered using guidlines discussed in lecture. $EBOLD $BR -Consider the reaction shown below.$BR -$named_reactants \(\longrightarrow\) $named_products $BR -Write the complete molecular reaction equation.$BR -\{ans_rule(60)\}$BR -Write the oxidation half-reaction.$BR -\{ans_rule(60)\}$BR -Write the reduction half-reaction.$BR -\{ans_rule(60)\} -END_TEXT - -BEGIN_TEXT - -Solutions: -\($COMPLETE_REACTION\) -$PAR -\($OXIDATION\) -$PAR -\($REDUCTION\) - -END_TEXT - -Context()->normalStrings; - -# -ANS($COMPLETE_REACTION->cmp); -ANS($OXIDATION->cmp); -ANS($REDUCTION->cmp); -# -ENDDOCUMENT(); \ No newline at end of file diff --git a/t/pg_test_problems/matrix_inverse.pg b/t/pg_test_problems/matrix_inverse.pg deleted file mode 100644 index af0af40031..0000000000 --- a/t/pg_test_problems/matrix_inverse.pg +++ /dev/null @@ -1,70 +0,0 @@ -##DESCRIPTION -## -## -## -##ENDDESCRIPTION -## -## -DOCUMENT(); # This should be the first executable line in the problem. - -loadMacros( - "PGstandard.pl", # Standard macros for PG language - "MathObjects.pl", - "PGML.pl", - #"source.pl", # used to display problem source button - "PGcourse.pl", # Customization file for the course -); - -TEXT(beginproblem()); -$showPartialCorrectAnswers = 1; - -############################################################## -############################################################### -# Setup -# # -# ## -## Context("Numeric"); - -############################################################## -############################################################### -# Text -# # -# ## -# ## -Context("Matrix"); -Context()->constants->add(A=>Matrix([1,2],[3,4])); -Context()->variables->add(M=>Matrix([1,2],[3,4])); -TEXT(Formula("A^(-1)")->reduce,$BR); -TEXT(Formula("M^(-1)")->reduce,$BR); -TEXT(Formula("[[x,2],[3,x]]^(-1)")->reduce,$BR); -TEXT(Formula("x^(-1)")->reduce,$BR); -TEXT(Formula("x^(-2)")->reduce,$BR); - -BEGIN_PGML -Without the patch, the first three reductions will produce an error about only being able -to divide by a number. With the patch, all three should succeed, and you should get - -* A^(-1) -* M^(-1) -* [`[[x,2],[3,x]]^{(-1)}`] -* 1/x -* 1/(x^2) - -as the output. - -Note that this does change the name of the reduction rule from x^(-1) to x^(-a). I've -checked the macro files and the OPL and don't see any uses of reduction rule x^(-1), so I -think this should not be a problem (though some Wiki pages may need to be updated). - ------------- -END_PGML - -############################################################# -############################################################### -# Answers -# # -# ## -# ## -# ## -# ## -ENDDOCUMENT(); # This should be the last executable line in the problem. \ No newline at end of file diff --git a/t/pg_test_problems/matrix_inverse2.pg b/t/pg_test_problems/matrix_inverse2.pg deleted file mode 100644 index b59571e199..0000000000 --- a/t/pg_test_problems/matrix_inverse2.pg +++ /dev/null @@ -1,83 +0,0 @@ -##DESCRIPTION - - - -##ENDDESCRIPTION - - -DOCUMENT(); # This should be the first executable line in the problem. - -loadMacros( - "PGstandard.pl", # Standard macros for PG language - "MathObjects.pl", - "PGML.pl", - #"source.pl", # used to display problem source button - "PGcourse.pl", # Customization file for the course -); - -TEXT(beginproblem()); -$showPartialCorrectAnswers = 1; - -############################################################## -# -# Setup -# -# -Context("Numeric"); - -############################################################## -# -# Text -# -# - -Context("Matrix"); -Context()->constants->add( - A => Matrix([[1,2,3],[4,5,6]]), - B => Matrix([0,0],[0,0]), -); -Context()->variables->add( - M => Matrix([[1,2,3],[4,5,6]]), - N => Matrix([[1,2],[3,4]]), -); - -#Formula("A^(-1)"); -#Formula("M^(-1)"); -#Formula("[[1,2,3],[4,5,x]]^(-1)"); -#Formula("[[1,2,3],[4,5,6]]^(-1)"); - -#Formula("B^(-1)")->eval; -#Formula("N^(-1)")->eval(N => Matrix([[0,0],[0,0]])); -#Formula("[[0,0],[0,0]]^(-1)"); -#Formula("[[x,0],[0,x]]^(-1)")->eval(x => 0); -#Matrix([[0,0],[0,0]]) ** -1; - -Matrix([[0,0],[0,0]])->inverse; -Matrix([[0,0],[0,0]])->solve_LR(Vector(1,1)); - - -BEGIN_PGML -Without the patch, the first four should produce errors -about 2x3 and 2x3 matrixes not being able to be multiplied, -while the next five and final two should produce errors -about matrices needing at least one entry. - -With the patch, the first four should produce messages -that only a square matrix can be inverted, the next -five should say that the matrix is not invertible, -and the last two should produce an undefined value -and a list of three undefined values, respectively. - - -END_PGML -# - -############################################################## -# -# Answers -# -# - - - -ENDDOCUMENT(); # This should be the last executable line in the problem. \ No newline at end of file diff --git a/t/pg_test_problems/test_units1.pg b/t/pg_test_problems/test_units1.pg deleted file mode 100644 index d0db0f0442..0000000000 --- a/t/pg_test_problems/test_units1.pg +++ /dev/null @@ -1,96 +0,0 @@ -## DESCRIPTION -## Functions: Input and Output - - -## DBsubject(WeBWorK) -## DBchapter(TEST) -## DBsection(Units) -## Date(01/01/10) -## Institution(U of R) -## Author(Gage) -## Level() -## MO(1) - -## KEYWORDS('test','units',) - -DOCUMENT(); - -loadMacros( -"PGstandard.pl", -"MathObjects.pl", -"AnswerFormatHelp.pl", -"PGML.pl", -"parserNumberWithUnits.pl", -"parserFormulaWithUnits.pl", -"PGcourse.pl", -); - -TEXT(beginproblem()); - -################################## -# Setup - -Context("Numeric"); - - -$one_mph = NumberWithUnits(1,"mph"); -$x2_mph = FormulaWithUnits("x^2", "mph"); - -$hz_0_05 = NumberWithUnits(.05, "Hz"); -$five_percent_per_second = NumberWithUnits(5, "%/s"); -$five_percent = NumberWithUnits(5, "%"); -$one_degree = NumberWithUnits(1, "deg"); -$one_radian = NumberWithUnits(1, "rad"); -$one_hour = NumberWithUnits(1,"hours"); -$one_inch = NumberWithUnits(1,"inches"); -$one_foot = NumberWithUnits(1,"feet"); -$one_minute = NumberWithUnits(1,"minute"); -$one_second = NumberWithUnits(1,"s"); #only s works -$one_cup = NumberWithUnits(.236588 ,"L"); -$one_footpersecond = NumberWithUnits(1,"feet/s"); -$x2_footpersecond = FormulaWithUnits("x^2","feet/s"); - - -##################################### -# Main text - -Context()->texStrings; -BEGIN_PGML -These units are equivalent: -* deg, degree, degrees -* rad, radian, radians, -* in, inch, inches -* ft, feet, foot -* min, minute, minutes -* h, hr, hour, hours -* s, sec,?? -* cup, cups, 0.000236588 m^3 or .236588 L - - -* sr ( steradian or square radian a measure of solid angle. 1 sr = rad^2 ?) The actual definition is the central solid angle of a patch on a sphere of radius r whose area is r^2. A full sphere measures 4pi steradian's. - -The definition here is 1 sr = 1 rad^2 --- is that really right? - -TESTS: - -These should be equivalent: -* Enter .05 Hz in %/s [_________]{$hz_0_05} as [`5*2\pi %*rad/s`] -* Enter 5 %/s as Hz [__________]{$five_percent_per_second} as[`.05/(2pi) Hz/rad`] -* Enter 5 % as [__________]{$five_percent} as [`.05 rad/rad`] -* Enter 1 mph [__________]{$one_mph} as 5280 ft/hr -* Enter x^2 mph [__________]{$x2_mph} - -* Enter one degree: [__________]{$one_degree} -* Enter one radian: [__________]{$one_radian} as [`(2\pi)^-1 cycles`] -* Enter one hour: [__________]{$one_hour} -* Enter one inch: [__________]{$one_inch} -* Enter one foot: [__________]{$one_foot} -* Enter one minute: [__________]{$one_minute} -* Enter one second: [__________]{$one_second} -* Enter one cup: [__________]{$one_cup} -* Enter one ft/sec [__________]{$one_footpersecond} -* [`x^2`] ft/sec [__________]{$x2_footpersecond} -END_PGML - - -ENDDOCUMENT(); \ No newline at end of file diff --git a/t/test_units.t b/t/test_units.t deleted file mode 100755 index 605dcfdd8c..0000000000 --- a/t/test_units.t +++ /dev/null @@ -1,129 +0,0 @@ -#!/usr/bin/perl -w -# -# tests Units.pm module - -#use Test::More tests => 5; -use Test::More qw( no_plan ); -use lib "../lib"; # location of Units.pm module -use lib "lib"; # location of Units.pm module we run perl t/test_units.t - -BEGIN { - use_ok('Units'); -} - -my $error_message = ''; - -#### Let's check that all the units are unique and defined in base units #### -ok( check_fundamental_units(), "checking fundamental units: $error_message"); - -SKIP: { - skip 'Evaluating units doomed to failure', 9 if $error_message; - -is_deeply( {evaluate_units('kg')}, in_base_units(kg => 1, factor => 1), 'kilogram' ); -is_deeply( {evaluate_units('N')}, in_base_units(kg => 1, m => 1, s => -2, factor => 1), 'Newton' ); -is_deeply( {evaluate_units('C')}, in_base_units(amp => 1, s => 1, factor => 1), 'Coulomb' ); -is_deeply( {evaluate_units('V')}, in_base_units(amp => -1, s => -3, kg => 1, m => 2, factor => 1), 'Volt' ); -is_deeply( {evaluate_units('J*s')}, in_base_units(kg => 1, m => 2, s => -1, factor => 1), 'Joule-seconds' ); - -is_deeply( {evaluate_units('N/C')}, {evaluate_units('V/m')}, 'N/C = V/m' ); -is_deeply( {evaluate_units('C/N')}, {evaluate_units('m/V')}, 'C/N = m/V' ); -is_deeply( {evaluate_units('V/m')}, in_base_units(kg => 1, m => 1, s => -3, amp => -1, factor => 1), 'Volts per metre' ); -is_deeply( {evaluate_units('N/C')}, in_base_units(kg => 1, m => 1, s => -3, amp => -1, factor => 1), 'Newtons per Coulomb' ); -is_deeply( {evaluate_units('N/C')}, {evaluate_units('J/amp*m*s')}, 'N/C = J/amp*m*s' ); -is_deeply( {evaluate_units('V/m')}, {evaluate_units('N/C')}, 'V/m = N/C' ); - -is_deeply( multiply_by(1000, evaluate_units('mF')), {evaluate_units('F')}, 'millifarad conversion'); -is_deeply( multiply_by(1E6, evaluate_units('uF')), {evaluate_units('F')}, 'microfarad conversion'); -is_deeply( multiply_by(1000, evaluate_units('ohm')), {evaluate_units('kohm')}, 'kilo-ohm conversion'); -is_deeply( multiply_by(1E6, evaluate_units('ohm')), {evaluate_units('Mohm')}, 'kilo-ohm conversion'); -is_deeply( multiply_by(1000, evaluate_units('mV')), {evaluate_units('V')}, 'millivolt conversion'); -is_deeply( multiply_by(1000, evaluate_units('V')), {evaluate_units('kV')}, 'kilovolt conversion'); - -is_deeply( multiply_by(1e5, evaluate_units('G')), {evaluate_units('T')}, 'magnetic field strength conversion'); -is_deeply( {evaluate_units('V/ohm')}, {evaluate_units('V*S')}, 'conductivity definition'); -is_deeply( {evaluate_units('Wb')}, {evaluate_units('T*m^2')}, 'Weber definition'); -is_deeply( {evaluate_units('H')}, {evaluate_units('V*s/amp')}, 'Henry definition'); - -is_deeply( multiply_by(1000, evaluate_units('micromol/L')), {evaluate_units('mmol/L')}, 'concentration conversion'); -is_deeply( multiply_by(10, evaluate_units('mg/L')), {evaluate_units('mg/dL')}, 'concentration conversion'); -is_deeply( multiply_by(1e9, evaluate_units('nanomol')), {evaluate_units('mol')}, 'concentration conversion'); - -is_deeply( multiply_by(1000, evaluate_units('mSv')), {evaluate_units('Sv')}, 'milli-Sievert conversion'); -is_deeply( multiply_by(1e6, evaluate_units('uSv')), {evaluate_units('Sv')}, 'micro-Sievert conversion'); -is_deeply( {evaluate_units('kat')}, {evaluate_units('mol/s')}, 'catalitic activity' ); - -is_deeply( multiply_by(1822.88854680448, evaluate_units('me')), {evaluate_units('amu')}, 'atomic mass conversion'); - -is_deeply( {evaluate_units('lx')}, {evaluate_units('lm/m^2')}, 'lux = lumen per square metre' ); - -is_deeply( multiply_by(1e9, evaluate_units('Pa')), {evaluate_units('GPa')}, 'gigapascal conversion'); -is_deeply( multiply_by(1000, evaluate_units('kPa')), {evaluate_units('MPa')}, 'kilopascal conversion'); - -is_deeply( multiply_by(2*1000*$Units::PI, evaluate_units('rad/s')), {evaluate_units('kHz')}, 'kilohertz conversion'); - -$second_arc = 0.0174532925/60/60; -is_deeply( multiply_by(cos($second_arc)/sin($second_arc), evaluate_units('AU')), {evaluate_units('parsec')}, 'parsec conversion'); -is_deeply( multiply_by(299792458, evaluate_units('m/s')), {evaluate_units('c')}, 'speed of light conversion'); -is_deeply( {evaluate_units('c*yr')}, {evaluate_units('light-year')}, 'light year' ); - -is_deeply( multiply_by((180/$Units::PI)**2, evaluate_units('deg^2')), {evaluate_units('sr')}, 'solid angle conversion'); - -is_deeply( multiply_by(0.01,evaluate_units('rad/rad')), {evaluate_units('%')}, 'percent conversion'); - - -} -ok( units_well_defined(), "checking unit definitions: $error_message"); - -exit; - -sub in_base_units { - my %u = @_; - my %base_units = %Units::fundamental_units; - foreach my $key (keys %u) { - $base_units{$key} = $u{$key}; - } - return \%base_units; -} - -sub multiply_by { - my ($conversion, %unit) = @_; - $unit{factor} *= $conversion; - return \%unit; -} - -sub check_fundamental_units { - my @base_units = qw( factor mol degF degC kg m amp s degK rad cd ); - - if ( @base_units != keys %Units::fundamental_units ) { - if ( @base_units < keys %Units::fundamental_units ) { - $error_message = 'New fundamental units added - update test'; - return undef; - } - else { - $error_message = 'Missing fundamental units'; - return undef; - } - } - foreach my $unit ( @base_units ) { - unless ( exists $Units::fundamental_units{$unit} - && ($Units::fundamental_units{$unit} == 0 || $Units::fundamental_units{$unit} == 1) ) { - $error_message = "Problem with $unit"; - return undef; - } - } - return 'ok'; -} - - -sub units_well_defined { - foreach my $unit ( keys %Units::known_units ) { - for my $factor ( keys %{$Units::known_units{$unit}} ) { - unless ( exists $Units::fundamental_units{$factor} ) { - $error_message = "non-base unit in definition: $unit"; - return undef; - } - } - } - return 'ok'; -} - From 3d94218b2b1317bd4ed32c5e6943d6aa30b375dd Mon Sep 17 00:00:00 2001 From: Michael Gage <1203580+mgage@users.noreply.github.com> Date: Mon, 11 Mar 2019 15:43:39 -0400 Subject: [PATCH 9/9] change to encodine(UTF-8) from :utf8 whereever possible. --- lib/PGloadfiles.pm | 2 +- lib/WeBWorK/PG/IO.pm | 24 ++- lib/WeBWorK/PG/Translator.pm | 314 ++++++++++++++++++----------------- macros/PG.pl | 2 +- 4 files changed, 181 insertions(+), 161 deletions(-) diff --git a/lib/PGloadfiles.pm b/lib/PGloadfiles.pm index a262b75c72..4675cd575e 100644 --- a/lib/PGloadfiles.pm +++ b/lib/PGloadfiles.pm @@ -232,7 +232,7 @@ sub compile_file { local($/); $/ = undef; # allows us to treat the file as a single line - open(MACROFILE, "<:utf8", $filePath) || die "Cannot open file: $filePath"; + open(MACROFILE, "encoding(UTF-8)", $filePath) || die "Cannot open file: $filePath"; my $string = 'BEGIN {push @__eval__, __FILE__};' . "\n" . ; #warn "compiling $string"; my ($result,$error,$fullerror) = $self->PG_macro_file_eval($string); diff --git a/lib/WeBWorK/PG/IO.pm b/lib/WeBWorK/PG/IO.pm index ecd8c5cffd..6327bd57db 100644 --- a/lib/WeBWorK/PG/IO.pm +++ b/lib/WeBWorK/PG/IO.pm @@ -4,13 +4,17 @@ ################################################################################ package WeBWorK::PG::IO; +use warnings qw(FATAL utf8); use parent qw(Exporter); use Encode qw( encode decode); use JSON qw(decode_json); use PGUtil qw(not_null); use WeBWorK::Utils qw(path_is_subdir); use WeBWorK::CourseEnvironment; - +use utf8; +#binmode(STDOUT,":encoding(UTF-8)"); +#binmode(STDIN,":encoding(UTF-8)"); +#binmode(INPUT,":encoding(UTF-8)"); my $CE = new WeBWorK::CourseEnvironment({ webwork_dir => $ENV{WEBWORK_ROOT}, }); @@ -40,6 +44,7 @@ BEGIN { our @SHARED_FUNCTIONS = qw( includePGtext read_whole_problem_file + read_whole_file convertPath fileFromPath directoryFromPath @@ -140,13 +145,24 @@ sub read_whole_file { unless path_is_course_subdir($filePath); local (*INPUT); - open(INPUT, "<:utf8", $filePath) || die "$0: read_whole_file subroutine:
Can't read file $filePath"; + open(INPUT, "<:raw", $filePath) || die "$0: read_whole_file subroutine:
Can't read file $filePath"; local($/)=undef; - my $string = ; # can't append spaces because this causes trouble with <<'EOF' \nEOF construction + my $string = ; + my $backup_string = $string; + # can't append spaces because this causes trouble with <<'EOF' \nEOF construction + my $success = utf8::decode($string); + unless ($success) { + warn "There was an error decoding $filePath as UTF-8, will try to upgrade"; + utf8:upgrade($backup_string); + $string = $backup_string; + } close(INPUT); \$string; } - +# <:utf8 is more relaxed on input, <:encoding(UTF-8) would be better, but +# perhaps it's not so horrible to have lax input. encoding(UTF-8) tries to use require +# to import Encode, Encode::Alias::find_encoding and Safe raises an exception. +# haven't figured a way around this yet. =item convertPath($path) Currently a no-op. Returns $path unmodified. diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index 62d793e10a..3e6692b520 100644 --- a/lib/WeBWorK/PG/Translator.pm +++ b/lib/WeBWorK/PG/Translator.pm @@ -16,7 +16,7 @@ use PGUtil qw(pretty_print); use WeBWorK::PG::IO qw(fileFromPath); use utf8; use v5.12; -binmode(STDOUT,":utf8"); +binmode(STDOUT,":encoding(UTF-8)"); #use PadWalker; # used for processing error messages #use Data::Dumper; @@ -304,160 +304,162 @@ sub initialize { # the above line will get changed when we fix the PG modules thing. heh heh. } - -################################################################ -# Preloading the macro files -################################################################ - -# Preloading the macro files can significantly speed up the translation process. -# Files are read into a separate safe compartment (typically Safe::Root1::) -# This means that all non-explicit subroutine references and those explicitly prefixed by main:: -# are prefixed by Safe::Root1:: -# These subroutines (but not the constants) are then explicitly exported to the current -# safe compartment Safe::Rootx:: - -# Although it is not large, it is important to import PG.pl into the -# cached safe compartment as well. This is because a call in PGbasicmacros.pl to NEW_ANSWER_NAME -# which is defined in PG.pl would actually be a call to Safe::Root1::NEW_ANSWER_NAME since -# PGbasicmacros is compiled into the SAfe::Root1:: compartment. If PG.pl has only been compiled into -# the current Safe compartment, this call will fail. There are many calls between PG.pl, -# PGbasicmacros and PGanswermacros so it is easiest to have all of them defined in Safe::Root1:: -# There subroutines are still available in the current safe compartment. -# Sharing the hash %Safe::Root1:: in the current compartment means that any references to Safe::Root1::NEW_ANSWER_NAME -# will be found as long as NEW_ANSWER_NAME has been defined in Safe::Root1:: -# -# Constants and references to subroutines in other macro files have to be handled carefully in preloaded files. -# For example a call to main::display_matrix (defined in PGmatrixmacros.pl) will become Safe::Root1::display_matrix and -# will fail since PGmatrixmacros.pl is loaded only into the current safe compartment Safe::Rootx::. -# The value of main:: has to be evaluated at runtime in order to make this work. Hence something like -# my $temp_code = eval('\&main::display_matrix'); -# &$temp_code($matrix_object_to_be_displayed); -# in PGanswermacros.pl -# would reference the run time value of main::, namely Safe::Rootx:: -# There may be a clearer or more efficient way to obtain the runtime value of main:: - - -sub pre_load_macro_files { - time_it("Begin pre_load_macro_files"); - my $self = shift; - my $cached_safe_cmpt = shift; - my $dirName = shift; - my @fileNameList = @_; - my $debugON = 0; # This helps with debugging the loading of macro files - -################################################################ -# prepare safe_cache -################################################################ - $cached_safe_cmpt -> share_from('WeBWorK::PG::Translator', - [keys %Translator_shared_subroutine_hash]); - $cached_safe_cmpt -> share_from('WeBWorK::PG::IO', - [keys %IO_shared_subroutine_hash]); - no strict; - local(%envir) = %{ $self ->{envir} }; - $cached_safe_cmpt -> share('%envir'); - use strict; - $cached_safe_cmpt -> share_from('main', $self->{ra_included_modules} ); - $cached_safe_cmpt->mask(Opcode::full_opset()); # allow no operations - $cached_safe_cmpt->permit(qw( :default )); - $cached_safe_cmpt->permit(qw(time)); # used to determine whether solutions are visible. - $cached_safe_cmpt->permit(qw( atan2 sin cos exp log sqrt )); - - # just to make sure we'll deny some things specifically - $cached_safe_cmpt->deny(qw(entereval)); - $cached_safe_cmpt->deny(qw ( unlink symlink system exec )); - $cached_safe_cmpt->deny(qw(print require)); - -################################################################ -# read in macro files -################################################################ - - foreach my $fileName (@fileNameList) { - # determine whether the file has already been loaded by checking for - # subroutine named _${macro_file_name}_init - my $macro_file_name = $fileName; - $macro_file_name =~s/\.pl//; # trim off the extension - $macro_file_name =~s/\.pg//; # sometimes the extension is .pg (e.g. CAPA files) - my $init_subroutine_name = "_${macro_file_name}_init"; - my $macro_file_loaded = defined(&{$cached_safe_cmpt->root."::$init_subroutine_name"}) ? 1 : 0; - - - if ( $macro_file_loaded ) { - warn "$macro_file_name is already loaded" if $debugON; - }else { - warn "reading and evaluating $macro_file_name from $dirName/$fileName" if $debugON; - ### read in file - my $filePath = "$dirName/$fileName"; - local(*MACROFILE); - local($/); - $/ = undef; # allows us to treat the file as a single line - open(MACROFILE, "<:encoding(utf8)", $filePath) || die "Cannot open file: $filePath"; - my $string = ; - close(MACROFILE); - - -################################################################ -# Evaluate macro files -################################################################ -# FIXME The following hardwired behavior should be modifiable -# either in the procedure call or in global.conf: +# -- Preloading has not been used for some time. +# It was a method of speeding up the creation of a new safe compartment +# It may be worth saving this for a while as a reference +# ################################################################ +# # Preloading the macro files +# ################################################################ # -# PG.pl, IO.pl are loaded without restriction; -# all other files are loaded with restriction -# - # construct a regex that matches only these three files safely - my @unrestricted_files = (); # no longer needed? FIXME w/PG.pl IO.pl/; - my $unrestricted_files = join("|", map { quotemeta } @unrestricted_files); - - my $store_mask; - if ($fileName =~ /^($unrestricted_files)$/) { - $store_mask = $cached_safe_cmpt->mask(); - $cached_safe_cmpt ->mask(Opcode::empty_opset()); - } - $cached_safe_cmpt -> reval('BEGIN{push @main::__eval__,__FILE__}; package main; ' .$string); - warn "preload Macros: errors in compiling $macro_file_name:
$@" if $@; - $self->{envir}{__files__}{$cached_safe_cmpt->reval('pop @main::__eval__')} = $filePath; - if ($fileName =~ /^($unrestricted_files)$/) { - $cached_safe_cmpt ->mask($store_mask); - warn "mask restored after $fileName" if $debugON; - } - - - } - } - -################################################################################ -# load symbol table -################################################################################ - warn "begin loading symbol table " if $debugON; - no strict 'refs'; - my %symbolHash = %{$cached_safe_cmpt->root.'::'}; - use strict 'refs'; - my @subroutine_names; - - foreach my $name (keys %symbolHash) { - # weed out internal symbols - next if $name =~ /^(INC|_|__ANON__|main::)$/; - if ( defined(&{*{$symbolHash{$name}}}) ) { -# warn "subroutine $name" if $debugON;; - push(@subroutine_names, "&$name"); - } - } - - warn "Loading symbols into active safe compartment:
", join(" ",sort @subroutine_names) if $debugON; - $self->{safe} -> share_from($cached_safe_cmpt->root,[@subroutine_names]); - - # Also need to share the cached safe compartment symbol hash in the current safe compartment. - # This is necessary because the macro files have been read into the cached safe compartment - # So all subroutines have the implied names Safe::Root1::subroutine - # When they call each other we need to make sure that they can reach each other - # through the Safe::Root1 symbol table. - - $self->{safe} -> share('%'.$cached_safe_cmpt->root.'::'); - warn 'Sharing '.'%'. $cached_safe_cmpt->root. '::' if $debugON; - time_it("End pre_load_macro_files"); - # return empty string. - ''; -} +# # Preloading the macro files can significantly speed up the translation process. +# # Files are read into a separate safe compartment (typically Safe::Root1::) +# # This means that all non-explicit subroutine references and those explicitly prefixed by main:: +# # are prefixed by Safe::Root1:: +# # These subroutines (but not the constants) are then explicitly exported to the current +# # safe compartment Safe::Rootx:: +# +# # Although it is not large, it is important to import PG.pl into the +# # cached safe compartment as well. This is because a call in PGbasicmacros.pl to NEW_ANSWER_NAME +# # which is defined in PG.pl would actually be a call to Safe::Root1::NEW_ANSWER_NAME since +# # PGbasicmacros is compiled into the SAfe::Root1:: compartment. If PG.pl has only been compiled into +# # the current Safe compartment, this call will fail. There are many calls between PG.pl, +# # PGbasicmacros and PGanswermacros so it is easiest to have all of them defined in Safe::Root1:: +# # There subroutines are still available in the current safe compartment. +# # Sharing the hash %Safe::Root1:: in the current compartment means that any references to Safe::Root1::NEW_ANSWER_NAME +# # will be found as long as NEW_ANSWER_NAME has been defined in Safe::Root1:: +# # +# # Constants and references to subroutines in other macro files have to be handled carefully in preloaded files. +# # For example a call to main::display_matrix (defined in PGmatrixmacros.pl) will become Safe::Root1::display_matrix and +# # will fail since PGmatrixmacros.pl is loaded only into the current safe compartment Safe::Rootx::. +# # The value of main:: has to be evaluated at runtime in order to make this work. Hence something like +# # my $temp_code = eval('\&main::display_matrix'); +# # &$temp_code($matrix_object_to_be_displayed); +# # in PGanswermacros.pl +# # would reference the run time value of main::, namely Safe::Rootx:: +# # There may be a clearer or more efficient way to obtain the runtime value of main:: +# +# +# sub pre_load_macro_files { +# time_it("Begin pre_load_macro_files"); +# my $self = shift; +# my $cached_safe_cmpt = shift; +# my $dirName = shift; +# my @fileNameList = @_; +# my $debugON = 0; # This helps with debugging the loading of macro files +# +# ################################################################ +# # prepare safe_cache +# ################################################################ +# $cached_safe_cmpt -> share_from('WeBWorK::PG::Translator', +# [keys %Translator_shared_subroutine_hash]); +# $cached_safe_cmpt -> share_from('WeBWorK::PG::IO', +# [keys %IO_shared_subroutine_hash]); +# no strict; +# local(%envir) = %{ $self ->{envir} }; +# $cached_safe_cmpt -> share('%envir'); +# use strict; +# $cached_safe_cmpt -> share_from('main', $self->{ra_included_modules} ); +# $cached_safe_cmpt->mask(Opcode::full_opset()); # allow no operations +# $cached_safe_cmpt->permit(qw( :default )); +# $cached_safe_cmpt->permit(qw(time)); # used to determine whether solutions are visible. +# $cached_safe_cmpt->permit(qw( atan2 sin cos exp log sqrt )); +# +# # just to make sure we'll deny some things specifically +# $cached_safe_cmpt->deny(qw(entereval)); +# $cached_safe_cmpt->deny(qw ( unlink symlink system exec )); +# $cached_safe_cmpt->deny(qw(print require)); +# +# ################################################################ +# # read in macro files +# ################################################################ +# +# foreach my $fileName (@fileNameList) { +# # determine whether the file has already been loaded by checking for +# # subroutine named _${macro_file_name}_init +# my $macro_file_name = $fileName; +# $macro_file_name =~s/\.pl//; # trim off the extension +# $macro_file_name =~s/\.pg//; # sometimes the extension is .pg (e.g. CAPA files) +# my $init_subroutine_name = "_${macro_file_name}_init"; +# my $macro_file_loaded = defined(&{$cached_safe_cmpt->root."::$init_subroutine_name"}) ? 1 : 0; +# +# +# if ( $macro_file_loaded ) { +# warn "$macro_file_name is already loaded" if $debugON; +# }else { +# warn "pre_load_macro_files: reading and evaluating $macro_file_name from $dirName/$fileName" ; +# ### read in file +# my $filePath = "$dirName/$fileName"; +# local(*MACROFILE); +# local($/); +# $/ = undef; # allows us to treat the file as a single line +# open(MACROFILE, "<:encoding(UTF-8)", $filePath) || die "Cannot open file: $filePath"; +# my $string = ; +# close(MACROFILE); +# +# +# ################################################################ +# # Evaluate macro files +# ################################################################ +# # FIXME The following hardwired behavior should be modifiable +# # either in the procedure call or in global.conf: +# # +# # PG.pl, IO.pl are loaded without restriction; +# # all other files are loaded with restriction +# # +# # construct a regex that matches only these three files safely +# my @unrestricted_files = (); # no longer needed? FIXME w/PG.pl IO.pl/; +# my $unrestricted_files = join("|", map { quotemeta } @unrestricted_files); +# +# my $store_mask; +# if ($fileName =~ /^($unrestricted_files)$/) { +# $store_mask = $cached_safe_cmpt->mask(); +# $cached_safe_cmpt ->mask(Opcode::empty_opset()); +# } +# $cached_safe_cmpt -> reval('BEGIN{push @main::__eval__,__FILE__}; package main; ' .$string); +# warn "preload Macros: errors in compiling $macro_file_name:
$@" if $@; +# $self->{envir}{__files__}{$cached_safe_cmpt->reval('pop @main::__eval__')} = $filePath; +# if ($fileName =~ /^($unrestricted_files)$/) { +# $cached_safe_cmpt ->mask($store_mask); +# warn "mask restored after $fileName" if $debugON; +# } +# +# +# } +# } +# +# ################################################################################ +# # load symbol table +# ################################################################################ +# warn "begin loading symbol table " if $debugON; +# no strict 'refs'; +# my %symbolHash = %{$cached_safe_cmpt->root.'::'}; +# use strict 'refs'; +# my @subroutine_names; +# +# foreach my $name (keys %symbolHash) { +# # weed out internal symbols +# next if $name =~ /^(INC|_|__ANON__|main::)$/; +# if ( defined(&{*{$symbolHash{$name}}}) ) { +# # warn "subroutine $name" if $debugON;; +# push(@subroutine_names, "&$name"); +# } +# } +# +# warn "Loading symbols into active safe compartment:
", join(" ",sort @subroutine_names) if $debugON; +# $self->{safe} -> share_from($cached_safe_cmpt->root,[@subroutine_names]); +# +# # Also need to share the cached safe compartment symbol hash in the current safe compartment. +# # This is necessary because the macro files have been read into the cached safe compartment +# # So all subroutines have the implied names Safe::Root1::subroutine +# # When they call each other we need to make sure that they can reach each other +# # through the Safe::Root1 symbol table. +# +# $self->{safe} -> share('%'.$cached_safe_cmpt->root.'::'); +# warn 'Sharing '.'%'. $cached_safe_cmpt->root. '::' if $debugON; +# time_it("End pre_load_macro_files"); +# # return empty string. +# ''; +# } sub environment{ my $self = shift; @@ -505,6 +507,8 @@ sub share_from { $safe_compartment->share_from($pckg_name,$array_ref); } +#### end safe compartment pass through macros + sub source_string { my $self = shift; my $temp = shift; @@ -526,7 +530,7 @@ sub source_file { local($/); $/ = undef; # allows us to treat the file as a single line my $err = ""; - if ( open(SOURCEFILE, "<:encoding(utf8)", $filePath) ) { + if ( open(SOURCEFILE, "<:encoding(UTF-8)", $filePath) ) { $self -> {source} = ; close(SOURCEFILE); } else { diff --git a/macros/PG.pl b/macros/PG.pl index c4d5b1b806..90acc5d04d 100644 --- a/macros/PG.pl +++ b/macros/PG.pl @@ -785,7 +785,7 @@ sub includePGproblem { my $filePath = shift; my %save_envir = %main::envir; my $fullfilePath = $PG->envir("templateDirectory").$filePath; - my $r_string = read_whole_problem_file($fullfilePath); + my $r_string = $PG->read_whole_problem_file($fullfilePath); if (ref($r_string) eq 'SCALAR') { $r_string = $$r_string; }