diff --git a/VERSION b/VERSION index 2650dc99cd..669dbea71a 100644 --- a/VERSION +++ b/VERSION @@ -1,4 +1,4 @@ -$PG_VERSION ='PG-2.14'; -$PG_COPYRIGHT_YEARS = '1996-2018'; +$PG_VERSION ='2.15'; +$PG_COPYRIGHT_YEARS = '1996-2019'; 1; diff --git a/lib/AnswerHash.pm b/lib/AnswerHash.pm index a2dee9e85e..4e81bfb299 100755 --- a/lib/AnswerHash.pm +++ b/lib/AnswerHash.pm @@ -24,7 +24,7 @@ manipulation methods. More of these may be added as it becomes necessary. - Useage: $rh_ans = new AnswerHash; + Usage: $rh_ans = new AnswerHash; AnswerEvaluator -- this class organizes the construction of answer evaluator subroutines which check the @@ -37,7 +37,7 @@ thus greatly reducing the programming and maintenance required for constructing answer evaluators. - Useage: $ans_eval = new AnswerEvaluator; + Usage: $ans_eval = new AnswerEvaluator; =cut @@ -203,14 +203,14 @@ sub setKeys { =head4 data - Useage: $rh_ans->data('foo'); set $rh_ans->{student_ans} = 'foo'; + Usage: $rh_ans->data('foo'); set $rh_ans->{student_ans} = 'foo'; $student_input = $rh_ans->data(); retrieve value of $rh_ans->{student_ans} synonym for input =head4 input - Useage: $rh_ans->input('foo') sets $rh_ans->{student_ans} = 'foo'; + Usage: $rh_ans->input('foo') sets $rh_ans->{student_ans} = 'foo'; $student_input = $rh_ans->input(); synonym for data @@ -231,7 +231,7 @@ sub input { #$rh_ans->input('foo') is a synonym for $rh_ans->{student_ans}=' =head4 input - Useage: $rh_ans->score(1) + Usage: $rh_ans->score(1) $score = $rh_ans->score(); Retrieve or set $rh_ans->{score}, the student's score on the problem. @@ -266,7 +266,7 @@ sub stringify_hash { =head4 throw_error - Useage: $rh_ans->throw_error("FLAG", "message"); + Usage: $rh_ans->throw_error("FLAG", "message"); FLAG is a distinctive word that describes the type of error. Examples are EVAL for an evaluation error or "SYNTAX" for a syntax error. @@ -279,7 +279,7 @@ sub stringify_hash { =head4 catch_error - Useage: $rh_ans->catch_error("FLAG2"); + Usage: $rh_ans->catch_error("FLAG2"); Returns true (1) if $rh_ans->{error_flag} equals "FLAG2", otherwise it returns false (empty string). @@ -288,7 +288,7 @@ sub stringify_hash { =head4 clear_error - Useage: $rh_ans->clear_error("FLAG2"); + Usage: $rh_ans->clear_error("FLAG2"); If $rh_ans->{error_flag} equals "FLAG2" then the {error_flag} entry is set to the empty string as is the entry {error_message} @@ -297,7 +297,7 @@ sub stringify_hash { =head4 error_message - Useage: $flag = $rh_ans -> error_flag(); + Usage: $flag = $rh_ans -> error_flag(); $message = $rh_ans -> error_message(); @@ -352,7 +352,7 @@ sub error_message { # =head4 pretty_print # # -# Useage: $rh_ans -> pretty_print(); +# Usage: $rh_ans -> pretty_print(); # # # Returns a string containing a representation of the AnswerHash as an HTML table. @@ -396,7 +396,7 @@ sub error_message { =head4 OR - Useage: $rh_ans->OR($rh_ans2); + Usage: $rh_ans->OR($rh_ans2); Returns a new AnswerHash whose score is the maximum of the scores in $rh_ans and $rh_ans2. The correct answers for the two hashes are combined with "OR". @@ -408,7 +408,7 @@ sub error_message { =head4 AND - Useage: $rh_ans->AND($rh_ans2); + Usage: $rh_ans->AND($rh_ans2); Returns a new AnswerHash whose score is the minimum of the scores in $rh_ans and $rh_ans2. The correct answers for the two hashes are combined with "AND". @@ -817,7 +817,7 @@ sub rh_ans { A filter is a subroutine which takes one AnswerHash as an input, followed by a hash of options. - Useage: filter($ans_hash, option1 =>value1, option2=> value2 ); + Usage: filter($ans_hash, option1 =>value1, option2=> value2 ); The filter performs some operations on the input AnswerHash and returns an diff --git a/lib/Matrix.pm b/lib/Matrix.pm index 3bb7586c94..d051f5d04a 100644 --- a/lib/Matrix.pm +++ b/lib/Matrix.pm @@ -377,9 +377,8 @@ sub new_from_col_vecs sub cp { # MEG makes new copies of complex number my $z = shift; - return $z unless ref($z); - my $w = Complex1::cplx($z->Re,$z->Im); - return $w; + return $z unless ref($z) eq 'Complex1'; + Complex1::cplx($z->Re,$z->Im); } =head4 @@ -600,4 +599,4 @@ sub decompose_LR -1; \ No newline at end of file +1; diff --git a/lib/PGalias.pm b/lib/PGalias.pm index 8b4a5f8a87..83da471dbf 100644 --- a/lib/PGalias.pm +++ b/lib/PGalias.pm @@ -102,6 +102,7 @@ sub initialize { $self->{externalGif2PngPath} = $envir->{externalGif2PngPath}; $self->{courseID} = $envir->{courseName}; $self->{problemSeed} = $envir->{problemSeed}; + $self->{problemUUID} = $envir->{problemUUID}//0; $self->{appletPath} = $self->{envir}->{pgDirectories}->{appletPath}; # @@ -117,7 +118,8 @@ sub initialize { $self->{courseID}, 'set'.$self->{setNumber}, 'prob'.$self->{probNum}, - $self->{problemSeed} + $self->{problemSeed}, + $self->{problemUUID}, ); ################################## diff --git a/lib/PGcore.pm b/lib/PGcore.pm index 5927faeb59..3a38d02a0a 100755 --- a/lib/PGcore.pm +++ b/lib/PGcore.pm @@ -29,7 +29,9 @@ use Tie::IxHash; use WeBWorK::Debug; use MIME::Base64(); use PGUtil(); - +use Encode qw(encode_utf8 decode_utf8); +use utf8; +binmode(STDOUT, ":utf8"); ################################## # PGcore object ################################## @@ -565,13 +567,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); } diff --git a/lib/PGloadfiles.pm b/lib/PGloadfiles.pm index 1445cc734e..035329d2d0 100644 --- a/lib/PGloadfiles.pm +++ b/lib/PGloadfiles.pm @@ -70,6 +70,7 @@ our $debugON =0; package PGloadfiles; use strict; +#use Encode(qw(encode decode)); use Exporter; use PGcore; use WeBWorK::PG::Translator; @@ -232,8 +233,9 @@ 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, "<:raw", $filePath) || die "Cannot open file: $filePath"; my $string = 'BEGIN {push @__eval__, __FILE__};' . "\n" . ; + utf8::decode($string); # can't yet use :encoding(UTF-8) #warn "compiling $string"; my ($result,$error,$fullerror) = $self->PG_macro_file_eval($string); eval ('$main::__files__->{pop @main::__eval__} = $filePath'); #used to keep track of which file is being evaluated. diff --git a/lib/Parser/Context/Default.pm b/lib/Parser/Context/Default.pm index 694609d569..e988e0e570 100644 --- a/lib/Parser/Context/Default.pm +++ b/lib/Parser/Context/Default.pm @@ -174,8 +174,8 @@ $functions = { 'asinh' => {class => 'Parser::Function::hyperbolic', TeX => '\sinh^{-1}'}, 'acosh' => {class => 'Parser::Function::hyperbolic', TeX => '\cosh^{-1}'}, 'atanh' => {class => 'Parser::Function::hyperbolic', TeX => '\tanh^{-1}'}, - 'asech' => {class => 'Parser::Function::hyperbolic', TeX => '\mathop{\rm sech}^{-1}'}, - 'acsch' => {class => 'Parser::Function::hyperbolic', TeX => '\mathop{\rm csch}^{-1}'}, + 'asech' => {class => 'Parser::Function::hyperbolic', TeX => '\mathop{\rm sech}\nolimits^{-1}'}, + 'acsch' => {class => 'Parser::Function::hyperbolic', TeX => '\mathop{\rm csch}\nolimits^{-1}'}, 'acoth' => {class => 'Parser::Function::hyperbolic', TeX => '\coth^{-1}'}, 'ln' => {class => 'Parser::Function::numeric', inverse => 'exp', diff --git a/lib/Parser/Function.pm b/lib/Parser/Function.pm index 9c0d4298e8..f4b5806a9e 100644 --- a/lib/Parser/Function.pm +++ b/lib/Parser/Function.pm @@ -300,7 +300,7 @@ sub TeX { my @pstr = (); my $fn_precedence = $fn->{precedence}; $fn_precedence = $fn->{parenPrecedence} if $fn->{parenPrecedence}; $fn = $self->{def}; - my $name = '\mathop{\rm '.$self->{name}.'}'; + my $name = '\mathop{\rm '.$self->{name}.'}\nolimits'; $name = $fn->{TeX} if defined($fn->{TeX}); foreach my $x (@{$self->{params}}) {push(@pstr,$x->TeX)} if ($fn->{braceTeX}) {$TeX = $name.'{'.join(',',@pstr).'}'} diff --git a/lib/Units.pm b/lib/Units.pm index 60b6582492..f9776f08a9 100644 --- a/lib/Units.pm +++ b/lib/Units.pm @@ -185,6 +185,18 @@ our %known_units = ('m' => { 'factor' => 86400, 's' => 1 }, + 'month' => { + 'factor' => 60*60*24*30, + 's' => 1 + }, + 'months' => { + 'factor' => 60*60*24*30, + 's' => 1 + }, + 'mo' => { + 'factor' => 60*60*24*30, + 's' => 1 + }, 'yr' => { 'factor' => 31557600, 's' => 1 @@ -283,7 +295,7 @@ our %known_units = ('m' => { 'm' => 1 }, 'parsec' => { - 'factor' => 30.857E15, + 'factor' => 3.08567758149137E16, #30.857E15, 'm' => 1 }, # VOLUME @@ -441,6 +453,12 @@ our %known_units = ('m' => { 'kg' => 1, 's' => -2 }, + 'lbs' => { + 'factor' => 4.4482216152605, + 'm' => 1, + 'kg' => 1, + 's' => -2 + }, 'ton' => { 'factor' => 8900, 'm' => 1, diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index 0d73cc32ec..f28cbefb4e 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -186,7 +186,7 @@ sub numberMatrix { #internal my @M = (); my $isFormula = 0; foreach my $x (@_) { $x = Value::makeValue($x,context=>$context); - Value::Error("Matrix row entries must be numbers") unless Value::isNumber($x); + Value::Error("Matrix row entries must be numbers: $x ") unless _isNumber($x); push(@M,$x); $isFormula = 1 if Value::isFormula($x); } return $self->formula([@M]) if $isFormula; @@ -249,7 +249,7 @@ sub isRow { } # -# See if the matrix is an Indenity matrix +# See if the matrix is an Identity matrix # sub isOne { my $self = shift; @@ -275,6 +275,11 @@ sub isZero { return 1; } +sub _isNumber { + my $n = shift; + return Value::isNumber($n) || Value::classMatch($n, 'Fraction'); +} + # # Make arbitrary data into a matrix, if possible # @@ -327,7 +332,7 @@ sub mult { # # Constant multiplication # - if (Value::isNumber($r)) { + if (_isNumber($r)) { my @coords = (); foreach my $x (@{$l->data}) {push(@coords,$x*$r)} return $self->make(@coords); @@ -365,7 +370,7 @@ sub mult { sub div { my ($l,$r,$flag) = @_; my $self = $l; Value::Error("Can't divide by a Matrix") if $flag; - Value::Error("Matrices can only be divided by Numbers") unless Value::isNumber($r); + Value::Error("Matrices can only be divided by Numbers") unless _isNumber($r); Value::Error("Division by zero") if $r == 0; my @coords = (); foreach my $x (@{$l->data}) {push(@coords,$x/$r)} @@ -377,11 +382,11 @@ sub power { Value::Error("Can't use Matrices in exponents") if $flag; Value::Error("Only square matrices can be raised to a power") unless $l->isSquare; $r = Value::makeValue($r,context=>$context); - if ($r->isNumber && $r =~ m/^-\d+$/) { + if (_isNumber($r) && $r =~ m/^-\d+$/) { $l = $l->inverse; $r = -$r; $self->Error("Matrix is not invertible") unless defined($l); } - Value::Error("Matrix powers must be non-negative integers") unless $r->isNumber && $r =~ m/^\d+$/; + Value::Error("Matrix powers must be non-negative integers") unless _isNumber($r) && $r =~ m/^\d+$/; return $context->Package("Matrix")->I($l->length,$context) if $r == 0; my $M = $l; foreach my $i (2..$r) {$M = $M*$l} return $M; diff --git a/lib/Value/String.pm b/lib/Value/String.pm index 438a10f8b0..5c9c973cf9 100644 --- a/lib/Value/String.pm +++ b/lib/Value/String.pm @@ -27,6 +27,14 @@ sub new { return $s; } +sub make { + my $self = shift; + my $s = $self->SUPER::make(@_); + my $def = $self->context->strings->get($s->{data}[0]); + $s->{caseSensitive} = 1 if $def->{caseSensitive}; + return $s; +} + # # Return the appropriate data. # @@ -72,7 +80,21 @@ sub compare { # # Mark a string to be display verbatim # -sub verb {shift; return "\\verb".chr(0x85).(shift).chr(0x85)} +sub verb { + shift; + my $s = shift; + $s =~ s/\r/ /g; + # different verbatim delimiters because in general 0xD would be nicest, + # but browsers want to change that to 0xA + # eval() needed because this .pm file loaded outside the safe compartment, + # and eval() runs it inside the safe compartment, where problem context is in place. + my $d = eval ('main::MODES(HTML => chr(0x1F), TeX => chr(0xD), PTX=> chr(0xD))'); + return "{\\verb$d$s$d}"; + # Note this does not handle \n in the input string + # A future effort to address that should concurrently + # handle it similarly for HTML output. + # And something similar should be done for the ArbitraryString context +} # # Put normal strings into \text{} and others into \verb diff --git a/lib/Value/Union.pm b/lib/Value/Union.pm index cf3ef7d77a..7dbee1f427 100644 --- a/lib/Value/Union.pm +++ b/lib/Value/Union.pm @@ -212,7 +212,7 @@ sub reduce { foreach my $x ($self->value) { if ($x->type eq 'Set') {push(@singletons,$x->value)} elsif ($x->{data}[0] == $x->{data}[1]) {push(@singletons,$x->{data}[0])} - else {push(@intervals,$x->copy)} + else {push(@intervals,$x->inherit)} } my @union = (); my @set = (); my $prevX; @intervals = (CORE::sort {$a <=> $b} @intervals); diff --git a/lib/VectorField.pm b/lib/VectorField.pm index c49c4ae756..d761da4b74 100644 --- a/lib/VectorField.pm +++ b/lib/VectorField.pm @@ -8,11 +8,11 @@ use Carp; use GD; use WWPlot; - use Fun; - $fn = new Fun( rule_reference); - $fn = new Fun( rule_reference , graph_reference); - $fn = new Fun ( x_rule_ref, y_rule_ref ); - $fn = new Fun ( x_rule_ref, y_rule_ref, graph_ref ); + use VectorField; + $vf = new VectorField( dy_rule_ref); + $vf = new VectorField( dy_rule_ref , graph_reference); + $vf = new VectorField( x_rule_ref, y_rule_ref ); + $vf = new VectorField( x_rule_ref, y_rule_ref, graph_ref ); =head1 DESCRIPTION @@ -25,19 +25,14 @@ The following functions are provided: =over 4 -=item $fn = new VectorField( dy_rule_ref); +=item $vf = new VectorField( dy_rule_ref); rule_reference is a reference to a subroutine which accepts a pair of numerical values and returns a numerical value. -The Fun object will draw the direction field associated with this subroutine. - -The new method returns a reference to the vector field object. - -=item $fn = new Fun( rule_reference , graph_reference); - The vector field is also placed into the printing queue of the graph object pointed to by graph_reference and the domain of the vector field object is set to the domain of the graph. +The graph_ref must come last. =back @@ -45,22 +40,22 @@ domain of the vector field object is set to the domain of the graph. =over 4 -=item $fn = new VectorField ( dx_rule_ref, dy_rule_ref ); +=item $vf = new VectorField ( dx_rule_ref, dy_rule_ref ); A vector field object is created where the subroutines refered to by dx_rule_ref and dy_rule_ref define the x and y components of the vector field at (x,y). Both subroutines must be functions of two variables. -=item $fn = new VectorField ( x_rule_ref, y_rule_ref, graph_ref ); +=item $vf = new VectorField ( x_rule_ref, y_rule_ref, graph_ref ); This variant inserts the vector field object into the graph object referred to by graph_ref. The domain -of the vector field object is set to the domain of the graph. +of the vector field object is set to the domain of the graph. The graph_ref must come last. =back =head2 Properites - All of the properties are set using the construction $new_value = $fn->property($new_value) - and read using $current_value = $fn->property() + All of the properties are set using the construction $new_value = $vf->property($new_value) + and read using $current_value = $vf->property() =over 4 @@ -105,12 +100,12 @@ The width in pixels of the pen used to draw the arrow (respectively the dot). =item domain -$array_ref = $fn->domain(-1,-2,1,2) sets xmin to -1, ymin to -2, xmax to 1, and ymax to 2. +$array_ref = $vf->domain(-1,-2,1,2) sets xmin to -1, ymin to -2, xmax to 1, and ymax to 2. =item draw -$fn->draw($graph_ref) draws the vector field in the graph object pointed to by $graph_ref. +$vf->draw($graph_ref) draws the vector field in the graph object pointed to by $graph_ref. The graph object must respond to the methods below. The draw call is mainly for internal diff --git a/lib/WeBWorK/PG/IO.pm b/lib/WeBWorK/PG/IO.pm index 0990606be6..93c3d90479 100644 --- a/lib/WeBWorK/PG/IO.pm +++ b/lib/WeBWorK/PG/IO.pm @@ -4,12 +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}, }); @@ -33,12 +38,13 @@ BEGIN { directoryFromPath createFile createDirectory - path_is_course_subdir + path_is_course_subdir ); our @SHARED_FUNCTIONS = qw( includePGtext read_whole_problem_file + read_whole_file convertPath fileFromPath directoryFromPath @@ -139,13 +145,24 @@ 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, "<: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. @@ -201,7 +218,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); @@ -260,8 +277,12 @@ sub path_is_course_subdir { # sub query_sage_server { my ($python, $url, $accepted_tos, $setSeed, $webworkfunc, $debug, $curlCommand)=@_; - my $sagecall = qq{$curlCommand -i -k -sS -L --data-urlencode "accepted_tos=${accepted_tos}"}. +# my $sagecall = qq{$curlCommand -i -k -sS -L --http1.1 --data-urlencode "accepted_tos=${accepted_tos}"}. +# qq{ --data-urlencode 'user_expressions={"WEBWORK":"_webwork_safe_json(WEBWORK)"}' --data-urlencode "code=${setSeed}${webworkfunc}$python" $url}; + my $sagecall = qq{$curlCommand -i -k -sS -L --data-urlencode "accepted_tos=${accepted_tos}"}. qq{ --data-urlencode 'user_expressions={"WEBWORK":"_webwork_safe_json(WEBWORK)"}' --data-urlencode "code=${setSeed}${webworkfunc}$python" $url}; + + my $output =`$sagecall`; if ($debug) { warn "debug is turned on in IO.pm. "; @@ -279,13 +300,44 @@ sub query_sage_server { # Access-Control-Allow-Origin: * # Content-Type: application/json; charset=UTF-8 # $content: Either error message about terms of service or output from sage - my ($continue, $header, @content) = split("\r\n\r\n",$output); - my $content = join("\r\n\r\n",@content); # handle case where there were blank lines in the content - # warn "output list is ", join("|||\n|||",($continue, $header, @content)); - # warn "header is $header =" , $header =~/200 OK\r\n/; + # find the header + # expecting something like + # HTTP/1.1 100 Continue + + # HTTP/1.1 200 OK + # Date: Wed, 20 Sep 2017 14:54:03 GMT + # ...... + # two blank lines + # content + + # or (notice that here there is no continue response) + # HTTP/2 200 + # date: Wed, 20 Sep 2017 16:06:03 GMT + # ...... + # two blank lines + # content + + my ($continue, $header, @content) = split("\r\n\r\n",$output); + #my $content = join("\r\n\r\n",@content); # handle case where there were blank lines in the content + my @lines = split("\r\n\r\n", $output); + $continue=0; + my $header_ok =0; + while (@lines) { + my $header_block = shift(@lines); + warn "checking for header: $header_block" if $debug; + next unless $header_block=~/\S/; #skip empty lines; + next if $header_block=~/HTTP/ and $header_block=~/100/; # skip continue line + if ($header_block=~/200/) { # 200 return is ok + $header_ok=1; + last; + } + } + my $content = join("|||\n|||",@lines) ; #headers have been removed. + #warn "output list is ", $content; # join("|||\n|||",($continue, $header, $content)); + #warn "header_ok is $header_ok"; my $result; - if ($header =~/200 OK\r\n/) { #success - $result = $content; + if ($header_ok) { #success put any extraneous splits back together + $result = join("\r\n\r\n",@lines); } else { warn "ERROR in contacting sage server. Did you accept the terms of service by setting {accepted_tos=>'true'} in the askSage options?\n $content\n"; @@ -343,7 +395,9 @@ END # has something been returned? not_null($output) or die "Unable to make a sage call to $url."; warn "IO::askSage: We have some kind of value |$output| returned from sage" if $output and $debug; - + if ($output =~ /"success":\s*true/ and $debug){ + warn '"success": true is present in the output'; + } my $decoded = decode_json($output); not_null($decoded) or die "Unable to decode sage output"; if ($debug and defined $decoded ) { @@ -351,16 +405,19 @@ END foreach my $key (keys %$decoded) {$warning_string .= "$key=".$decoded->{$key}.", ";} $warning_string .= ' end decoded contents'; #warn "\n$warning_string" if $debug; - warn " decoded contents \n", PGUtil::pretty_print($decoded, 'text'), "end decoded contents"; + warn " decoded contents \n", PGUtil::pretty_print($decoded, 'text'), "end decoded contents" if $debug; } # was there a Sage/python syntax Error # is the returned something text from stdout (deprecated) # have objects been returned in a WEBWORK variable? - my $success = $decoded->{success} if defined $decoded; + my $success = 0; + $success = $decoded->{success} if defined $decoded and $decoded->{success}; warn "success is $success" if $debug; # the decoding process seems to change the string "true" to "1" sometimes -- we could enforce this $success = 1 if defined $success and $success eq 'true'; - if ($decoded->{success}==1) { + $success = 1 if $decoded->{execute_reply}->{status} eq 'ok'; + warn "now success is $success because status was ok" if $debug; + if ($success) { my $WEBWORK_variable_non_empty=0; my $sage_WEBWORK_data = $decoded->{execute_reply}{user_expressions}{WEBWORK}{data}{'text/plain'}; warn "sage_WEBWORK_data $sage_WEBWORK_data" if $debug; @@ -387,7 +444,7 @@ END } else { die "Error receiving JSON output from sage: \n$output\n "; } - } elsif ($decoded->{success} == 0 ) { # this might be a syntax error + } elsif ($success == 0 ) { # this might be a syntax error $ret->{error_message} = $decoded->{execute_reply}; # this is a hash. # need a better pretty print method warn ( "IO.pm: Perhaps there was syntax error.", join(" ",%{ $decoded->{execute_reply}})); } else { diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index 1779bdc20c..d78de79a1d 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,":encoding(UTF-8)"); #use PadWalker; # used for processing error messages #use Data::Dumper; @@ -302,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, "<$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; @@ -503,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; @@ -524,7 +530,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(UTF-8)", $filePath) ) { $self -> {source} = ; close(SOURCEFILE); } else { @@ -1334,7 +1340,7 @@ sub process_answers{ if defined($new_rh_ans_evaluation_result) && ref($new_rh_ans_evaluation_result) && defined($new_rh_ans_evaluation_result->error_flag()); } else { - $PG->warning_message(" The evaluated answer is not an answer hash $new_rh_ans_evaluation_result: |".ref($new_rh_ans_evaluation_result)."|."); + $PG->warning_message(" The evaluated answer is not an answer hash ".($new_rh_ans_evaluation_result//'').': |'.ref($new_rh_ans_evaluation_result)."|."); } # $PG->debug_message( $self->{envir}->{'probFileName'} ." new_temp_ans and temp_ans don't agree: ". # ref($new_temp_ans)." $new_temp_ans ". ref($temp_ans). " $temp_ans".length($new_temp_ans).length($temp_ans)) @@ -1888,7 +1894,7 @@ sub dumpvar { *stash = *{"${packageName}::"}; $, = " "; - emit "Content-type: text/html\n\n
\n";
+    emit "Content-type: text/html; charset=UTF-8\n\n
\n";
     
     
     while ( ($varName, $globValue) = each %stash) {
diff --git a/macros/LinearProgramming.pl b/macros/LinearProgramming.pl
index d2e2fa2c38..fbe81409b2 100644
--- a/macros/LinearProgramming.pl
+++ b/macros/LinearProgramming.pl
@@ -290,7 +290,7 @@ sub lp_current_value {
   		if (defined &Fraction) {
   			return Fraction(0);   # MathObjects version
   		} else {
-  			return new Fraction(0);	# old style Function module version
+  			return Fraction->new(0);	# old style Function module version
   		}
   	} else {
   		return 0;
diff --git a/macros/LiveGraphics3D.pl b/macros/LiveGraphics3D.pl
index f0cc1e4a13..da69b14c39 100644
--- a/macros/LiveGraphics3D.pl
+++ b/macros/LiveGraphics3D.pl
@@ -156,8 +156,10 @@ sub LiveGraphics3D {
 		    vars : $ind_vars,
     };
 
+    if (typeof LiveGraphics3D !== 'undefined') {
+        var graph = new LiveGraphics3D(thisTD[0],options);
+    }
 
-    var graph = new LiveGraphics3D(thisTD[0],options);
     
 EOS
 
diff --git a/macros/PG.pl b/macros/PG.pl
index 028807c237..0b2d35d9c6 100644
--- a/macros/PG.pl
+++ b/macros/PG.pl
@@ -5,17 +5,15 @@
 # initialize PGcore and PGrandom
 
 
-$main::VERSION ="PG-2.14";
-
 sub _PG_init{
-  $main::VERSION ="PG-2.14";
+  $main::VERSION ="PG-2.15";
+
   #
   #  Set up MathObject context for use in problems
   #  that don't load MathObjects.pl
   #
   %main::context = ();
   Parser::Context->current(\%main::context);
-
 }
 
 our $PG;  
@@ -142,6 +140,72 @@ 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"} = "rtl";
+  } elsif ( $requested_dir =~ /^auto$/i ) {
+    $PG->{flags}->{"textdirection"} = "auto"; # NOT RECOMMENDED
+  } else {
+    warn " INVALID setting for PROBLEM_TEXTDIRECTION: $requested_dir was DROPPED.";
+  }
+}
+
+# Request that the problem HTML page also include additional CSS files
+# from the webwork2/htdocs/css/ directory.
+sub ADD_CSS_FILE {
+  my $file = shift ;
+  if ( !defined( $PG->{flags}{extra_css_files} ) ) {
+    $PG->{flags}{extra_css_files} = [ "$file" ];
+  } else {
+    push( @{$PG->{flags}{extra_css_files}}, $file );
+  }
+}
+
 sub AskSage {
     my $python = shift;
     my $options = shift;
@@ -730,7 +794,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;      
     }
diff --git a/macros/PGML.pl b/macros/PGML.pl
index e7971e1086..144d0729f5 100644
--- a/macros/PGML.pl
+++ b/macros/PGML.pl
@@ -32,7 +32,7 @@ package PGML::Parse;
 
 my $wordStart = qr/[^a-z0-9]/;
 
-my $indent = '^\t+';
+my $indent = '^(?:\t|    )+';
 my $lineend = '\n+';
 my $linebreak = '   ?(?=\n)';
 my $heading = '#+';
@@ -67,8 +67,6 @@ sub new {
 
 sub Split {
   my $self = shift; my $string = shift;
-  $string =~ s/\t/    /g;                             # turn tabs into spaces
-  $string =~ s!^((?:    )+)!"\t"x(length($1)/4)!gme;  # make initial indent into tabs
   $string =~ s!^(?:\t* +|\t+ *)$!!gm;                 # make blank lines blank
   return split($splitPattern,$string);
 }
@@ -153,7 +151,7 @@ sub All {
   my $self = shift; my $token = shift;
   return $self->Begin($token) if substr($token,0,1) eq "[" && $BlockDefs{$token};
   for ($token) {
-    /\t/           && do {return $self->Indent($token)};
+    /^(?:\t|    )/ && do {return $self->Indent($token)};
     /\d+\. /       && do {return $self->Bullet($token,"numeric")};
     /[ivxl]+[.)] / && do {return $self->Bullet($token,"roman")};
     /[a-z][.)] /   && do {return $self->Bullet($token,"alpha")};
@@ -285,7 +283,9 @@ sub Par {
 sub Indent {
   my $self = shift; my $token = shift;
   if ($self->{atLineStart}) {
-    my $indent = $self->{actualIndent} = length($token);
+    my $tabs = $token;
+    $tabs =~ s/    /\t/g;  # turn spaces into tabs
+    my $indent = $self->{actualIndent} = length($tabs);
     if ($indent != $self->{indent}) {
       $self->End("indentation change");
       $self->{indent} = $indent;
@@ -855,7 +855,6 @@ sub pushText {
   my $self = shift;
   foreach my $text (@_) {
     if ($text ne "") {
-      $text =~ s/\t/    /g;
       push(@{$self->{stack}},$text);
     }
   }
@@ -1013,7 +1012,7 @@ sub Answer {
         $method = "named_".$method;
       }
       $rule = $ans->$method(@options);
-      $rule = PGML::LaTeX($rule) if $item->{hasStar};
+      $rule = PGML::LaTeX($rule);
       if (!(ref($ans) eq 'MultiAnswer' && $ans->{part} > 1)) {
         if (defined($item->{name})) {
           main::NAMED_ANS($item->{name} => $ans->cmp);
@@ -1349,7 +1348,9 @@ package PGML::Format::ptx;
 sub Escape {
   my $self = shift;
   my $string = shift; return "" unless defined $string;
-  $string = main::PTX_special_character_cleanup($string);
+  $string =~ s/&/&/g;
+  $string =~ s//>/g;
   return $string;
 }
 
@@ -1362,7 +1363,7 @@ sub Indent {
 # No align for PTX
 sub Align {
   my $self = shift; my $item = shift;
-  return $self->string($item);
+  return "\n" . $self->string($item);
 }
 
 my %bullet = (
@@ -1394,29 +1395,33 @@ sub Bullet {
 
 sub Code {
   my $self = shift; my $item = shift;
-  my $class = ($item->{class} ? ' class="'.$item->{class}.'"' : "");
-  return $self->nl .
-    "\n" .
-    join("<\/cline>\n", split(/\n/,$self->string($item))) .
-    "<\/cline>\n<\/cd>\n";
+  my $code = ($self->string($item) =~ /\n/)
+    ?
+      $self->nl .
+      "
\n" .
+      join("<\/cline>\n", split(/\n/,$self->string($item))) .
+      "<\/cline>\n<\/pre>\n"
+    :
+      $self->nl .
+      "
" . $self->string($item) . "<\/pre>\n";
+  ## Restore escaped characters
+  $code =~ s//&/g;
+  $code =~ s//</g;
+  $code =~ s//>/g;
+  return $code;
 }
 
 sub Pre {
   my $self = shift; my $item = shift;
-  return
-    $self->nl .
-    '
' .
-    $self->string($item) .
-    "
\n"; + ## PGML pre can have stylized contents like bold, + ## and PTX pre cannot have element children + return "\n"; } # PreTeXt can't use headings. sub Heading { my $self = shift; my $item = shift; - my $n = $item->{n}; - my $text = $self->string($item); - $text =~ s/^ +| +$//gm; $text =~ s! +(
)!$1!g; - return $text."\n"; + return "\n" . $self->string($item); } sub Par { @@ -1428,7 +1433,7 @@ sub Par { sub Bold { my $self = shift; my $item = shift; - return ''.$self->string($item).''; + return ''.$self->string($item).''; } sub Italic { @@ -1436,8 +1441,8 @@ sub Italic { return ''.$self->string($item).''; } -our %openQuote = ('"' => "", "'" => ""); -our %closeQuote = ('"' => "", "'" => ""); +our %openQuote = ('"' => "", "'" => ""); +our %closeQuote = ('"' => "", "'" => ""); sub Quote { my $self = shift; my $item = shift; my $string = shift; return $openQuote{$item->{token}} if $string eq "" || $string =~ m/(^|[ ({\[\s])$/; @@ -1447,17 +1452,23 @@ sub Quote { # No rule for PTX sub Rule { my $self = shift; my $item = shift; - return $self->nl; + return "\n"; } sub Verbatim { my $self = shift; my $item = shift; - #Don't escape most content. Just < and & - #my $text = $self->Escape($item->{text}); my $text = $item->{text}; - $text =~ s/$text"; + if ($item->{hasStar}) { + #Don't escape most content. Just < and & + $text =~ s/&/&/g; + $text =~ s/$text"; + } + else { + $text =~ s//g; + $text =~ s/(?//g; + $text =~ s/&//g; + } return $text; } diff --git a/macros/PGbasicmacros.pl b/macros/PGbasicmacros.pl index 38f4acd74c..a93d4a66d3 100644 --- a/macros/PGbasicmacros.pl +++ b/macros/PGbasicmacros.pl @@ -18,7 +18,7 @@ =head1 NAME - PGbasicmacros.pl --- located in the courseScripts directory + PGbasicmacros.pl --- located in the courseScripts directory =head1 SYNPOSIS @@ -79,6 +79,8 @@ BEGIN $ECENTER, $BLTR, $ELTR, + $BKBD, + $EKBD, $HR, $LBRACE, $RBRACE, @@ -89,6 +91,9 @@ BEGIN $CARET, $PI, $E, + $LATEX, + $TEX, + $APOS, @ALPHABET, $envir, $PG_random_generator, @@ -113,53 +118,58 @@ sub _PGbasicmacros_init { main::PG_restricted_eval( <<'EndOfFile'); $displayMode = $displayMode; - $main::PAR = PAR(); - $main::BR = BR(); - $main::BRBR = BRBR(); - $main::LQ = LQ(); - $main::RQ = RQ(); - $main::BM = BM(); - $main::EM = EM(); - $main::BDM = BDM(); - $main::EDM = EDM(); - $main::LTS = LTS(); - $main::GTS = GTS(); - $main::LTE = LTE(); - $main::GTE = GTE(); - $main::BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); - $main::END_ONE_COLUMN = END_ONE_COLUMN(); - $main::SOL = SOLUTION_HEADING(); - $main::SOLUTION = SOLUTION_HEADING(); - $main::HINT = HINT_HEADING(); - $main::US = US(); - $main::SPACE = SPACE(); - $main::NBSP = NBSP(); - $main::NDASH = NDASH(); - $main::MDASH = MDASH(); - $main::BLABEL = BLABEL(); - $main::ELABEL = ELABEL(); - $main::BBOLD = BBOLD(); - $main::EBOLD = EBOLD(); - $main::BITALIC = BITALIC(); - $main::EITALIC = EITALIC(); - $main::BUL = BUL(); - $main::EUL = EUL(); - $main::BCENTER = BCENTER(); - $main::ECENTER = ECENTER(); - $main::BLTR = BLTR(); - $main::ELTR = ELTR(); - $main::HR = HR(); - $main::LBRACE = LBRACE(); - $main::RBRACE = RBRACE(); - $main::LB = LB(); - $main::RB = RB(); - $main::DOLLAR = DOLLAR(); - $main::PERCENT = PERCENT(); - $main::CARET = CARET(); - $main::PI = PI(); - $main::E = E(); - @main::ALPHABET = ('A'..'ZZ'); - %main::STICKY_ANSWERS = (); + $main::PAR = PAR(); + $main::BR = BR(); + $main::BRBR = BRBR(); + $main::LQ = LQ(); + $main::RQ = RQ(); + $main::BM = BM(); + $main::EM = EM(); + $main::BDM = BDM(); + $main::EDM = EDM(); + $main::LTS = LTS(); + $main::GTS = GTS(); + $main::LTE = LTE(); + $main::GTE = GTE(); + $main::BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); + $main::END_ONE_COLUMN = END_ONE_COLUMN(); + $main::SOL = SOLUTION_HEADING(); + $main::SOLUTION = SOLUTION_HEADING(); + $main::HINT = HINT_HEADING(); + $main::US = US(); + $main::SPACE = SPACE(); + $main::NBSP = NBSP(); + $main::NDASH = NDASH(); + $main::MDASH = MDASH(); + $main::BLABEL = BLABEL(); + $main::ELABEL = ELABEL(); + $main::BBOLD = BBOLD(); + $main::EBOLD = EBOLD(); + $main::BITALIC = BITALIC(); + $main::EITALIC = EITALIC(); + $main::BUL = BUL(); + $main::EUL = EUL(); + $main::BCENTER = BCENTER(); + $main::ECENTER = ECENTER(); + $main::BLTR = BLTR(); + $main::ELTR = ELTR(); + $main::BKBD = BKBD(); + $main::EKBD = EKBD(); + $main::HR = HR(); + $main::LBRACE = LBRACE(); + $main::RBRACE = RBRACE(); + $main::LB = LB(); + $main::RB = RB(); + $main::DOLLAR = DOLLAR(); + $main::PERCENT = PERCENT(); + $main::CARET = CARET(); + $main::PI = PI(); + $main::E = E(); + $main::LATEX = LATEX(); + $main::TEX = TEX(); + $main::APOS = APOS(); + @main::ALPHABET = ('A'..'ZZ'); + %main::STICKY_ANSWERS = (); EndOfFile @@ -168,52 +178,57 @@ sub _PGbasicmacros_init { # This can't be done inside the eval above because my variables seem to be invisible inside the eval - $PAR = PAR(); - $BR = BR(); - $BRBR = BRBR(); - $LQ = LQ(); - $RQ = RQ(); - $BM = BM(); - $EM = EM(); - $BDM = BDM(); - $EDM = EDM(); - $LTS = LTS(); - $GTS = GTS(); - $LTE = LTE(); - $GTE = GTE(); - $BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); - $END_ONE_COLUMN = END_ONE_COLUMN(); - $SOL = SOLUTION_HEADING(); - $SOLUTION = SOLUTION_HEADING(); - $HINT = HINT_HEADING(); - $US = US(); - $SPACE = SPACE(); - $NBSP = NBSP(); - $NDASH = NDASH(); - $MDASH = MDASH(); - $BLABEL = BLABEL(); - $ELABEL = ELABEL(); - $BBOLD = BBOLD(); - $EBOLD = EBOLD(); - $BITALIC = BITALIC(); - $EITALIC = EITALIC(); - $BUL = BUL(); - $EUL = EUL(); - $BCENTER = BCENTER(); - $ECENTER = ECENTER(); - $BLTR = BLTR(); - $ELTR = ELTR(); - $HR = HR(); - $LBRACE = LBRACE(); - $RBRACE = RBRACE(); - $LB = LB(); - $RB = RB(); - $DOLLAR = DOLLAR(); - $PERCENT = PERCENT(); - $CARET = CARET(); - $PI = PI(); - $E = E(); - @ALPHABET = ('A'..'ZZ'); + $PAR = PAR(); + $BR = BR(); + $BRBR = BRBR(); + $LQ = LQ(); + $RQ = RQ(); + $BM = BM(); + $EM = EM(); + $BDM = BDM(); + $EDM = EDM(); + $LTS = LTS(); + $GTS = GTS(); + $LTE = LTE(); + $GTE = GTE(); + $BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); + $END_ONE_COLUMN = END_ONE_COLUMN(); + $SOL = SOLUTION_HEADING(); + $SOLUTION = SOLUTION_HEADING(); + $HINT = HINT_HEADING(); + $US = US(); + $SPACE = SPACE(); + $NBSP = NBSP(); + $NDASH = NDASH(); + $MDASH = MDASH(); + $BLABEL = BLABEL(); + $ELABEL = ELABEL(); + $BBOLD = BBOLD(); + $EBOLD = EBOLD(); + $BITALIC = BITALIC(); + $EITALIC = EITALIC(); + $BUL = BUL(); + $EUL = EUL(); + $BCENTER = BCENTER(); + $ECENTER = ECENTER(); + $BLTR = BLTR(); + $ELTR = ELTR(); + $BKBD = BKBD(); + $EKBD = EKBD(); + $HR = HR(); + $LBRACE = LBRACE(); + $RBRACE = RBRACE(); + $LB = LB(); + $RB = RB(); + $DOLLAR = DOLLAR(); + $PERCENT = PERCENT(); + $CARET = CARET(); + $PI = PI(); + $E = E(); + $LATEX = LATEX(); + $TEX = TEX(); + $APOS = APOS(); + @ALPHABET = ('A'..'ZZ'); $envir = PG_restricted_eval(q!\%main::envir!); $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!); @@ -223,25 +238,25 @@ sub _PGbasicmacros_init { } # =head2 Utility Macros -# +# # not_null(item) returns 1 or 0 -# +# # empty arrays, empty hashes, strings containing only whitespace are all NULL and return 0 # all undefined quantities are null and return 0 -# -# +# +# # =cut -# +# # sub not_null { # empty arrays, empty hashes and strings containing only whitespace are all NULL # my $item = shift; -# return 0 unless defined($item); -# if (ref($item)=~/ARRAY/) { -# return scalar(@{$item}); # return the length -# } elsif (ref($item)=~/HASH/) { -# return scalar( keys %{$item}); -# } else { # string case return 1 if none empty -# return ($item =~ /\S/)? 1:0; -# } +# return 0 unless defined($item); +# if (ref($item)=~/ARRAY/) { +# return scalar(@{$item}); # return the length +# } elsif (ref($item)=~/HASH/) { +# return scalar( keys %{$item}); +# } else { # string case return 1 if none empty +# return ($item =~ /\S/)? 1:0; +# } # } =head2 Answer blank macros: @@ -323,10 +338,10 @@ =head2 Answer blank macros: These are legacy macros: - ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME( ), width) - ANS_BOX( question_number,height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME( ), height, width) - ANS_RADIO( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME( ), value,tag) - ANS_RADIO_OPTION( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag) + ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME( ), width) + ANS_BOX( question_number,height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME( ), height, width) + ANS_RADIO( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME( ), value,tag) + ANS_RADIO_OPTION( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value,tag) =cut @@ -349,22 +364,22 @@ sub NAMED_ANS_RULE { #FIXME -- code factoring needed if ($answer_value =~ /\0/ ) { - my @answers = split("\0", $answer_value); - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name}=\@answers; - # store the rest -- beacuse this stores to a main:; variable - # it must be evaluated at run time - $answer_value= '' unless defined($answer_value); + my @answers = split("\0", $answer_value); + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name}=\@answers; + # store the rest -- beacuse this stores to a main:; variable + # it must be evaluated at run time + $answer_value= '' unless defined($answer_value); } elsif (ref($answer_value) eq 'ARRAY') { my @answers = @{ $answer_value}; - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name}=\@answers; + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name}=\@answers; - # store the rest -- because this stores to a main:; variable - # it must be evaluated at run time - $answer_value= '' unless defined($answer_value); + # store the rest -- because this stores to a main:; variable + # it must be evaluated at run time + $answer_value= '' unless defined($answer_value); } - + # $answer_value =~ tr/\\$@`//d; ## unnecessary since we encode HTML now $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer $name = RECORD_ANS_NAME($name, $answer_value); @@ -372,13 +387,13 @@ sub NAMED_ANS_RULE { my $previous_name = "previous_$name"; $name = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%$name":$name; $previous_name = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%$previous_name": $previous_name; - + #INSERT_RESPONSE($name,$name,$answer_value); #FIXME -- why can't we do this inside RECORD_ANS_NAME? my $label; if (defined ($options{aria_label})) { - $label = $options{aria_label}; + $label = $options{aria_label}; } else { - $label = generate_aria_label($name); + $label = generate_aria_label($name); } my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max @@ -395,41 +410,40 @@ sub NAMED_ANS_RULE { } # end of addition for dragmath - + MODES( TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", - Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, - - # Note: codeshard is used in the css to identify input elements - # that come from pg - HTML => qq!\n!. - $add_html. # added for dragmath - qq!\n!, - PTX => '', - + Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, + + # Note: codeshard is used in the css to identify input elements that come from pg + HTML => qq!\n! . $add_html . # added for dragmath + qq!\n!, + PTX => qq!! ); } -sub NAMED_HIDDEN_ANS_RULE { # this is used to hold information being passed into and out of applets +sub NAMED_HIDDEN_ANS_RULE { # this is used to hold information being passed into and out of applets # -- preserves state -- identical to NAMED_ANS_RULE except input type "hidden" my($name,$col) = @_; $col = 20 unless not_null($col); my $answer_value = ''; $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); if ($answer_value =~ /\0/ ) { - my @answers = split("\0", $answer_value); - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name}=\@answers; - # store the rest -- beacuse this stores to a main:; variable - # it must be evaluated at run time - $answer_value= '' unless defined($answer_value); + my @answers = split("\0", $answer_value); + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name}=\@answers; + # store the rest -- beacuse this stores to a main:; variable + # it must be evaluated at run time + $answer_value= '' unless defined($answer_value); } elsif (ref($answer_value) eq 'ARRAY') { my @answers = @{ $answer_value}; - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name}=\@answers; - # store the rest -- beacuse this stores to a main:; variable - # it must be evaluated at run time - $answer_value= '' unless defined($answer_value); + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name}=\@answers; + # store the rest -- beacuse this stores to a main:; variable + # it must be evaluated at run time + $answer_value= '' unless defined($answer_value); } # $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 @@ -444,9 +458,9 @@ sub NAMED_HIDDEN_ANS_RULE { # this is used to hold information being passed into MODES( TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", - Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, - HTML => qq!!. - qq!!, + Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, + HTML => qq!!. + qq!!, PTX => '', ); } @@ -461,20 +475,18 @@ sub NAMED_ANS_RULE_EXTENSION { my $label; if (defined ($options{aria_label})) { - $label = $options{aria_label}; + $label = $options{aria_label}; } else { - $label = generate_aria_label($name); + $label = generate_aria_label($name); } # $answer_group_name is the name of the parent answer group - # the group name is usually the same as the answer blank name - # when there is only one answer blank. - - - - my $answer_group_name = $options{answer_group_name}//''; + # the group name is usually the same as the answer blank name + # when there is only one answer blank. + + my $answer_group_name = $options{answer_group_name}//''; unless ($answer_group_name) { WARN_MESSAGE("Error in NAMED_ANSWER_RULE_EXTENSION: every call to this subroutine needs - to have \$options{answer_group_name} defined. For a single answer blank this is + to have \$options{answer_group_name} defined. For a single answer blank this is usually the same as the answer blank name. Answer blank name: $name"); } # warn "from named answer rule extension in PGbasic answer_group_name: |$answer_group_name|"; @@ -486,8 +498,8 @@ sub NAMED_ANS_RULE_EXTENSION { } # $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer - # warn "from NAMED_ANSWER_RULE_EXTENSION in PGbasic: - # answer_group_name: |$answer_group_name| name: |$name| answer value: |$answer_value|"; + # warn "from NAMED_ANSWER_RULE_EXTENSION in PGbasic: + # answer_group_name: |$answer_group_name| name: |$name| answer value: |$answer_value|"; INSERT_RESPONSE($answer_group_name,$name,$answer_value); #FIXME hack -- this needs more work to decide how to make it work $answer_value = encode_pg_and_html($answer_value); @@ -495,10 +507,12 @@ sub NAMED_ANS_RULE_EXTENSION { $tcol = $tcol < 40 ? $tcol : 40; ## get min MODES( TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", - Latex2HTML => qq!\\begin{rawhtml}\n\n\\end{rawhtml}\n!, - HTML => qq!!. - qq!!, - PTX => '', + Latex2HTML => qq!\\begin{rawhtml}\n\n\\end{rawhtml}\n!, + HTML => qq!! . + qq!!, + PTX => qq!!, ); } @@ -517,24 +531,24 @@ sub ANS_RULE { #deprecated $row = 10 unless defined($row); $col = 80 unless defined($col); - + my $height = .07*$row; my $answer_value = ''; $answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} ); $name = RECORD_ANS_NAME($name, $answer_value); my $label; if (defined ($options{aria_label})) { - $label = $options{aria_label}; + $label = $options{aria_label}; } else { - $label = generate_aria_label($name); + $label = generate_aria_label($name); } # $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 #INSERT_RESPONSE($name,$name,$answer_value); # no longer needed? # try to escape HTML entities to deal with xss stuff $answer_value = encode_pg_and_html($answer_value); my $out = MODES( - TeX => qq!\\vskip $height in \\hrulefill\\quad !, - Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, HTML => qq! @@ -555,11 +569,11 @@ sub NAMED_ANS_RADIO { my $name = shift; my $value = shift; my $tag =shift; - + my $checked = ''; if ($value =~/^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED' + $value =~ s/^\%//; + $checked = 'CHECKED' } if (defined($inputs_ref->{$name}) ) { if ($inputs_ref->{$name} eq $value) { @@ -593,8 +607,8 @@ sub NAMED_ANS_RADIO_EXTENSION { my $checked = ''; if ($value =~/^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED' + $value =~ s/^\%//; + $checked = 'CHECKED' } if (defined($inputs_ref->{$name}) ) { if ($inputs_ref->{$name} eq $value) { @@ -607,9 +621,9 @@ sub NAMED_ANS_RADIO_EXTENSION { EXTEND_RESPONSE($name,$name,$value, $checked); my $label; if (defined ($options{aria_label})) { - $label = $options{aria_label}; + $label = $options{aria_label}; } else { - $label = generate_aria_label($name); + $label = generate_aria_label($name); } MODES( @@ -634,7 +648,7 @@ sub NAMED_ANS_RADIO_BUTTONS { while (@buttons) { $value = shift @buttons; $tag = shift @buttons; push(@out, NAMED_ANS_RADIO_OPTION($name, $value,$tag, - aria_label=>$label."option $count ")); + aria_label=>$label."option $count ")); $count++; } (wantarray) ? @out : join(" ",@out); @@ -666,7 +680,7 @@ sub ANS_RADIO_BUTTONS { push(@out, ANS_RADIO($number, $value,$tag)); my @buttons = @_; while (@buttons) { - $value = shift @buttons; $tag = shift @buttons; + $value = shift @buttons; $tag = shift @buttons; push(@out, ANS_RADIO_OPTION($number, $value,$tag)); } (wantarray) ? @out : join(" ",@out); @@ -687,24 +701,24 @@ sub generate_aria_label { return maketext('answer').' '.$name; } - # check for quiz prefix + # check for quiz prefix if ($name =~ /^Q\d+/ || $name =~ /^MaTrIx_Q\d+/) { $name =~ s/Q0*(\d+)_//; $label .= maketext('problem').' '.$1.' '; } - # get answer number + # get answer number $name =~ /AnSwEr0*(\d+)/; $label .= maketext('answer').' '.$1.' '; - + # check for Multianswer if ($name =~ /MuLtIaNsWeR_/) { $name =~ s/MuLtIaNsWeR_//; $name =~ /AnSwEr(\d+)_(\d+)/; $label .= maketext('part').' '.($2+1).' '; } - - # check for Matrix + + # check for Matrix if ($name =~ /^MaTrIx_/) { $name =~ /_(\d+)_(\d+)$/; $label .= maketext('row').' '.($1+1) @@ -717,7 +731,7 @@ sub generate_aria_label { ############################################## # contained_in( $elem, $array_reference or null separated string); -# determine whether element is equal +# determine whether element is equal # ( in the sense of eq, not ==, ) to an element in the array. ############################################## sub contained_in { @@ -729,13 +743,13 @@ sub contained_in { foreach my $item (@input_list ) { if ($item =~ /\0/) { push @output_list, split('\0', $item); - } elsif (ref($item) =~/ARRAY/) { - push @output_list, @{$item}; - } else { - push @output_list, $item; - } + } elsif (ref($item) =~/ARRAY/) { + push @output_list, @{$item}; + } else { + push @output_list, $item; + } } - + my @match_list = grep {$element eq $_ } @output_list; if ( @match_list ) { return 1; @@ -753,12 +767,12 @@ sub NAMED_ANS_CHECKBOX { my $name = shift; my $value = shift; my $tag =shift; - + my $checked = ''; if ($value =~/^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED' + $value =~ s/^\%//; + $checked = 'CHECKED' } if (defined($inputs_ref->{$name}) ) { @@ -791,8 +805,8 @@ sub NAMED_ANS_CHECKBOX_OPTION { my $checked = ''; if ($value =~/^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED' + $value =~ s/^\%//; + $checked = 'CHECKED' } if (defined($inputs_ref->{$name}) ) { @@ -807,9 +821,9 @@ sub NAMED_ANS_CHECKBOX_OPTION { EXTEND_RESPONSE($name,$name,$value, $checked); my $label; if (defined ($options{aria_label})) { - $label = $options{aria_label}; + $label = $options{aria_label}; } else { - $label = generate_aria_label($name); + $label = generate_aria_label($name); } MODES( @@ -828,7 +842,7 @@ sub NAMED_ANS_CHECKBOX_BUTTONS { my @out = (); push(@out, NAMED_ANS_CHECKBOX($name, $value,$tag)); - my $label = generate_aria_label($name); + my $label = generate_aria_label($name); my $count = 2; my @buttons = @_; while (@buttons) { @@ -1027,7 +1041,7 @@ sub NAMED_POP_UP_LIST { || $displayMode eq 'HTML' || $displayMode eq 'HTML_tth' || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_asciimath' || $displayMode eq 'HTML_LaTeXMathML' || $displayMode eq 'HTML_img') { $out = qq!\n\\end{rawhtml}\n!, - HTML => qq!\n!, - PTX => qq!!, + Latex2HTML => qq!\\begin{rawhtml}\n\n\\end{rawhtml}\n!, + HTML => qq!\n!, + PTX => qq!!, ); } @@ -1174,7 +1189,7 @@ sub ans_array{ my $col = shift; $col = 20 unless $col; my $ans_label = NEW_ANS_NAME(); - my $num = ans_rule_count(); + my $num = ans_rule_count(); my @options = @_; my @array=(); my $answer_value = ""; @@ -1182,8 +1197,8 @@ sub ans_array{ my $name; $main::vecnum = -1; CLEAR_RESPONSES($ans_label); - - + + for( my $i = 0; $i < $n; $i+=1) { $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,0,$i); @@ -1196,7 +1211,7 @@ sub ans_array{ for( my $i = 0; $i < $n; $i+=1) { $name = NEW_ANS_ARRAY_NAME_EXTENSION($num,$j,$i); - $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label); + $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label); } } @@ -1286,24 +1301,24 @@ sub solution { my $ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL = ( defined( $envir->{'ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL'} ) ) ? $envir->{'ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL'} : 10000; my $displaySolution = PG_restricted_eval(q!$main::envir{'displaySolutionsQ'}!); my $printSolutionForInstructor = ( - ($displayMode ne 'TeX' && ( $permissionLevel >= $ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL ) ) + ($displayMode ne 'TeX' && ( $permissionLevel >= $ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL ) ) || ($displayMode eq 'TeX' && $displaySolution && ($permissionLevel >= $ALWAYS_SHOW_SOLUTION_PERMISSION_LEVEL) ) ); PG_restricted_eval(q!$main::solutionExists = 1!); # set solution exists variable.--don't need PGeval?? - - if ($printSolutionForInstructor) { # always print solutions for instructor types + + if ($printSolutionForInstructor) { # always print solutions for instructor types $out = join(' ', $BITALIC, "(", maketext("Instructor solution preview: show the student solution after due date.")," )$BR",$EITALIC, @in); - } elsif ( $displaySolution ) { + } elsif ( $displaySolution ) { $out = join(' ',@in); # display solution - } + } $out; } sub SOLUTION { - if ($displayMode =~/HTML/ and $envir->{use_knowls_for_solutions}) { - TEXT( $PAR, knowlLink(SOLUTION_HEADING(), value => escapeSolutionHTML($BR . solution(@_) . $PAR ), - base64 =>1 ) ) if solution(@_); + if ($displayMode =~/HTML/ and $envir->{use_knowls_for_solutions}) { + TEXT( $PAR, knowlLink(SOLUTION_HEADING(), value => escapeSolutionHTML($BR . solution(@_) . $PAR ), + base64 =>1 ) ) if solution(@_); } elsif ($displayMode=~/TeX/) { TEXT( "\n%%% BEGIN SOLUTION\n", #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying @@ -1321,7 +1336,7 @@ sub SOLUTION { sub hint { - my @in = @_; + my @in = @_; my $out = ''; my $permissionLevel = $envir->{permissionLevel}||0; #PG_restricted_eval(q!$main::envir{permissionLevel}!); #user permission level # protect against undefined values @@ -1329,32 +1344,32 @@ sub hint { my $showHint = PG_restricted_eval(q!$main::showHint!); my $displayHint = PG_restricted_eval(q!$main::envir{'displayHintsQ'}!); my $printHintForInstructor = ( - ( ( $displayMode ne 'TeX' ) && ( $permissionLevel >= $ALWAYS_SHOW_HINT_PERMISSION_LEVEL ) ) + ( ( $displayMode ne 'TeX' ) && ( $permissionLevel >= $ALWAYS_SHOW_HINT_PERMISSION_LEVEL ) ) || ( ($displayMode eq 'TeX') && $displayHint && ( $permissionLevel >= $ALWAYS_SHOW_HINT_PERMISSION_LEVEL )) ); PG_restricted_eval(q!$main::hintExists =1!); PG_restricted_eval(q!$main::numOfAttempts = 0 unless defined($main::numOfAttempts);!); my $attempts = PG_restricted_eval(q!$main::numOfAttempts!); - + if ($displayMode =~ /TeX/) { my $afterAnswerDate = ( time() > $envir{answerDate} ); - if ($printHintForInstructor) { - $out = join(' ', $BITALIC,maketext("(Instructor hint preview: show the student hint after the following number of attempts:"), $showHint,$BR, $EITALIC, @in); - } elsif ( $displayHint and $afterAnswerDate ) { # only display hints after the answer date. - $out = join(' ',@in); - } - + if ($printHintForInstructor) { + $out = join(' ', $BITALIC,maketext("(Instructor hint preview: show the student hint after the following number of attempts:"), $showHint,$BR, $EITALIC, @in); + } elsif ( $displayHint and $afterAnswerDate ) { # only display hints after the answer date. + $out = join(' ',@in); + } + } elsif ($displayMode =~/HTML/) { - if ($printHintForInstructor) { # always print hints for instructor types in HTML mode - $out = join(' ', $BITALIC,maketext("(Instructor hint preview: show the student hint after the following number of attempts:"), $showHint,"$BR", $EITALIC, @in); - } elsif ( $displayHint and ( $attempts > $showHint ) ) { - ## the second test above prevents a hint being shown if a doctored form is submitted - $out = join(' ',@in); - } + if ($printHintForInstructor) { # always print hints for instructor types in HTML mode + $out = join(' ', $BITALIC,maketext("(Instructor hint preview: show the student hint after the following number of attempts:"), $showHint,"$BR", $EITALIC, @in); + } elsif ( $displayHint and ( $attempts > $showHint ) ) { + ## the second test above prevents a hint being shown if a doctored form is submitted + $out = join(' ',@in); + } } elsif ($displayMode=~/PTX/) { $out = join(' ',@in); } - + $out ; } @@ -1372,8 +1387,8 @@ sub HINT { } elsif ($displayMode=~/PTX/) { TEXT( '',"\n",hint(@_),"\n",'',"\n\n") if hint(@_); } else { - TEXT($PAR, HINT_HEADING(), $BR. hint(@_) . $PAR) if hint(@_); - } + TEXT($PAR, HINT_HEADING(), $BR. hint(@_) . $PAR) if hint(@_); + } } @@ -1396,7 +1411,7 @@ =head2 Comments to instructors COMMENT('text','text2',...); -Takes the text to be lines of a comment to be shown only +Takes the text to be lines of a comment to be shown only in the Library Browser below the rendered problem. The function COMMENT stores the needed html in the variable @@ -1408,7 +1423,7 @@ =head2 Comments to instructors # Currently, the only output is html sub COMMENT { - my @in = @_; + my @in = @_; my $out = join("$BR", @in); $out = '
'.$out.'
'; PG_restricted_eval(q!$main::pgComment .= "!.$out.q!"!); @@ -1422,7 +1437,7 @@ sub COMMENT { =head2 Pseudo-random number generator Usage: - random(0,5,.1) # produces a random number between 0 and 5 in increments of .1 + random(0,5,.1) # produces a random number between 0 and 5 in increments of .1 non_zero_random(0,5,.1) # gives a non-zero random number list_random(2,3,5,6,7,8,10) # produces random value from the list @@ -1447,13 +1462,13 @@ sub random { sub non_zero_random { ##gives a non-zero random number - my (@arguments)=@_; - my $a=0; - my $i=100; #safety counter - while ($a==0 && ( 0 < $i-- ) ) { - $a=random(@arguments); - } - $a; + my (@arguments)=@_; + my $a=0; + my $i=100; #safety counter + while ($a==0 && ( 0 < $i-- ) ) { + $a=random(@arguments); + } + $a; } sub list_random { @@ -1522,10 +1537,10 @@ sub M3 { # This replaces M3. You can add new modes at will to this one. sub MODES { my %options = @_; - + # is a string supplied for the current display mode? if so, return it return $options{$main::displayMode} if defined $options{$main::displayMode}; - + # otherwise, fail over to backup modes my @backup_modes; if (exists $DISPLAY_MODE_FAILOVER{$main::displayMode}) { @@ -1543,52 +1558,57 @@ sub MODES { =head2 Display constants - @ALPHABET ALPHABET() capital letter alphabet -- ALPHABET[0] = 'A' - $PAR PAR() paragraph character (\par or

) - $BR BR() line break character - $BRBR BRBR() line break character - $LQ LQ() left double quote - $RQ RQ() right double quote - $BM BM() begin math - $EM EM() end math - $BDM BDM() begin display math - $EDM EDM() end display math - $LTS LTS() strictly less than - $GTS GTS() strictly greater than - $LTE LTE() less than or equal - $GTE GTE() greater than or equal - $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN() begin one-column mode - $END_ONE_COLUMN END_ONE_COLUMN() end one-column mode - $SOL SOLUTION_HEADING() solution headline - $SOLUTION SOLUTION_HEADING() solution headline - $HINT HINT_HEADING() hint headline - $US US() underscore character - $SPACE SPACE() space character (tex and latex only) - $NBSP NBSP() non breaking space character - $NDASH NDASH() en dash character - $MDASH MDASH() em dash character - $BLABEL BLABEL() begin label (for input) - $ELABEL ELABEL() end label (for input) - $BBOLD BBOLD() begin bold typeface - $EBOLD EBOLD() end bold typeface - $BITALIC BITALIC() begin italic typeface - $EITALIC EITALIC() end italic typeface - $BUL BUL() begin underlined type - $EUL EUL() end underlined type - $BCENTER BCENTER() begin centered environment - $ECENTER ECENTER() end centered environment - $BLTR BLTR() begin left to right environment - $ELTR ELTR() end left to right environment - $HR HR() horizontal rule - $LBRACE LBRACE() left brace - $LB LB () left brace - $RBRACE RBRACE() right brace - $RB RB () right brace - $DOLLAR DOLLAR() a dollar sign - $PERCENT PERCENT() a percent sign - $CARET CARET() a caret sign - $PI PI() the number pi - $E E() the number e + @ALPHABET ALPHABET() capital letter alphabet -- ALPHABET[0] = 'A' + $PAR PAR() paragraph character (\par or

) + $BR BR() line break character + $BRBR BRBR() line break character + $LQ LQ() left double quote + $RQ RQ() right double quote + $BM BM() begin math + $EM EM() end math + $BDM BDM() begin display math + $EDM EDM() end display math + $LTS LTS() strictly less than + $GTS GTS() strictly greater than + $LTE LTE() less than or equal + $GTE GTE() greater than or equal + $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN() begin one-column mode + $END_ONE_COLUMN END_ONE_COLUMN() end one-column mode + $SOL SOLUTION_HEADING() solution headline + $SOLUTION SOLUTION_HEADING() solution headline + $HINT HINT_HEADING() hint headline + $US US() underscore character + $SPACE SPACE() space character (tex and latex only) + $NBSP NBSP() non breaking space character + $NDASH NDASH() en dash character + $MDASH MDASH() em dash character + $BLABEL BLABEL() begin label (for input) + $ELABEL ELABEL() end label (for input) + $BBOLD BBOLD() begin bold typeface + $EBOLD EBOLD() end bold typeface + $BITALIC BITALIC() begin italic typeface + $EITALIC EITALIC() end italic typeface + $BUL BUL() begin underlined type + $EUL EUL() end underlined type + $BCENTER BCENTER() begin centered environment + $ECENTER ECENTER() end centered environment + $BLTR BLTR() begin left to right environment + $ELTR ELTR() end left to right environment + $BKBD BKBD() begin "keyboard" input text + $EKBD EKBD() end "keyboard" input text + $HR HR() horizontal rule + $LBRACE LBRACE() left brace + $LB LB () left brace + $RBRACE RBRACE() right brace + $RB RB () right brace + $DOLLAR DOLLAR() a dollar sign + $PERCENT PERCENT() a percent sign + $CARET CARET() a caret sign + $PI PI() the number pi + $E E() the number e + $LATEX LATEX() the LaTeX logo + $TEX TEX() the TeX logo + $APOS APOS() an apostrophe =cut @@ -1613,8 +1633,8 @@ sub ALPHABET { # which looks better but kills more trees. sub BR { MODES( TeX => '\\leavevmode\\\\\\relax ', Latex2HTML => '\\begin{rawhtml}
\\end{rawhtml}', HTML => '
', PTX => "\n\n"); }; sub BRBR { MODES( TeX => '\\leavevmode\\\\\\relax \\leavevmode\\\\\\relax ', Latex2HTML => '\\begin{rawhtml}

\\end{rawhtml}', HTML => '

', PTX => "\n"); }; -sub LQ { MODES( TeX => "\\lq\\lq{}", Latex2HTML => '"', HTML => '"', PTX => '' ); }; -sub RQ { MODES( TeX => "\\rq\\rq{}", Latex2HTML => '"', HTML => '"', PTX => '' ); }; +sub LQ { MODES( TeX => "\\lq\\lq{}", Latex2HTML => '"', HTML => '"', PTX => '' ); }; +sub RQ { MODES( TeX => "\\rq\\rq{}", Latex2HTML => '"', HTML => '"', PTX => '' ); }; sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML => '', PTX => ''); }; # begin math mode sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML => '', PTX => ''); }; # end math mode sub BDM { MODES(TeX => '\\[', Latex2HTML => '\\[', HTML => '

', PTX => ''); }; #begin displayMath mode @@ -1635,13 +1655,13 @@ sub ALPHABET { PTX => ''); }; sub HINT_HEADING { MODES( TeX => "\\par {\\bf ".maketext('Hint:')." }", Latex2HTML => "\\par {\\bf ".maketext('Hint:')." }", HTML => "".maketext('Hint:')." ", PTX => ''); }; -sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_', PTX => '');}; # underscore, e.g. file${US}name +sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_', PTX => '_');}; # underscore, e.g. file${US}name sub SPACE { MODES(TeX => '\\ ', Latex2HTML => '\\ ', HTML => ' ', PTX => ' ');}; # force a space in latex, doesn't force extra space in html -sub NBSP { MODES(TeX => '~', Latex2HTML => '~', HTML => ' ', PTX => '');}; -sub NDASH { MODES(TeX => '--', Latex2HTML => '--', HTML => '–', PTX => '');}; -sub MDASH { MODES(TeX => '---', Latex2HTML => '---', HTML => '—', PTX => '');}; -sub BBOLD { MODES(TeX => '{\\bf ', Latex2HTML => '{\\bf ', HTML => '', PTX => ''); }; -sub EBOLD { MODES( TeX => '}', Latex2HTML => '}',HTML => '', PTX => ''); }; +sub NBSP { MODES(TeX => '~', Latex2HTML => '~', HTML => ' ', PTX => '');}; +sub NDASH { MODES(TeX => '--', Latex2HTML => '--', HTML => '–', PTX => '');}; +sub MDASH { MODES(TeX => '---', Latex2HTML => '---', HTML => '—', PTX => '');}; +sub BBOLD { MODES(TeX => '{\\bf ', Latex2HTML => '{\\bf ', HTML => '', PTX => ''); }; +sub EBOLD { MODES( TeX => '}', Latex2HTML => '}',HTML => '', PTX => ''); }; sub BLABEL { MODES(TeX => '', Latex2HTML => '', HTML => '', PTX => ''); }; sub BITALIC { MODES(TeX => '{\\it ', Latex2HTML => '{\\it ', HTML => '', PTX => ''); }; @@ -1652,16 +1672,253 @@ sub ALPHABET { sub ECENTER { MODES(TeX => '\\end{center} ', Latex2HTML => ' \\begin{rawhtml} \\end{rawhtml} ', HTML => '', PTX => ''); }; sub BLTR { MODES(TeX => ' ', Latex2HTML => ' \\begin{rawhtml}

\\end{rawhtml} ', HTML => '', PTX => ''); }; sub ELTR { MODES(TeX => ' ', Latex2HTML => ' \\begin{rawhtml}
\\end{rawhtml} ', HTML => '', PTX => ''); }; +sub BKBD { MODES(TeX => '\\texttt{' , Latex2HTML => '', HTML => '', PTX => ''); }; +sub EKBD { MODES(TeX => '}', Latex2HTML => '', HTML => '', PTX => ''); }; sub HR { MODES(TeX => '\\par\\hrulefill\\par ', Latex2HTML => '\\begin{rawhtml}
\\end{rawhtml}', HTML => '
', PTX => ''); }; -sub LBRACE { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace', PTX => '' ); }; #not for use in math mode -sub RBRACE { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace', PTX => '' ); }; #not for use in math mode -sub LB { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace', PTX => '' ); }; #not for use in math mode -sub RB { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace', PTX => '' ); }; #not for use in math mode -sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '$', HTML => '$', PTX => '' ); }; -sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%', PTX => '' ); }; -sub CARET { MODES( TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^', PTX => '' ); }; +sub LBRACE { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace', PTX => '{' ); }; #not for use in math mode +sub RBRACE { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace', PTX => '}' ); }; #not for use in math mode +sub LB { MODES( TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{' , HTML_tth=> '\\lbrace', PTX => '{' ); }; #not for use in math mode +sub RB { MODES( TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}' , HTML_tth=> '\\rbrace', PTX => '}' ); }; #not for use in math mode +sub DOLLAR { MODES( TeX => '\\$', Latex2HTML => '$', HTML => '$', PTX => '$' ); }; +sub PERCENT { MODES( TeX => '\\%', Latex2HTML => '\\%', HTML => '%', PTX => '%' ); }; +sub CARET { MODES( TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^', PTX => '^' ); }; sub PI {4*atan2(1,1);}; sub E {exp(1);}; +sub LATEX { MODES( TeX => '\\LaTeX', HTML => '\\(\\mathrm\\LaTeX\\)', PTX => '' ); }; +sub TEX { MODES( TeX => '\\TeX', HTML => '\\(\\mathrm\\TeX\\)', PTX => '' ); }; +sub APOS { MODES( TeX => "'", HTML => "'", PTX => "\\'" ); }; + +############################################################### + +=head2 SPAN and DIV macros + These are functions primarly meant to add + HTML block level DIV or inline SPAN + tags and the relevant closing tags for HTML output. + + At present, these macros require the user to provide TeX and + preTeXt strings which will be used in those modes instead of the + HTML block level DIV or inline SPAN tag. + + If they are missing, they will default to the empty string. + If only one string is given, it will be assumed to be the TeX string. + + At present only the following 4 HTML attributes can be set: + lang, dir, class, style. + Using the style option requires creating valid CSS text. + For safety some parsing/cleanup is done and various sorts of + (apparently) invalid values may be dropped. See the code for + details of what input sanitation is done. + + Since the use of style is particularly dangerous, in order to + enable its use you must set allowStyle to 1 in the hash. It is + possible to prevent the use of some of the other options by + setting certain control like allowLang to 0. + + Usage: + openSpan( options_hash, "tex code", "ptx code" ); + closeSpan("tex code","ptx code"); + + Usage where TeX and PTX output will be empty by default. + openSpan( options_hash ); + closeSpan(); + + Sample options hashes + + { "lang" => "he", + "dir" => "rtl", + "class" => "largeText class123" } + + { "lang" => "he", + "allowStyle" => 1, + "style" => "background-color: \"#afafaf; float: left;\t height: 12px;" } + +=cut + +sub processDivSpanOptions { + my $option_ref = {}; $option_ref = shift if ref($_[0]) eq 'HASH'; + + my %options = ( + allowLang => 1, # Setting the lang tag is allowed by default + allowDir => 1, # Setting the dir tag is allowed by default + allowClass => 1, # Setting the class tag is allowed by default + allowStyle => 0, # Setting the style tag is FORBIDDEN by default, use with care! + %{$option_ref}, + ); + + my $LangVal = ""; + if ( $options{allowLang} && defined( $options{lang} ) ) { + # The standard for how the lang tag should be set is explained in + # https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang + # based on the BCP47 standard from https://www.ietf.org/rfc/bcp/bcp47.txt + + # We are going to do only minimal cleanup to the value provided + # making sure that all the characters are in the valid range A-Za-z0-9\- + # but not checking the inner structure + $LangVal = $options{lang}; + if ( $LangVal =~ /[^\w\-]/ ) { + # Clean it up + $LangVal =~ s/[^\w\-]//g; # Drop invalid characters + WARN_MESSAGE("processDivSpanOptions received an HTML LANG attribute setting with invalid characters which were removed. The value after cleanup is $LangVal which may not be what was intended. See https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang for information on how this value should be set"); + } + } + + my $DirVal = ""; + if ( $options{allowDir} && defined( $options{dir} ) ) { + # the ONLY allowed values are: ltr rtl auto + if ( ( $options{dir} eq "ltr" ) || + ( $options{dir} eq "rtl" ) || + ( $options{dir} eq "auto" ) ) { + $DirVal = $options{dir}; + } else { + WARN_MESSAGE("processDivSpanOptions received an invalid value for the HTML DIR attribute. Only ltr rtl auto are allowed. As a result the DIR attribute has not been set."); + } + } + + my $ClassVal = ""; + if ( $options{allowClass} && defined( $options{class} ) ) { + # Class names which are permitted here must start with a letter [A-Za-z] + # and the rest of the class name can be characters in [A-Za-z0-9\-\_]. + + # A space is used to separate class names + + # The offical W3C documentation allows class names to follow a far more general + # grammar, but this is not being permitted here at present. + # See: https://www.w3.org/TR/css-syntax-3/#token-diagrams + + my $hadBadClassNames = 0; + my @rawList = split( ' ', $options{class} ); + my @okList; # Will collect valid class names + my $cl; + while ( @rawList ) { + $cl = shift( @rawList ); + if ( $cl =~ /^[A-Za-z][\w\-\_]*$/ ) { + push( @okList, $cl ); + } else { + $hadBadClassNames = 1; + # print "Invalid classname $cl dropped\n"; + } + } + if ( @okList ) { + $ClassVal = join(' ', @okList); + WARN_MESSAGE("processDivSpanOptions received some CSS class names which are not permitted by PG for the HTML CLASS attribute. Any invalid names were dropped.") if ($hadBadClassNames); + } else { + # No good values arrived + WARN_MESSAGE("processDivSpanOptions received ONLY CSS class names which are not permitted by PG for the HTML CLASS attribute. As a result the CLASS attribute has not been set.") if ($hadBadClassNames); + } + } + + + my $StyleVal = ""; + if ( $options{allowStyle} && defined( $options{style} ) ) { + # The value is validated in a very minimal sense only - use with great care + + # Replace tab with space + $options{style} =~ s/\t/ /g; + + $StyleVal = $options{style}; + + # Mininal cleanup for safety + $StyleVal =~ s/["']//g; # Drop quotes + if ( $StyleVal eq $options{style} ) { + # no quotes, so now drop other characters we consider invalid + # ONLY A-Za-z-_ #:; are currently allowed. + $StyleVal =~ s/[^\w\-\_ #:;]//g; + } + + if ( $StyleVal ne $options{style} ) { + # Did not seem safe + $StyleVal = ""; + WARN_MESSAGE("processDivSpanOptions received some characters in the STYLE string which are are not permitted by PG. As a result the entire STYLE string was dropped"); + } + } + + # Construct the desired HTML attributes + my $html_attribs = ""; + $html_attribs .= "lang=\"$LangVal\" " if ( $LangVal ne "" ); + $html_attribs .= "dir=\"$DirVal\" " if ( $DirVal ne "" ); + $html_attribs .= "class=\"$ClassVal\" " if ( $ClassVal ne "" ); + $html_attribs .= "style=\"$StyleVal\" " if ( $StyleVal ne "" ); + return( $html_attribs ); +} + +sub openDivSpan { + my $type = shift; # "Span" or "Div"; + if ( $type eq "Span" || $type eq "Div" ) { + # OK + } else { + WARN_MESSAGE("openDivSpan called with an invalid first argument. The entire call was discarded."); + return(); + } + my $option_ref = {}; + my $html_attribs; + if ( ref($_[0]) eq 'HASH' ) { + $option_ref = shift ; + $html_attribs = processDivSpanOptions( $option_ref ); + } + + my $tex_code = shift; # TeX code to be used for this - currently needs to be set by hand + my $ptx_code = shift; # preTeXt code to be used for this - currently needs to be set by hand + + # Fall back to empty TeX / preTeXt code if none was provided. + $tex_code = defined($tex_code)?$tex_code:""; + $ptx_code = defined($ptx_code)?$ptx_code:""; + + # Make a call to track this as opening a "object" which needs to be closed + # ON HOLD - as the internal balancing support is still work in progress + # internalBalancingIncrement("open${type}"); + + MODES( + TeX => "$tex_code", + Latex2HTML => qq!\\begin{rawhtml}<$type $html_attribs>\\end{rawhtml}!, + HTML => qq!<$type $html_attribs>\n! , + PTX => "$ptx_code", + ); +} + +sub closeDivSpan { + my $type = shift; # "Span" or "Div"; + if ( $type eq "Span" || $type eq "Div" ) { + # OK + } else { + WARN_MESSAGE("closeDivSpan called with an invalid first argument. The entire call was discarded."); + return(); + } + + my $tex_code = shift; # TeX code to be used for this - currently needs to be set by hand + my $ptx_code = shift; # preTeXt code to be used for this - currently needs to be set by hand + + # Fall back to empty TeX / preTeXt code if none was provided. + $tex_code = defined($tex_code)?$tex_code:""; + $ptx_code = defined($ptx_code)?$ptx_code:""; + + # Make a call to track this as closing a tracked "object" which was reported as opened + # ON HOLD - as the internal balancing support is still work in progress + # internalBalancingDecrement("open${type}"); + + MODES( + TeX => "$tex_code", + Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, + HTML => qq!\n! , + PTX => "$ptx_code", + ); +} + +sub openSpan { + openDivSpan( ( "Span", @_ ) ); +} + +sub openDiv { + openDivSpan( ( "Div", @_ ) ); +} + +sub closeSpan { + closeDivSpan( ( "Span", @_ ) ); +} + +sub closeDiv { + closeDivSpan( ( "Div", @_ ) ); +} + ############################################################### ## Evaluation macros @@ -1720,7 +1977,7 @@ =head3 EV3 constructions, in that order: -=head3 refreshEquations +=head3 refreshEquations refreshEquations(1); @@ -1739,7 +1996,7 @@ sub refreshEquations{ =head3 addToTeXPreamble addToTeXPreamble("\newcommand{\myVec}[1]{\vec{#1}} "); - + Defines C<\myVec > for all the equations in the file. You can change the vector notation for an entire PG question by changing just this line. @@ -1748,13 +2005,13 @@ =head3 addToTeXPreamble In .pg files use single backslashes. This is in accordance with the usual rules for backslash in PG. -For the moment this change only works in image mode. It does not work in +For the moment this change only works in image mode. It does not work in jsMath or MathJax mode. Stay tuned. Adding this command \newcommand{\myVec}[1]{\vec{#1}} - + to TeX(hardcopy) portion of the setHeaderCombinedFile.pg ( or to the setHeaderHardcopyFile.pg for each homework set will take care of the TeX hardcopy version @@ -1764,18 +2021,18 @@ =head3 addToTeXPreamble There are ways you can use course.conf to allow course by course modification by choosing different TeXPreamble files for different courses -=cut +=cut sub addToTeXPreamble { my $str = shift; if ($displayMode eq "HTML_dpng") { $envir->{imagegen}->addToTeXPreamble($str."\n" ) ; } elsif ($displayMode eq "TeX" and $envir->{probNum}==0) { - - # in TeX mode we are typically creating an entire homework set - # and typesetting that so w only want the TeXPreamble to + + # in TeX mode we are typically creating an entire homework set + # and typesetting that so w only want the TeXPreamble to # appear once -- towards the beginning. - # This is potentially fragile -- if one starts + # This is potentially fragile -- if one starts # typesetting problems separately this will fail. # The reason for the multicols commands is baroque # If they are not there then the newcommand gets printed @@ -1784,9 +2041,9 @@ sub addToTeXPreamble { # when printing hardcopy. --it's weird and there must be a better way. TEXT("\\ifdefined\\nocolumns\\else \\end{multicols} \\fi\n", $str, "\n","\\ifdefined\\nocolumns\\else \\begin{multicols}{2}\\columnwidth=\\linewidth \\fi\n"); } else { # for jsMath and MathJax mode - my $mathstr = "\\(".$str."\\)"; #add math mode. - $mathstr =~ s/\\/\\\\/g; # protect math modes ($str has a true TeX command, - # with single backslashes. The backslashes have not + my $mathstr = "\\(".$str."\\)"; #add math mode. + $mathstr =~ s/\\/\\\\/g; # protect math modes ($str has a true TeX command, + # with single backslashes. The backslashes have not # been protected by the .pg problem preprocessor TEXT(EV3($mathstr)); } @@ -1834,11 +2091,11 @@ =head3 FEQ Two additional legacy formatting constructions are also supported: C will give a number with 3 decimal places and a negative -sign if the number is negative, no sign if the number is positive. Since this is -identical to the behavior of C<{$c:%0.3f}> the use of this syntax is depricated. +sign if the number is negative, no sign if the number is positive. Since this is +identical to the behavior of C<{$c:%0.3f}> the use of this syntax is depricated. C determines the sign and prints it -whether the number is positive or negative. You can use this +whether the number is positive or negative. You can use this to force an expression such as C<+5.456>. =head3 EV2 @@ -1865,41 +2122,34 @@ =head3 EV2 sub ev_substring { - my $string = shift; + my $string = shift; my $start_delim = shift; my $end_delim = shift; my $actionRef = shift; my ($eval_out,$PG_eval_errors,$PG_full_error_report)=(); - my $out = ""; - # - # DPVC -- 2001/12/07 - # original "while ($string)" fails to process the string "0" correctly - # - while ($string ne "") { - # - # end DPVC - # - if ($string =~ /\Q$start_delim\E/s) { - #print "$start_delim $end_delim evaluating_substring=$string
"; - $string =~ s/^(.*?)\Q$start_delim\E//s; # get string up to next \{ ---treats string as a single line, ignoring returns - $out .= $1; - #print "$start_delim $end_delim substring_out=$out
"; - $string =~ s/^(.*?)\Q$end_delim\E//s; # get perl code up to \} ---treats string as a single line, ignoring returns - #print "$start_delim $end_delim evaluate_string=$1
"; - ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); - $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; - $out = $out . $eval_out; - #print "$start_delim $end_delim new substring_out=$out


"; - $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR

  $@ 
$PAR" if $@; - } - else { - $out .= $string; # flush the last part of the string - last; - } + my $out = ""; + while ($string ne "") { # DPVC -- 2001/12/07 - original "while ($string)" fails to process the string "0" correctly + if ($string =~ /\Q$start_delim\E/s) { + #print "$start_delim $end_delim evaluating_substring=$string
"; + $string =~ s/^(.*?)\Q$start_delim\E//s; # get string up to next \{ ---treats string as a single line, ignoring returns + $out .= $1; + #print "$start_delim $end_delim substring_out=$out
"; + $string =~ s/^(.*?)\Q$end_delim\E//s; # get perl code up to \} ---treats string as a single line, ignoring returns + #print "$start_delim $end_delim evaluate_string=$1
"; + ($eval_out,$PG_eval_errors,$PG_full_error_report) = &$actionRef($1); + $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; + $out = $out . $eval_out; + #print "$start_delim $end_delim new substring_out=$out


"; + $out .="$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR

  $@ 
$PAR" if $@; + } else { + $out .= $string; # flush the last part of the string + last; + } - } + } $out; } + sub safe_ev { my ($out,$PG_eval_errors,$PG_full_error_report) = &old_safe_ev; # process input by old_safe_ev first $out = "" unless defined($out) and $out =~/\S/; @@ -1909,11 +2159,11 @@ sub ev_substring { sub old_safe_ev { my $in = shift; - my ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;"); - # the addition of the ; seems to provide better error reporting - if ($PG_eval_errors) { - my @errorLines = split("\n",$PG_eval_errors); - #$out = "
$PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $BR % Code evaluated:$BR $in $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR 
"; + my ($out,$PG_eval_errors,$PG_full_error_report) = PG_restricted_eval("$in;"); + # the addition of the ; seems to provide better error reporting + if ($PG_eval_errors) { + my @errorLines = split("\n",$PG_eval_errors); + #$out = "
$PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $BR % Code evaluated:$BR $in $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR 
"; warn " ERROR in old_safe_ev, PGbasicmacros.pl:
      ## There is an error occuring inside evaluation brackets \\{ ...code... \\}
      ## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
@@ -1932,7 +2182,7 @@ sub ev_substring {
 
 sub FEQ   {    # Format EQuations
 	my $in = shift;
-	 # formatting numbers -- the ?{} and !{} constructions
+	# formatting numbers -- the ?{} and !{} constructions
 	$in =~s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1,$2) )}/g;
 	$in =~s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1,$2) )}/g;
 
@@ -1993,28 +2243,28 @@ sub general_math_ev3 {
 	} elsif ($displayMode eq "HTML_img") {
 		$out = math2img($in, $mode);
 	} elsif ($displayMode eq "HTML_jsMath") {
-	  $in =~ s/&/&/g; $in =~ s//>/g;
-	  $out = ''.$in.'' if $mode eq "inline";
-	  $out = '
'.$in.'
' if $mode eq "display"; + $in =~ s/&/&/g; $in =~ s//>/g; + $out = ''.$in.'' if $mode eq "inline"; + $out = '
'.$in.'
' if $mode eq "display"; } elsif ($displayMode eq "HTML_asciimath") { - $in = HTML::Entities::encode_entities($in); - $out = "`$in`" if $mode eq "inline"; - $out = '
`'.$in.'`
' if $mode eq "display"; + $in = HTML::Entities::encode_entities($in); + $out = "`$in`" if $mode eq "inline"; + $out = '
`'.$in.'`
' if $mode eq "display"; } elsif ($displayMode eq "PTX") { - #protect XML control characters - $in =~ s/\&(?!([\w#]+;))/\\amp /g; - $in =~ s/'."$in".'' if $mode eq "inline"; + #protect XML control characters + $in =~ s/\&(?!([\w#]+;))/\\amp /g; + $in =~ s/'."$in".'' if $mode eq "inline"; $out = ''."$in".'' if $mode eq "display"; } elsif ($displayMode eq "HTML_LaTeXMathML") { - $in = HTML::Entities::encode_entities($in); - $in = '{'.$in.'}'; - $in =~ s/\{\s*(\\(display|text|script|scriptscript)style)/$1\{/g; - $out = '$$'.$in.'$$' if $mode eq "inline"; - $out = '
$$\displaystyle{'.$in.'}$$
' if $mode eq "display"; + $in = HTML::Entities::encode_entities($in); + $in = '{'.$in.'}'; + $in =~ s/\{\s*(\\(display|text|script|scriptscript)style)/$1\{/g; + $out = '$$'.$in.'$$' if $mode eq "inline"; + $out = '
$$\displaystyle{'.$in.'}$$
' if $mode eq "display"; } elsif ($displayMode eq "HTML") { - $in_delim = HTML::Entities::encode_entities($in_delim); - $out = "$in_delim"; + $in_delim = HTML::Entities::encode_entities($in_delim); + $out = "$in_delim"; } else { $out = $in_delim; } @@ -2043,9 +2293,9 @@ sub EV3{ # interpolate variables my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("</>/g; - $evaluated_string = "
$PAR % ERROR in $0:EV3, PGbasicmacros.pl: $PAR % There is an error occuring in the following code:$BR $string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR 
"; + my @errorLines = split("\n",$PG_eval_errors); + $string =~ s//>/g; + $evaluated_string = "
$PAR % ERROR in $0:EV3, PGbasicmacros.pl: $PAR % There is an error occuring in the following code:$BR $string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR 
"; $@=""; } $string = $evaluated_string; @@ -2070,7 +2320,7 @@ sub EV4{ $string = $envir{'imagegen'}->add($string); $string; } else { - EV3(@_); + EV3(@_); } } @@ -2132,7 +2382,7 @@ sub EV3P { if ($options{processVariables}) { my $eval_string = $string; $eval_string =~ s/\$(?![a-z\{])/\${DOLLAR}/gi if $options{fixDollars}; - my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = + my ($evaluated_string,$PG_eval_errors,$PG_full_errors) = PG_restricted_eval("< - $string = "

".$string."

"; + #except not for certain "sub" structures that are also passed through EV3 + $string = "

".$string."

" unless (($string =~ /^]*\/>$/) or ($string =~ /^$/s)); #a may have been created within a of a as a container of an #so here we clean that up @@ -2206,7 +2457,7 @@ sub PTX_cleanup { #insert opening and closing p, to be removed later if they enclose an image, video or tabular $string =~ s/(]*(?)/$1\n

/g; $string =~ s/(<\/sidebyside>)/<\/p>\n$1/g; - #ditto for li + #ditto for li, since we are not going to look to see if there is a nested list in there $string =~ s/(]*(?)/$1\n

/g; $string =~ s/(<\/li>)/<\/p>\n$1/g; @@ -2233,6 +2484,13 @@ sub PTX_cleanup { #remove whitespace preceding

$string =~ s/(?s)\s*(<\/p>)/$1/g; + #move PTX warnings from the beginning of inside a p to just before the p. + $string =~ s/

()/$1\n

/g; + + #remove doulbe p's we may have created + $string =~ s/

/

/g; + $string =~ s/<\/p><\/p>/<\/p>/g; + #remove empty p $string =~ s/(\r\n?|\n)?

<\/p>//g; @@ -2248,24 +2506,6 @@ sub PTX_cleanup { $string; } -sub PTX_special_character_cleanup { - my $string = shift; - $string =~ s//g; - $string =~ s/(?//g; - $string =~ s/&//g; - $string =~ s/"/"/g; - $string =~ s/\^//g; - $string =~ s/#//g; - $string =~ s/\$//g; - $string =~ s/\%//g; - $string =~ s/\\//g; - $string =~ s/_//g; - $string =~ s/{//g; - $string =~ s/}//g; - $string =~ s/~//g; - $string; -} - =head2 Formatting macros @@ -2283,9 +2523,9 @@ =head2 Formatting macros # as the problem file knowlLink($display_text, url => '', value = <'', width=>'', id=>'', name=>'' ) # insert the web page referenced by $url in a space defined by height and width # if the webpage contains a form then this must be inserted between - # BEGIN_POST_HEADER_TEXT/END_POST_HEADER_TEXT to avoid having one + # BEGIN_POST_HEADER_TEXT/END_POST_HEADER_TEXT to avoid having one # form(from the webpage) inside another (the defining form for the problem A wide variety of google widgets, youtube videos, and other online resources can be imbedded using this macro. In HTML mode it creates an iframe, in TeX mode it prints the url. - appletLink( { name => "xFunctions", + appletLink( { name => "xFunctions", codebase => '', # use this to specify the complete url # otherwise libraries specified in global.conf are searched archive => 'xFunctions.zip', # name the archive containing code (.jar files go here also) - code => 'xFunctionsLauncher.class', + code => 'xFunctionsLauncher.class', width => 100, height => 14, params => { param1 =>value1, param2 => value2}, @@ -2314,23 +2554,23 @@ =head2 Formatting macros The parameter localHelpURL must be defined in the environment and is set by default to webwork2/htdocs/helpFiles Standard helpFile types - 'angle' - 'decimal' - 'equation' - 'exponent' - 'formula' - 'fraction' + 'angle' + 'decimal' + 'equation' + 'exponent' + 'formula' + 'fraction' 'inequalit' - 'limit' - 'log' - 'number' - 'point' - 'vector' - 'interval' + 'limit' + 'log' + 'number' + 'point' + 'vector' + 'interval' 'unit' - 'syntax' + 'syntax' + - ######################## deprecated coding method appletLink ($url, $parameters) @@ -2370,7 +2610,7 @@ sub beginproblem { my $effectivePermissionLevel = $envir->{effectivePermissionLevel}; # permission level of user assigned to question my $PRINT_FILE_NAMES_PERMISSION_LEVEL = $envir->{'PRINT_FILE_NAMES_PERMISSION_LEVEL'}; my $studentLogin = $envir->{studentLogin}; - my $print_path_name_flag = + my $print_path_name_flag = (defined($effectivePermissionLevel) && defined($PRINT_FILE_NAMES_PERMISSION_LEVEL) && $effectivePermissionLevel >= $PRINT_FILE_NAMES_PERMISSION_LEVEL) || ( defined($inlist{ $studentLogin }) and ( $inlist{ $studentLogin }>0 ) )?1:0 ; $out .= MODES( TeX => @@ -2379,13 +2619,13 @@ sub beginproblem { if ( $print_path_name_flag ) { $out .= &M3("{\\bf ${probNum}. {\\footnotesize ($problemValue $points) \\path|$fileName|}}\\newline ", " \\begin{rawhtml} ($problemValue $points) $l2hFileName
\\end{rawhtml}", - "($problemValue $points) $fileName
" - ) if ($problemValue >=0 and ($envir->{setNumber})=~/\S/ and ($envir->{setNumber}) ne 'Undefined_Set' and ($envir->{setNumber}) ne 'not defined'); + "($problemValue $points) $fileName
" + ) if ($problemValue >=0 and ($envir->{setNumber})=~/\S/ and ($envir->{setNumber}) ne 'Undefined_Set' and ($envir->{setNumber}) ne 'not defined'); } else { $out .= &M3("{\\bf ${probNum}.} ($problemValue $points) ", "($problemValue $points) ", - "($problemValue $points) " - ) if ($problemValue >= 0 and ($envir->{setNumber})=~/\S/ and ($envir->{setNumber}) ne 'Undefined_Set' and ($envir->{setNumber}) ne 'not defined'); + "($problemValue $points) " + ) if ($problemValue >= 0 and ($envir->{setNumber})=~/\S/ and ($envir->{setNumber}) ne 'Undefined_Set' and ($envir->{setNumber}) ne 'not defined'); } $out .= MODES(%{main::PG_restricted_eval(q!$main::problemPreamble!)}); $out .= MODES( TeX => @@ -2407,7 +2647,7 @@ sub nicestring { } else { my($j); for $j (1..($n-2)) { - $others[$j-1] = "x^".($n-$j); + $others[$j-1] = "x^".($n-$j); } if($n>=2) { $others[$n-2] = "x";} $others[$n-1] = ""; @@ -2422,13 +2662,13 @@ sub nicestring { $k++; for $j ($k..($n-1)) { if($coefs[$j] != 0) { - if($coefs[$j] == 1) { - $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1"; - } elsif($coefs[$j] == -1) { - $ans .= ($others[$j]) ? "- $others[$j]" : "-1"; - } else { - $ans .= "+ $coefs[$j] $others[$j]"; - } + if($coefs[$j] == 1) { + $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1"; + } elsif ($coefs[$j] == -1) { + $ans .= ($others[$j]) ? "- $others[$j]" : "-1"; + } else { + $ans .= "+ $coefs[$j] $others[$j]"; + } } } return($ans); @@ -2459,7 +2699,7 @@ sub OL { #"

    \n" HTML=> "
    \n", PTX=> '
      '."\n", - ) ; + ) ; my $elem; foreach $elem (@array) { $letter = shift @alpha; @@ -2500,17 +2740,17 @@ sub htmlLink { # sub knowlLink { # # I'd like to make text shift -- since this is always present # # url might not be used with a here document which would be written as -# # value = "contents of here document" +# # value = "contents of here document" # # suggested usage knowl(text, [url => ..., value => ....]) # # used in helpLink -# my $url = shift; -# my $display_text = shift; -# my $option_string = shift; -# $option_string = "" unless defined($option_string); -# return "$BBOLD\[ broken link: $display_text \] $EBOLD" unless defined($url) or $option_string; -# MODES( TeX => "{\\bf \\underline{$display_text}}", -# HTML => "$display_text" -# ); +# my $url = shift; +# my $display_text = shift; +# my $option_string = shift; +# $option_string = "" unless defined($option_string); +# return "$BBOLD\[ broken link: $display_text \] $EBOLD" unless defined($url) or $option_string; +# MODES( TeX => "{\\bf \\underline{$display_text}}", +# HTML => "$display_text" +# ); # } sub knowlLink { # an new syntax for knowlLink that facilitates a local HERE document @@ -2518,14 +2758,14 @@ sub knowlLink { # an new syntax for knowlLink that facilitates a local HERE docu my $display_text = shift; my @options = @_; # so we can check parity my %options = @options; - WARN_MESSAGE('usage knowlLink($display_text, [url => $url, value => $helpMessage] );'. - qq!after the display_text the information requires key/value pairs. - Received @options !,scalar(@options)%2) if scalar(@options)%2; + WARN_MESSAGE('usage knowlLink($display_text, [url => $url, value => $helpMessage] );'. + qq!after the display_text the information requires key/value pairs. + Received @options !,scalar(@options)%2) if scalar(@options)%2; # check that options has an even number of inputs my $properties = ""; if ($options{value} ) { #internal knowl from HERE document - $options{value} =~ s/"/'/g; # escape quotes #FIXME -- make escape more robust - my $base64 = ($options{base64})?"base64 = \"1\"" :""; + $options{value} =~ s/"/'/g; # escape quotes #FIXME -- make escape more robust + my $base64 = ($options{base64})?"base64 = \"1\"" :""; $properties = qq! href="#" knowl = "" class = "internal" value = "$options{value} " $base64 !; } elsif ($options{url}) { $properties = qq! knowl = "$options{url}"!; @@ -2551,7 +2791,7 @@ sub iframe { TeX => "\\framebox{".protect_underbar($url)."}\n", HTML => qq!\n \n!, + \n!, PTX => '', ); } @@ -2562,7 +2802,7 @@ sub helpLink { my $helpurl = shift; return "" if(not defined($envir{'localHelpURL'})); if (defined $helpurl) { - return knowlLink($display_text, url=>$envir{'localHelpURL'}.$helpurl); + return knowlLink($display_text, url=>$envir{'localHelpURL'}.$helpurl); } my %typeHash = ( 'angle' => 'Entering-Angles.html', @@ -2596,7 +2836,7 @@ sub helpLink { $infoRef = 'Entering-Logarithms10.html' if($refhold eq 'log'); $infoRef = 'Entering-Formulas10.html' if($refhold eq 'formula'); } - + # If infoRef is still '', we give up and just print plain text return $display_text unless ($infoRef); return knowlLink($display_text, url=>$envir{'localHelpURL'}.$infoRef); @@ -2610,54 +2850,53 @@ sub appletLink { return oldAppletLink(@_) unless ref($url) ; # handle legacy where applet link completely defined # search for applet # get fileName of applet - my $applet = shift; - my $options = shift; - my $archive = $applet ->{archive}; - my $codebase = $applet ->{codebase}; - my $code = $applet ->{code}; - my $appletHeader = ''; - # find location of applet + my $applet = shift; + my $options = shift; + my $archive = $applet ->{archive}; + my $codebase = $applet ->{codebase}; + my $code = $applet ->{code}; + my $appletHeader = ''; + # find location of applet if (defined($codebase) and $codebase =~/\S/) { - # do nothing + # do nothing } elsif(defined($archive) and $archive =~/\S/) { - $codebase = findAppletCodebase($archive ) + $codebase = findAppletCodebase($archive ) } elsif (defined($code) and $code =~/\S/) { - $codebase = findAppletCodebase($code ) + $codebase = findAppletCodebase($code ) } else { - warn "Must define the achive (.jar file) or code (.class file) where the applet code is to be found"; - return; + warn "Must define the achive (.jar file) or code (.class file) where the applet code is to be found"; + return; } - - if ( $codebase =~/^Error/) { - warn $codebase; - return; - } else { - # we are set to include the applet - } - $appletHeader = qq! archive = "$archive " codebase = "$codebase" !; - foreach my $key ('name', 'code','width','height', ) { - if ( defined($applet->{$key}) ) { - $appletHeader .= qq! $key = "!.$applet->{$key}.q!" ! ; - } else { - warn " $key is not defined for applet ".$applet->{name}; - # technically name is not required, but all of the other parameters are - } - } - # add parameters to options - if (defined($applet->{params}) ) { - foreach my $key (keys %{ $applet->{params} }) { - my $value = $applet->{params}->{$key}; - $options .= qq{\n}; - } - - - } - MODES( TeX => "{\\bf \\underline{APPLET} }".$applet->{name}, - Latex2HTML => "\\begin{rawhtml} $options \\end{rawhtml}", - HTML => " \n $options \n ", - #HTML => qq! $options ! + + if ( $codebase =~/^Error/) { + warn $codebase; + return; + } else { + # we are set to include the applet + } + $appletHeader = qq! archive = "$archive " codebase = "$codebase" !; + foreach my $key ('name', 'code','width','height', ) { + if ( defined($applet->{$key}) ) { + $appletHeader .= qq! $key = "!.$applet->{$key}.q!" ! ; + } else { + warn " $key is not defined for applet ".$applet->{name}; + # technically name is not required, but all of the other parameters are + } + } + # add parameters to options + if (defined($applet->{params}) ) { + foreach my $key (keys %{ $applet->{params} }) { + my $value = $applet->{params}->{$key}; + $options .= qq{\n}; + } + + } + MODES( TeX => "{\\bf \\underline{APPLET} }".$applet->{name}, + Latex2HTML => "\\begin{rawhtml} $options \\end{rawhtml}", + HTML => " \n $options \n ", + #HTML => qq! $options ! PTX => 'PreTeXt does not support appletLink', - ); + ); } sub oldAppletLink { @@ -2667,8 +2906,8 @@ sub oldAppletLink { MODES( TeX => "{\\bf \\underline{APPLET} }", Latex2HTML => "\\begin{rawhtml} $options \\end{rawhtml}", HTML => " $options ", - PTX => 'PreTeXt does not support appletLink', - ); + PTX => 'PreTeXt does not support appletLink', + ); } sub spf { my($number,$format) = @_; # attention, the order of format and number are reversed @@ -2702,7 +2941,7 @@ =head2 Sorting and other list macros my (@in) =@_; my %temp = (); while (@in) { - $temp{shift(@in)}++; + $temp{shift(@in)}++; } my @out = keys %temp; # sort is causing trouble with Safe.?? @out; @@ -2757,13 +2996,13 @@ sub begintable { $out .= "\n\\begin{rawhtml} \n\\end{rawhtml}"; } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') { + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') { $out .= "
      \n" } else { @@ -2784,13 +3023,13 @@ sub endtable { $out .= "\n\\begin{rawhtml}
      \n\\end{rawhtml}"; } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') { + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') { $out .= "\n"; } else { @@ -2807,10 +3046,10 @@ sub row { while (@elements) { $out .= shift(@elements) . " &"; } - chop($out); # remove last & - $out .= "\\\\ \\hline \n"; - # carriage returns must be added manually for tex - } + chop($out); # remove last & + $out .= "\\\\ \\hline \n"; + # carriage returns must be added manually for tex + } elsif ($displayMode eq 'PTX') { $out .= ''."\n"; while (@elements) { @@ -2826,13 +3065,13 @@ sub row { $out .= " \n\\begin{rawhtml}\n \n\\end{rawhtml}\n"; } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') { + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') { $out .= "\n"; while (@elements) { $out .= "" . shift(@elements) . ""; @@ -2893,17 +3132,17 @@ sub image { my $height_attrib = ''; $height_attrib = qq{height = "$height"} if ($height); - if (ref($image_ref) =~ /ARRAY/ ) { + if (ref($image_ref) =~ /ARRAY/ ) { @image_list = @{$image_ref}; - } else { + } else { push(@image_list,$image_ref); - } + } - my @output_list = (); - while(@image_list) { - my $imageURL = alias(shift @image_list)//''; - $imageURL = ($envir{use_site_prefix})? $envir{use_site_prefix}.$imageURL : $imageURL; - my $out=""; + my @output_list = (); + while(@image_list) { + my $imageURL = alias(shift @image_list)//''; + $imageURL = ($envir{use_site_prefix})? $envir{use_site_prefix}.$imageURL : $imageURL; + my $out=""; if ($displayMode eq 'TeX') { my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL @@ -2927,32 +3166,32 @@ sub image { my $wid = ($envir->{onTheFlyImageSize} || 0)+ 30; $out = qq!\\begin{rawhtml}\n\n \\end{rawhtml}\n ! - } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') { + } elsif ($displayMode eq 'HTML_MathJax' + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') { my $wid = ($envir->{onTheFlyImageSize} || 0) +30; - $out = qq! - - - ! + $out = qq! + + + ! } elsif ($displayMode eq 'PTX') { my $ptxwidth = 100*$width/600; $out = qq!\n\n<\/sidebyside>! } else { - $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n"; - } - push(@output_list, $out); - } + $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n"; + } + push(@output_list, $out); + } return wantarray ? @output_list : $output_list[0]; } -#This is bare bones code for embedding svg +#This is bare bones code for embedding svg sub embedSVG { my $file_name = shift; # just input the file name of the svg image my $backup_file_name = shift//''; # a png version @@ -2961,10 +3200,10 @@ sub embedSVG { $str = q!" oneerror="this.src='! . alias($backup_file_name). q!'!; } return MODES( HTML => q! - !, + !, TeX => "Can't process svg in tex mode yet \\includegraphics[width=6in]{" . alias( $file_name ) . "}", PTX => '', - ); + ); } # This is bare bones code for embedding png files -- what else should be added? (there are .js scripts for example) @@ -2972,13 +3211,13 @@ sub embedPDF { my $file_name = shift; # just input the file name of the svg image #my $backup_file_name = shift//''; # a png version return MODES( HTML => q! - !, + !, TeX => "\\includegraphics[width=6in]{" . alias( $file_name ) . "}", PTX => '', - ) ; + ) ; } sub video { @@ -3008,54 +3247,54 @@ sub video { my @video_list = (); - if (ref($video_ref) =~ /ARRAY/ ) { + if (ref($video_ref) =~ /ARRAY/ ) { @video_list = @{$video_ref}; - } else { + } else { push(@video_list,$video_ref); - } + } - my @output_list = (); - while(@video_list) { + my @output_list = (); + while(@video_list) { - my $video = shift @video_list //''; - my $videoURL = alias($video)//''; - $video =~ /.*\.(\w*)/; - my $type = $1; + my $video = shift @video_list //''; + my $videoURL = alias($video)//''; + $video =~ /.*\.(\w*)/; + my $type = $1; my $out; - my $htmlmessage = maketext("Your browser does not support the video tag."); - + my $htmlmessage = maketext("Your browser does not support the video tag."); + if ($displayMode eq 'TeX') { - $videoURL = ($envir{use_site_prefix})? $envir{use_site_prefix}.$videoURL : $videoURL; - $out="\\begin{center} {\\bf ".maketext("This problem contains a video which must be viewed online.")."} \\end{center}"; + $videoURL = ($envir{use_site_prefix})? $envir{use_site_prefix}.$videoURL : $videoURL; + $out="\\begin{center} {\\bf ".maketext("This problem contains a video which must be viewed online.")."} \\end{center}"; } elsif ($displayMode eq 'Latex2HTML') { - $out = qq!\\begin{rawhtml}