Menu
▾
▴
openwebwork-cvs — WeBWorK CVS activity
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(58) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(53) |
Feb
(56) |
Mar
|
Apr
|
May
(30) |
Jun
(78) |
Jul
(121) |
Aug
(155) |
Sep
(77) |
Oct
(61) |
Nov
(45) |
Dec
(94) |
| 2006 |
Jan
(116) |
Feb
(33) |
Mar
(11) |
Apr
(23) |
May
(60) |
Jun
(89) |
Jul
(130) |
Aug
(109) |
Sep
(124) |
Oct
(63) |
Nov
(82) |
Dec
(45) |
| 2007 |
Jan
(31) |
Feb
(35) |
Mar
(123) |
Apr
(36) |
May
(18) |
Jun
(134) |
Jul
(133) |
Aug
(241) |
Sep
(126) |
Oct
(31) |
Nov
(15) |
Dec
(5) |
| 2008 |
Jan
(11) |
Feb
(6) |
Mar
(16) |
Apr
(29) |
May
(43) |
Jun
(149) |
Jul
(27) |
Aug
(29) |
Sep
(37) |
Oct
(20) |
Nov
(4) |
Dec
(6) |
| 2009 |
Jan
(34) |
Feb
(30) |
Mar
(16) |
Apr
(6) |
May
(1) |
Jun
(32) |
Jul
(22) |
Aug
(7) |
Sep
(18) |
Oct
(50) |
Nov
(22) |
Dec
(8) |
| 2010 |
Jan
(17) |
Feb
(15) |
Mar
(10) |
Apr
(9) |
May
(67) |
Jun
(30) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 12:02:42
|
Log Message:
-----------
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:
PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash
Modified Files:
--------------
pg/lib/WeBWorK/PG:
Translator.pm
Added Files:
-----------
pg/lib:
PGalias.pm
PGanswergroup.pm
PGcore.pm
PGloadfiles.pm
PGresponsegroup.pm
Revision Data
-------------
--- /dev/null
+++ lib/PGcore.pm
@@ -0,0 +1,714 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# $CVSHeader: pg/lib/PGcore.pm,v 1.1 2010/05/14 11:39:02 gage Exp $
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of either: (a) the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any later
+# version, or (b) the "Artistic License" which comes with this package.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
+# Artistic License for more details.
+################################################################################
+package PGcore;
+
+use strict;
+BEGIN {
+ use Exporter;
+ our @EXPORT_OK = qw( not_null);
+}
+our $internal_debug_messages = [];
+
+use PGanswergroup;
+use PGresponsegroup;
+use PGrandom;
+use PGalias;
+use PGloadfiles;
+use WeBWorK::PG::IO;
+use Tie::IxHash;
+
+##################################
+# Utility macro
+##################################
+
+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;
+ }
+}
+
+##################################
+# PGcore object
+##################################
+
+sub new {
+ my $class = shift;
+ my $envir = shift; #pointer to environment hash
+ warn "PGcore must be called with an environment" unless ref($envir) eq 'HASH';
+ #warn "creating a new PGcore object";
+ my %options = @_;
+ my $self = {
+ OUTPUT_ARRAY => [], # holds output body text
+ HEADER_ARRAY => [], # holds output for the header text
+# PG_ANSWERS => [], # holds answers with labels
+# PG_UNLABELED_ANSWERS => [], # holds
+ PG_ANSWERS_HASH => {}, # holds label=>answer pairs
+ PERSISTENCE_HASH => {}, # holds other data, besides answers, which persists during a session and beyond
+# PG_persistence_hash => {}, # stores information (other than answers) from one session to another
+ answer_eval_count => 0,
+ answer_blank_count => 0,
+ unlabeled_answer_blank_count =>0,
+ unlabeled_answer_eval_count => 0,
+ KEPT_EXTRA_ANSWERS => [],
+ ANSWER_PREFIX => 'AnSwEr',
+ ARRAY_PREFIX => 'ArRaY',
+ vec_num => 0, # for distinguishing matrices
+ QUIZ_PREFIX => '',
+ SECTION_PREFIX => '', # might be used for sequential (compound) questions?
+
+ PG_ACTIVE => 1, # turn to zero to stop processing
+ submittedAnswers => 0, # have any answers been submitted? is this the first time this session?
+ PG_session_persistence_hash =>{}, # stores data from one invoction of the session to the next.
+ PG_original_problem_seed => 0,
+ PG_random_generator => undef,
+ PG_alias => undef,
+ PG_problem_grader => undef,
+ displayMode => undef,
+ envir => $envir,
+ gifs_created => {},
+ external_refs => {}, # record of external references
+ %options, # allows overrides and initialization
+ };
+ bless $self, $class;
+ tie %{$self->{PG_ANSWERS_HASH}}, "Tie::IxHash"; # creates a Hash with order
+ $self->initialize;
+ return $self;
+}
+
+sub initialize {
+ my $self = shift;
+ warn "environment is not defined in PGcore" unless ref($self->{envir}) eq 'HASH';
+
+
+
+
+ $self->{displayMode} = $self->{envir}->{displayMode};
+ $self->{PG_original_problem_seed} = $self->{envir}->{problemSeed};
+ $self->{PG_random_generator} = new PGrandom( $self->{PG_original_problem_seed});
+
+ $self->{tempDirectory} = $self->{envir}->{tempDirectory};
+ $self->{PG_problem_grader} = $self->{envir}->{PROBLEM_GRADER_TO_USE};
+ $self->{PG_alias} = new PGalias($self->{envir});
+ $self->{PG_loadMacros} = new PGloadfiles($self->{envir});
+ $self->{PG_FLAGS} = {
+ showpartialCorrectAnswers => 1,
+ showHint => 1,
+ hintExists => 0,
+ showHintLimit => 0,
+ solutionExists => 0,
+ WARNING_messages => [],
+ DEBUG_messages => [],
+ recordSubmittedAnswers => 1,
+ refreshCAchedImages => 0,
+# ANSWER_ENTRY_ORDER => [], # may not be needed if we ue Tie:IxHash
+ comment => '', # implement as array?
+
+
+
+ };
+
+}
+
+
+####################################################################
+
+=head1 DESCRIPTION
+
+This file provides the fundamental macros that define the PG language. It
+maintains a problem's text, header text, and answers:
+
+=over
+
+=item *
+
+Problem text: The text to appear in the body of the problem. See TEXT()
+below.
+
+=item *
+
+Header text: When a problem is processed in an HTML-based display mode,
+this variable can contain text that the caller should place in the HEAD of the
+resulting HTML page. See HEADER_TEXT() below.
+
+=item *
+
+Implicitly-labeled answers: Answers that have not been explicitly
+assigned names, and are associated with their answer blanks by the order in
+which they appear in the problem. These types of answers are designated using
+the ANS() macro.
+
+=item *
+
+Explicitly-labeled answers: Answers that have been explicitly assigned
+names with the LABELED_ANS() macro, or a macro that uses it. An explicitly-
+labeled answer is associated with its answer blank by name.
+
+=item *
+
+"Extra" answers: Names of answer blanks that do not have a 1-to-1
+correspondance to an answer evaluator. For example, in matrix problems, there
+will be several input fields that correspond to the same answer evaluator.
+
+=back
+
+=head1 USAGE
+
+This file is automatically loaded into the namespace of every PG problem. The
+macros within can then be called to define the structure of the problem.
+
+DOCUMENT() should be the first executable statement in any problem. It
+initializes vriables and defines the problem environment.
+
+ENDDOCUMENT() must be the last executable statement in any problem. It packs
+up the results of problem processing for delivery back to WeBWorK.
+
+The HEADER_TEXT(), TEXT(), and ANS() macros add to the header text string,
+body text string, and answer evaluator queue, respectively.
+
+=cut
+
+
+=item HEADER_TEXT()
+
+ HEADER_TEXT("string1", "string2", "string3");
+
+HEADER_TEXT() concatenates its arguments and appends them to the stored header
+text string. It can be used more than once in a file.
+
+The macro is used for material which is destined to be placed in the HEAD of
+the page when in HTML mode, such as JavaScript code.
+
+Spaces are placed between the arguments during concatenation, but no spaces are
+introduced between the existing content of the header text string and the new
+content being appended.
+
+=cut
+
+# ^function HEADER_TEXT
+# ^uses $STRINGforHEADER_TEXT
+sub HEADER_TEXT {
+ my $self = shift;
+ push @{$self->{HEADER_ARRAY}}, map { (defined($_) )?$_:'' } @_;
+ $self->{HEADER_ARRAY} ;
+}
+
+=item TEXT()
+
+ TEXT("string1", "string2", "string3");
+
+TEXT() concatenates its arguments and appends them to the stored problem text
+string. It is used to define the text which will appear in the body of the
+problem. It can be used more than once in a file.
+
+This macro has no effect if rendering has been stopped with the STOP_RENDERING()
+macro.
+
+This macro defines text which will appear in the problem. All text must be
+passed to this macro, passed to another macro that calls this macro, or included
+in a BEGIN_TEXT/END_TEXT block, which uses this macro internally. No other
+statements in a PG file will directly appear in the output. Think of this as the
+"print" function for the PG language.
+
+Spaces are placed between the arguments during concatenation, but no spaces are
+introduced between the existing content of the header text string and the new
+content being appended.
+
+=cut
+
+# ^function TEXT
+# ^uses $PG_STOP_FLAG
+# ^uses $STRINGforOUTPUT
+
+sub TEXT {
+ my $self = shift; #FIXME filter for undefined entries replace by "";
+ push @{$self->{OUTPUT_ARRAY}}, map { (defined($_) )?$_:'' } @_ ;
+ $self->{OUTPUT_ARRAY};
+}
+
+
+=item LABELED_ANS()
+
+ TEXT(labeled_ans_rule("name1"), labeled_ans_rule("name2"));
+ LABELED_ANS(name1 => answer_evaluator1, name2 => answer_evaluator2);
+
+Adds the answer evaluators listed to the list of labeled answer evaluators.
+They will be paired with labeled answer rules (a.k.a. answer blanks) in the
+order entered. This allows pairing of answer evaluators and answer rules that
+may not have been entered in the same order.
+
+=cut
+
+# ^function NAMED_ANS
+# ^uses &LABELED_ANS
+sub NAMED_ANS {
+ &LABELED_ANS;
+}
+
+=item NAMED_ANS()
+
+Old name for LABELED_ANS(). DEPRECATED.
+
+=cut
+
+# ^function NAMED_ANS
+# ^uses $PG_STOP_FLAG
+sub LABELED_ANS{
+ my $self = shift;
+ my @in = @_;
+ while (@in ) {
+ my $label = shift @in;
+ $label = join("", $self->{QUIZ_PREFIX}, $self->{SECTION_PREFIX}, $label);
+ my $ans_eval = shift @in;
+ $self->WARN("<BR><B>Error in LABELED_ANS:|$label|</B>
+ -- inputs must be references to AnswerEvaluator objects or subroutines<BR>")
+ unless ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/ ;
+ if (defined($self->{PG_ANSWERS_HASH}->{$label}) ){
+ $self->{PG_ANSWERS_HASH}->{$label}->insert(ans_label => $label, ans_eval => $ans_eval, active=>$self->{PG_ACTIVE});
+ } else {
+ $self->{PG_ANSWERS_HASH}->{$label} = PGanswergroup->new($label, ans_eval => $ans_eval, active=>$self->{PG_ACTIVE});
+ }
+ $self->{answer_eval_count}++;
+ }
+ $self->{PG_ANSWERS_HASH};
+}
+
+
+=item ANS()
+
+ TEXT(ans_rule(), ans_rule(), ans_rule());
+ ANS($answer_evaluator1, $answer_evaluator2, $answer_evaluator3);
+
+Adds the answer evaluators listed to the list of unlabeled answer evaluators.
+They will be paired with unlabeled answer rules (a.k.a. answer blanks) in the
+order entered. This is the standard method for entering answers.
+
+In the above example, answer_evaluator1 will be associated with the first
+answer rule, answer_evaluator2 with the second, and answer_evaluator3 with the
+third. In practice, the arguments to ANS() will usually be calls to an answer
+evaluator generator such as the cmp() method of MathObjects or the num_cmp()
+macro in L<PGanswermacros.pl>.
+
+=cut
+
+# ^function ANS
+# ^uses $PG_STOP_FLAG
+# ^uses @PG_ANSWERS
+
+sub ANS{
+ my $self = shift;
+ my @in = @_;
+ while (@in ) {
+ # create new label
+ $self->{unlabeled_answer_eval_count}++;
+ my $label = $self->new_label($self->{unlabeled_answer_eval_count});
+ my $evaluator = shift @in;
+ $self->LABELED_ANS($label, $evaluator);
+ }
+ $self->{PG_ANSWERS_HASH};
+}
+
+
+
+
+=item STOP_RENDERING()
+
+ STOP_RENDERING() unless all_answers_are_correct();
+
+Temporarily suspends accumulation of problem text and storing of answer blanks
+and answer evaluators until RESUME_RENDERING() is called.
+
+=cut
+
+# ^function STOP_RENDERING
+# ^uses $PG_STOP_FLAG
+sub STOP_RENDERING {
+ my $self = shift;
+ $self->{PG_ACTIVE}=0;
+ "";
+}
+
+=item RESUME_RENDERING()
+
+ RESUME_RENDERING();
+
+Resumes accumulating problem text and storing answer blanks and answer
+evaluators. Reverses the effect of STOP_RENDERING().
+
+=cut
+
+# ^function RESUME_RENDERING
+# ^uses $PG_STOP_FLAG
+sub RESUME_RENDERING {
+ my $self = shift;
+ $self->{PG_ACTIVE}=1;
+ "";
+}
+########
+# Internal methods
+#########
+sub new_label { #creates a new label for unlabeled submissions ASNWER_PREFIX.$number
+ my $self = shift;
+ my $number = shift;
+ $self->{QUIZ_PREFIX}.$self->{ANSWER_PREFIX}.sprintf("%04u", $number);
+}
+sub new_array_label { #creates a new label for unlabeled submissions ASNWER_PREFIX.$number
+ my $self = shift;
+ my $number = shift;
+ $self->{QUIZ_PREFIX}.$self->{ARRAY_PREFIX}.sprintf("%04u", $number);
+}
+sub new_array_element_label { #creates a new label for unlabeled submissions ARRAY_PREFIX.$number
+ my $self = shift;
+ my $ans_label = shift; # name of the PGanswer group holding this array
+ my $row_num = shift;
+ my $col_num = shift;
+ my %options = @_;
+ my $vec_num = (defined $options{vec_num})?$options{vec_num}: 0 ;
+ $self->{QUIZ_PREFIX}.$ans_label.'__'.$vec_num.':'.$row_num.':'.$col_num.'__';
+}
+sub new_answer_name { # bit of a legacy item
+ &new_label;
+}
+
+
+sub record_ans_name { # the labels in the PGanswer group and response group should match in this case
+ my $self = shift;
+ my $label = shift;
+ my $value = shift;
+ $self->internal_debug_message("record_ans_name $label $value");
+ my $response_group = new PGresponsegroup($label,$label,$value);
+ if (defined($self->{PG_ANSWERS_HASH}->{$label}) ) {
+ $self->{PG_ANSWERS_HASH}->{$label}->replace(ans_label => $label,
+ response => $response_group,
+ active => $self->{PG_ACTIVE});
+ } else {
+ $self->{PG_ANSWERS_HASH}->{$label} = PGanswergroup->new($label,
+ response => $response_group,
+ active => $self->{PG_ACTIVE});
+ }
+ $self->{answer_blank_count}++;
+ $label;
+}
+
+sub record_array_name { # currently the same as record ans group
+ my $self = shift;
+ my $label = shift;
+ my $value = shift;
+ my $response_group = new PGresponsegroup($label,$label,$value);
+ if (defined($self->{PG_ANSWERS_HASH}->{$label}) ) {
+ $self->{PG_ANSWERS_HASH}->{$label}->replace(ans_label => $label,
+ response => $response_group,
+ active => $self->{PG_ACTIVE});
+ } else {
+ $self->{PG_ANSWERS_HASH}->{$label} = PGanswergroup->new($label,
+ response => $response_group,
+ active => $self->{PG_ACTIVE});
+ }
+ $self->{answer_blank_count}++;
+ #$self->{PG_ANSWERS_HASH}->{$label}->{response}->clear; #why is this ?
+ $label;
+
+}
+sub extend_ans_group { # modifies the group type
+ my $self = shift;
+ my $label = shift;
+ my @response_list = @_;
+ my $answer_group = $self->{PG_ANSWERS_HASH}->{$label};
+ if (ref($answer_group) =~/PGanswergroup/) {
+ $answer_group->append_responses(@response_list);
+ } else {
+ $self->WARN("The answer |$label| has not yet been defined, you cannot extend it.",caller() );
+
+ }
+ $label;
+}
+sub record_unlabeled_ans_name {
+ my $self = shift;
+ $self->{unlabeled_answer_blank_count}++;
+ my $label = $self->new_label($self->{unlabeled_answer_blank_count});
+ $self->record_ans_name($label);
+ $label;
+}
+sub record_unlabeled_array_name {
+ my $self = shift;
+ $self->{unlabeled_answer_blank_count}++;
+ my $ans_label = $self->new_array_label($self->{unlabeled_answer_blank_count});
+ $self->record_array_name($ans_label);
+}
+sub store_persistent_data { # will store strings only (so far)
+ my $self = shift;
+ my $label = shift;
+ my @content = @_;
+ $self->internal_debug_message("storing $label in PERSISTENCE_HASH");
+ if (defined($self->{PERSISTENCE_HASH}->{$label}) ) {
+ warn "can' overwrite $label in persistent data";
+ } else {
+ $self->{PERSISTENCE_HASH}->{$label} = join("",@content); #need base64 encoding?
+ }
+ $label;
+}
+sub check_answer_hash {
+ my $self = shift;
+ foreach my $key (keys %{ $self->{PG_ANSWERS_HASH} }) {
+ my $ans_eval = $self->{PG_ANSWERS_HASH}->{$key}->{ans_eval};
+ unless (ref($ans_eval) =~ /CODE/ or ref($ans_eval) =~ /AnswerEvaluator/ ) {
+ warn "The answer group labeled $key is missing an answer evaluator";
+ }
+ unless (ref( $self->{PG_ANSWERS_HASH}->{$key}->{response} ) =~ /PGresponsegroup/ ) {
+ warn "The answer group labeled $key is missing answer blanks ";
+ }
+ }
+}
+
+sub PG_restricted_eval {
+ my $self = shift;
+ WeBWorK::PG::Translator::PG_restricted_eval(@_);
+}
+
+# sub AUTOLOAD {
+# my $self = shift;
+#
+# my $type = ref($self) or die "$self is not an object";
+#
+# # $AUTOLOAD is sent in by Perl and is the full name of the object (i.e. main::blah::blah_more)
+# my $name = $PGcore::AUTOLOAD;
+# $name =~ s/.*://; #strips fully-qualified portion
+#
+# unless ( exists $self->{'_permitted'}->{$name} ) { die "Can't find '$name' field in object of class '$type'";}
+#
+# if (@_) {
+# return $self->{$name} = shift; #set the variable to the first parameter
+# } else {
+# return $self->($name); #if no parameters just return the value
+# }
+# }
+
+sub append_debug_message {
+ my $self = shift;
+ my @str = @_;
+ push @{$self->{DEBUG_messages}}, @str;
+}
+sub get_debug_messages {
+ my $self = shift;
+ $self->{DEBUG_messages};
+}
+sub DESTROY {
+ # doing nothing about destruction, hope that isn't dangerous
+}
+
+sub WARN {
+ warn(@_);
+}
+
+
+# This creates on the fly graphs
+
+=head2 insertGraph
+
+ # returns a path to the file containing the graph image.
+ $filePath = insertGraph($graphObject);
+
+insertGraph writes a GIF or PNG image file to the gif subdirectory of the
+current course's HTML temp directory. The file name is obtained from the graph
+object. Warnings are issued if errors occur while writing to the file.
+
+Returns a string containing the full path to the temporary file containing the
+image. This is most often used in the construct
+
+ TEXT(alias(insertGraph($graph)));
+
+where alias converts the directory address to a URL when serving HTML pages and
+insures that an EPS file is generated when creating TeX code for downloading.
+
+=cut
+
+# ^function insertGraph
+# ^uses $WWPlot::use_png
+# ^uses convertPath
+# ^uses surePathToTmpFile
+# ^uses PG_restricted_eval
+# ^uses $refreshCachedImages
+# ^uses $templateDirectory
+# ^uses %envir
+sub insertGraph {
+ # Convert the image to GIF and print it on standard output
+ my $self = shift;
+ my $graph = shift;
+ my $extension = ($WWPlot::use_png) ? '.png' : '.gif';
+ my $fileName = $graph->imageName . $extension;
+ my $filePath = $self->convertPath("gif/$fileName");
+ my $templateDirectory = $self->{envir}->{templateDirectory};
+ $filePath = $self->surePathToTmpFile( $filePath );
+ my $refreshCachedImages = $self->PG_restricted_eval(q!$refreshCachedImages!);
+ # Check to see if we already have this graph, or if we have to make it
+ if( not -e $filePath # does it exist?
+ or ((stat "$templateDirectory"."$main::envir{fileName}")[9] > (stat $filePath)[9]) # source has changed
+ or $graph->imageName =~ /Undefined_Set/ # problems from SetMaker and its ilk should always be redone
+ or $refreshCachedImages
+ ) {
+ #createFile($filePath, $main::tmp_file_permission, $main::numericalGroupID);
+ local(*OUTPUT); # create local file handle so it won't overwrite other open files.
+ open(OUTPUT, ">$filePath")||warn ("$0","Can't open $filePath<BR>","");
+ chmod( 0777, $filePath);
+ print OUTPUT $graph->draw|| warn("$0","Can't print graph to $filePath<BR>","");
+ close(OUTPUT)||warn("$0","Can't close $filePath<BR>","");
+ }
+ $filePath;
+}
+
+=head1 Macros from IO.pm
+
+ includePGtext
+ read_whole_problem_file
+ read_whole_file
+ convertPath
+ getDirDelim
+ fileFromPath
+ directoryFromPath
+ createFile
+ createDirectory
+
+=cut
+
+sub includePGtext {
+ my $self = shift;
+ WeBWorK::PG::IO::includePGtext(@_);
+ };
+sub read_whole_problem_file {
+ my $self = shift;
+ WeBWorK::PG::IO::read_whole_problem_file(@_);
+ };
+sub read_whole_file {
+ my $self = shift;
+ WeBWorK::PG::IO::read_whole_file(@_);
+ };
+sub convertPath {
+ my $self = shift;
+ WeBWorK::PG::IO::convertPath(@_);
+ };
+sub getDirDelim {
+ my $self = shift;
+ WeBWorK::PG::IO::getDirDelim(@_);
+ };
+sub fileFromPath {
+ my $self = shift;
+ WeBWorK::PG::IO::fileFromPath(@_);
+ };
+sub directoryFromPath {
+ my $self = shift;
+ WeBWorK::PG::IO::directoryFromPath(@_);
+ };
+sub createFile {
+ my $self = shift;
+ WeBWorK::PG::IO::createFile(@_);
+ };
+sub createDirectory {
+ my $self = shift;
+ WeBWorK::PG::IO::createDirectory(@_);
+ };
+
+sub tempDirectory {
+ my $self = shift;
+ return $self->{tempDirectory};
+}
+
+
+=head2 surePathToTmpFile
+
+ $path = surePathToTmpFile($path);
+
+Creates all of the intermediate directories between the tempDirectory
+
+If $path begins with the tempDirectory path, then the
+path is treated as absolute. Otherwise, the path is treated as relative the the
+course temp directory.
+
+=cut
+
+# A very useful macro for making sure that all of the directories to a file have been constructed.
+
+# ^function surePathToTmpFile
+# ^uses getCourseTempDirectory
+# ^uses createDirectory
+
+
+sub surePathToTmpFile {
+ # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
+ # the input path must be either the full path, or the path relative to this tmp sub directory
+
+ my $self = shift;
+ my $path = shift;
+ my $delim = "/";
+ my $tmpDirectory = $self->tempDirectory();
+ unless ( -e $tmpDirectory) { # if by some unlucky chance the tmpDirectory hasn't been created, create it.
+ my $parentDirectory = $tmpDirectory;
+ $parentDirectory =~s|/$||; # remove a trailing /
+ $parentDirectory =~s|/\w*$||; # remove last node
+ my ($perms, $groupID) = (stat $parentDirectory)[2,5];
+ createDirectory($tmpDirectory, $perms, $groupID)
+ or warn "Failed to create directory at $path";
+
+ }
+ # use the permissions/group on the temp directory itself as a template
+ my ($perms, $groupID) = (stat $tmpDirectory)[2,5];
+ #warn "&urePathToTmpFile: perms=$perms groupID=$groupID\n";
+
+ # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
+ $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
+ #$path = convertPath($path);
+
+ # find the nodes on the given path
+ my @nodes = split("$delim",$path);
+
+ # create new path
+ $path = $tmpDirectory; #convertPath("$tmpDirectory");
+
+ while (@nodes>1) {
+ $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/");
+ unless (-e $path) {
+ #system("mkdir $path");
+ #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
+ createDirectory($path, $perms, $groupID)
+ or warn "Failed to create directory at $path";
+ }
+
+ }
+
+ $path = $path . shift(@nodes); #convertPath($path . shift(@nodes));
+ #system(qq!echo "" > $path! );
+ return $path;
+}
+
+sub internal_debug_message {
+ my $self = shift;
+ my @str = @_;
+ push @{$internal_debug_messages}, @str;
+}
+sub get_internal_debug_messages {
+ my $self = shift;
+ $internal_debug_messages;
+}
+sub clear_internal_debug_messages {
+ my $self = shift;
+ $internal_debug_messages=[];
+}
+
+1;
\ No newline at end of file
--- /dev/null
+++ lib/PGalias.pm
@@ -0,0 +1,776 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# $CVSHeader: pg/lib/PGalias.pm,v 1.1 2010/05/14 11:39:02 gage Exp $
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of either: (a) the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any later
+# version, or (b) the "Artistic License" which comes with this package.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
+# Artistic License for more details.
+################################################################################
+
+package PGresource;
+use strict;
+use Exporter;
+use PGcore;
+
+sub new {
+ my $class = shift;
+ my $aux_file_name = shift; #pointer to auxiliary fle
+ my $self = {
+ type => 'png', # gif eps pdf html pg (macro: pl) (applets: java js fla geogebra )
+ path => { content => undef,
+ is_complete=>0,
+ is_accessible => 0,
+ },
+ url => { content => undef,
+ is_complete=>0,
+ is_accessible => 0,
+ },
+ return_uri => '',
+ recorded_uri => '',
+ convert => { needed => 0,
+ from_type => undef,
+ from_path => undef,
+ to_type => undef,
+ to_path => undef,
+ },
+ copy_link => { type => undef, # copy or link or ??
+ link_to_path => undef,
+ copy_to_path => undef,
+ },
+ cache_info => {},
+ unique_id => undef,
+ };
+ bless $self, $class;
+ # $self->initialize;
+ # $self->check_parameters;
+ return $self;
+}
+
+package PGalias;
+use strict;
+use Exporter;
+use PGcore;
+use WeBWorK::PG::IO;
+
+our @ISA = ( qw ( PGcore ) ); # look up features in PGcore -- in this case we want the environment.
+
+# new
+# Create one alias object per question (and per PGcore object)
+# Check that information is intact
+# Construct unique id stubs
+# Keep list of external links
+sub new {
+ my $class = shift;
+ my $envir = shift; #pointer to environment hash
+ warn "PGlias must be called with an environment" unless ref($envir) eq 'HASH';
+ my $self = {
+ envir => $envir,
+ searchList => [{url=>'foo',dir=>'.'}], # for subclasses -> list of url/directories to search
+ resourceList => {},
+
+ };
+ bless $self, $class;
+ $self->initialize;
+ $self->check_parameters;
+ return $self;
+}
+
+# methods
+# make_alias -- outputs url and does what needs to be done
+# normalize paths (remove extra precursors to the path)
+# search directories for item
+# make_links -- in those cases where links need to be made
+# create_files -- e.g. when printing hardcopy
+# dispatcher -- decides what needs to be done based on displayMode and file type
+# alias_for_html
+# alias_for_image_in_html image includes gif, png, jpg, swf, svg, flv?? ogg??
+# alias_for_image_in_tex
+
+
+sub initialize {
+ my $self = shift;
+ my $envir = $self->{envir};
+ # warn "envir-- ", join(" ", %$envir);
+ $self->{fileName} = $envir->{probFileName};
+ $self->{htmlDirectory} = $envir->{htmlDirectory};
+ $self->{htmlURL} = $envir->{htmlURL};
+ $self->{tempDirectory} = $envir->{tempDirectory};
+ $self->{templateDirectory} = $envir->{templateDirectory};
+ $self->{tempURL} = $envir->{tempURL};
+ $self->{studentLogin} = $envir->{studentLogin};
+ $self->{psvnNumber} = $envir->{psvnNumber};
+ $self->{setNumber} = $envir->{setNumber};
+ $self->{probNum} = $envir->{probNum};
+ $self->{displayMode} = $envir->{displayMode};
+ $self->{externalGif2EpsPath} = $envir->{externalGif2EpsPath};
+ $self->{externalPng2EpsPath} = $envir->{externalPng2EpsPath};
+ #
+ # Find auxiliary files even when the main file is in tempates/tmpEdit
+ #
+ $self->{fileName} =~ s!(^|/)tmpEdit/!$1!;
+
+ $self->{ext} = "";
+
+ # create uniqeID stub "gif/uniqIDstub-filePath"
+ $self->{uniqIDstub} = join("-",
+ $self->{studentLogin},
+ $self->{psvnNumber},
+ 'set'.$self->{setNumber},
+ 'prob'.$self->{probNum}
+ );
+
+
+}
+
+sub check_parameters {
+ my $self = shift;
+
+ # problem specific data
+ warn "The path to the current problem file template is not defined." unless $self->{fileName};
+ warn "The current studentLogin is not defined " unless $self->{studentLogin};
+ warn "The current problem set number is not defined" if $self->{setNumber} eq ""; # allow for sets equal to 0
+ warn "The current problem number is not defined" if $self->{probNum} eq "";
+ warn "The current problem set version number (psvn) is not defined" unless defined($self->{psvnNumber});
+ warn "The displayMode is not defined" unless $self->{displayMode};
+
+ # required macros
+# warn "The macro &surePathToTmpFile can't be found" unless defined(&{$self->surePathToTmpFile()} );
+# warn "The macro &convertPath can't be found" unless defined(&{$self->convertPath()});
+# warn "The macro &directoryFromPath can't be found" unless defined(&{$self->directoryFromPath()});
+# warn $self->surePathToTmpFile("foo");
+ # warn "The webwork server does not have permission to execute the gif2eps script at ${externalGif2EpsPath}." unless ( -x "${externalGif2EpsPath}" );
+ # warn "The webwork server does not have permission to execute the png2eps script at ${externalPng2EpsPath}." unless ( -x "${externalPng2EpsPath}" );
+
+ # required directory addresses (and URL address)
+ warn "htmlDirectory is not defined." unless $self->{htmlDirectory};
+ warn "htmlURL is not defined." unless $self->{htmlURL};
+ warn "tempURL is not defined." unless $self->{tempURL};
+}
+
+sub make_alias {
+ my $self = shift;
+ # input is a path to the original auxiliary file
+ my $aux_file_path = shift @_;
+ my $resource_alias = new PGresource($aux_file_path); # just call it alias? FIXME -- not in use yet.
+
+ # warn "make alias for $aux_file_path";
+ warn "Empty string used as input into the function alias" unless $aux_file_path;
+
+ my $displayMode = $self->{displayMode};
+ my $fileName = $self->{fileName}; # name of .pg file
+ my $envir = $self->{envir};
+ my $htmlDirectory = $envir->{htmlDirectory};
+ my $htmlURL = $envir->{htmlURL};
+ my $tempDirectory = $envir->{tempDirectory};
+ my $tempURL = $envir->{tempURL};
+ my $studentLogin = $envir->{studentLogin};
+ my $psvnNumber = $envir->{psvnNumber};
+ my $setNumber = $envir->{setNumber};
+ my $probNum = $envir->{probNum};
+ my $externalGif2EpsPath = $envir->{externalGif2EpsPath};
+ my $externalPng2EpsPath = $envir->{externalPng2EpsPath};
+
+ my $templateDirectory = $self->{templateDirectory};
+
+ # $adr_output is a url in HTML and Latex2HTML modes
+ # and a complete path in TEX mode.
+ my $adr_output;
+ my $ext;
+
+ # determine file type
+ # determine display mode
+ # dispatch
+
+ # determine extension, if there is one
+ # if extension exists, strip and use the value for $ext
+ # files without extensions are considered to be picture files:
+
+
+ if ($aux_file_path =~ s/\.([^\.]*)$// ) {
+ $ext = $1;
+ } else {
+ warn "This file name $aux_file_path did not have an extension.<BR> " .
+ "Every file name used as an argument to alias must have an extension.<BR> " .
+ "The permissable extensions are .gif, .png, and .html .<BR>";
+ $ext = "gif";
+ }
+
+
+ # in order to facilitate maintenance of this macro the routines for handling
+ # different file types are defined separately. This involves some redundancy
+ # in the code but it makes it easier to define special handling for a new file
+ # type, (but harder to change the behavior for all of the file types at once
+ # (sigh) ).
+
+ if ($ext eq 'html') {
+ $adr_output = $self->alias_for_html($aux_file_path)
+ } elsif ($ext eq 'gif') {
+ if ( $displayMode eq 'HTML' ||
+ $displayMode eq 'HTML_tth'||
+ $displayMode eq 'HTML_dpng'||
+ $displayMode eq 'HTML_asciimath'||
+ $displayMode eq 'HTML_LaTeXMathML'||
+ $displayMode eq 'HTML_jsMath'||
+ $displayMode eq 'HTML_img') {
+ ################################################################################
+ # .gif FILES in HTML; HTML_tth; HTML_dpng; HTML_img; and Latex2HTML modes
+ ################################################################################
+ $adr_output=$self->alias_for_gif_in_html_mode($aux_file_path);
+
+ } elsif ($displayMode eq 'TeX') {
+ ################################################################################
+ # .gif FILES in TeX mode
+ ################################################################################
+ $adr_output=$self->alias_for_gif_in_tex_mode($aux_file_path);
+
+ } else {
+ die "Error in alias: dangerousMacros.pl: unrecognizable displayMode = $displayMode";
+ }
+ } elsif ($ext eq 'png') {
+ if ( $displayMode eq 'HTML' ||
+ $displayMode eq 'HTML_tth'||
+ $displayMode eq 'HTML_dpng'||
+ $displayMode eq 'HTML_asciimath'||
+ $displayMode eq 'HTML_LaTeXMathML'||
+ $displayMode eq 'HTML_jsMath'||
+ $displayMode eq 'HTML_img' ) {
+ $adr_output = $self->alias_for_png_in_html_mode($aux_file_path);
+ } elsif ($displayMode eq 'TeX') {
+ $adr_output = $self->alias_for_png_in_tex_mode($aux_file_path);
+
+ } else {
+ warn "Error in alias: dangerousMacros.pl","unrecognizable displayMode = $displayMode","";
+ }
+ } else { # $ext is not recognized
+ ################################################################################
+ # FILES with unrecognized file extensions in any display modes
+ ################################################################################
+
+ warn "Error in the macro alias. Alias does not understand how to process files with extension $ext. (Path ot problem file is $fileName) ";
+ }
+
+ warn "The macro alias was unable to form a URL for some auxiliary file used in this problem." unless $adr_output;
+ return $adr_output;
+}
+
+
+
+sub alias_for_html {
+ my $self = shift;
+ my $aux_file_path = shift;
+ warn "aux_file for html $aux_file_path";
+ my $envir = $self->{envir}; my $fileName = $envir->{fileName};
+ my $htmlDirectory = $envir->{htmlDirectory};
+ my $htmlURL = $envir->{htmlURL};
+ my $tempDirectory = $envir->{tempDirectory};
+ my $tempURL = $envir->{tempURL};
+ my $studentLogin = $envir->{studentLogin};
+ my $psvnNumber = $envir->{psvnNumber};
+ my $setNumber = $envir->{setNumber};
+ my $probNum = $envir->{probNum};
+ my $displayMode = $envir->{displayMode};
+ my $externalGif2EpsPath = $envir->{externalGif2EpsPath};
+ my $externalPng2EpsPath = $envir->{externalPng2EpsPath};
+
+ my $templateDirectory = $self->{templateDirectory};
+
+
+ # $adr_output is a url in HTML and Latex2HTML modes
+ # and a complete path in TEX mode.
+ my $adr_output;
+ my $ext = "html";
+ ################################################################################
+ # .html FILES in HTML, HTML_tth, HTML_dpng, HTML_img, etc. and Latex2HTML mode
+ ################################################################################
+
+ # No changes are made for auxiliary files in the
+ # ${Global::htmlDirectory} subtree.
+ if ( $aux_file_path =~ m|^$tempDirectory| ) {
+ $adr_output = $aux_file_path,
+ $adr_output =~ s|$tempDirectory|$tempURL/|,
+ $adr_output .= ".$ext",
+ } elsif ($aux_file_path =~ m|^$htmlDirectory| ) {
+ $adr_output = $aux_file_path,
+ $adr_output =~ s|$htmlDirectory|$htmlURL|,
+ $adr_output .= ".$ext",
+ } else {
+ # HTML files not in the htmlDirectory are assumed under live under the
+ # templateDirectory in the same directory as the problem.
+ # Create an alias file (link) in the directory html/tmp/html which
+ # points to the original file and return the URL of this alias.
+ # Create all of the subdirectories of html/tmp/html which are needed
+ # using sure file to path.
+
+ # $fileName is obtained from environment for PGeval
+ # it gives the full path to the current problem
+ my $filePath = directoryFromPath($fileName);
+ my $htmlFileSource = convertPath("$templateDirectory${filePath}$aux_file_path.html");
+ my $link = "html/".$self->{uniqIDstub}."-$aux_file_path.$ext";
+ my $linkPath = $self->surePathToTmpFile($link);
+ $adr_output = "${tempURL}$link";
+ if (-e $htmlFileSource) {
+ if (-e $linkPath) {
+ unlink($linkPath) || warn "Unable to unlink alias file at |$linkPath|";
+ # destroy the old link.
+ }
+ symlink( $htmlFileSource, $linkPath)
+ || warn "The macro alias cannot create a link from |$linkPath| to |$htmlFileSource| <BR>" ;
+ } else {
+ warn("The macro alias cannot find an HTML file at: |$htmlFileSource|");
+ }
+ }
+ $adr_output;
+}
+
+
+sub alias_for_gif_in_html_mode {
+ my $self = shift;
+ my $aux_file_path = shift;
+# warn "entering alias_for_gif_in_html_mode $aux_file_path";
+
+ my $envir = $self->{envir}; my $fileName = $envir->{fileName};
+ my $htmlDirectory = $envir->{htmlDirectory};
+ my $htmlURL = $envir->{htmlURL};
+ my $tempDirectory = $envir->{tempDirectory};
+ my $tempURL = $envir->{tempURL};
+ my $studentLogin = $envir->{studentLogin};
+ my $psvnNumber = $envir->{psvnNumber};
+ my $setNumber = $envir->{setNumber};
+ my $probNum = $envir->{probNum};
+ my $displayMode = $envir->{displayMode};
+ my $externalGif2EpsPath = $envir->{externalGif2EpsPath};
+ my $externalPng2EpsPath = $envir->{externalPng2EpsPath};
+
+ my $templateDirectory = $self->{templateDirectory};
+
+
+ # $adr_output is a url in HTML and Latex2HTML modes
+ # and a complete path in TEX mode.
+ my $adr_output;
+ my $ext = "gif";
+
+ ################################################################################
+ # .gif FILES in HTML, HTML_tth, HTML_dpng, HTML_img, and Latex2HTML modes
+ ################################################################################
+
+ #warn "tempDirectory is $tempDirectory";
+ #warn "file Path for auxiliary file is $aux_file_path";
+
+ # No changes are made for auxiliary files in the htmlDirectory or in the tempDirectory subtree.
+ if ( $aux_file_path =~ m|^$tempDirectory| ) {
+ $adr_output = $aux_file_path;
+ $adr_output =~ s|$tempDirectory|$tempURL|;
+ $adr_output .= ".$ext";
+ #warn "adress out is $adr_output",
+ } elsif ($aux_file_path =~ m|^$htmlDirectory| ) {
+ $adr_output = $aux_file_path;
+ $adr_output =~ s|$htmlDirectory|$htmlURL|;
+ $adr_output .= ".$ext";
+ } else {
+ # files not in the htmlDirectory sub tree are assumed to live under the templateDirectory
+ # subtree in the same directory as the problem.
+
+ # For a gif file the alias macro creates an alias under the html/images directory
+ # which points to the gif file in the problem directory.
+ # All of the subdirectories of html/tmp/gif which are needed are also created.
+ my $filePath = directoryFromPath($fileName);
+
+ # $fileName is obtained from environment for PGeval
+ # it gives the full path to the current problem
+ my $gifSourceFile = convertPath("$templateDirectory${filePath}$aux_file_path.gif");
+ #my $link = "gif/$studentLogin-$psvnNumber-set$setNumber-prob$probNum-$aux_file_path.$ext";
+
+ # Make file names work in Library Browser when the images in several
+ # files have the same names.
+ my $libFix = "";
+ if ($setNumber eq "Undefined_Set") {
+ $libFix = $fileName;
+ $libFix =~ s!.*/!!, $libFix =~ s!\.pg(\..*)?$!!;
+ $libFix =~ s![^a-zA-Z0-9._-]!!g;
+ $libFix .= '-';
+ }
+
+ my $link = "gif/$setNumber-prob$probNum-$libFix$aux_file_path.$ext";
+
+ my $linkPath = $self->surePathToTmpFile($link);
+ $adr_output = "${tempURL}$link";
+ #warn "linkPath is $linkPath";
+ #warn "adr_output is $adr_output";
+ if (-e $gifSourceFile) {
+ if (-e $linkPath) {
+ unlink($linkPath) || warn "Unable to unlink old alias file at $linkPath";
+ }
+ symlink($gifSourceFile, $linkPath)
+ || warn "The macro alias cannot create a link from |$linkPath| to |$gifSourceFile| <BR>" ;
+ } else {
+ warn("The macro alias cannot find a GIF file at: |$gifSourceFile|");
+ }
+ }
+ $adr_output;
+}
+
+sub alias_for_gif_in_tex_mode {
+ my $self = shift;
+ my $aux_file_path = shift;
+
+ my $envir = $self->{envir}; my $fileName = $envir->{fileName};
+ my $htmlDirectory = $envir->{htmlDirectory};
+ my $htmlURL = $envir->{htmlURL};
+ my $tempDirectory = $envir->{tempDirectory};
+ my $tempURL = $envir->{tempURL};
+ my $studentLogin = $envir->{studentLogin};
+ my $psvnNumber = $envir->{psvnNumber};
+ my $setNumber = $envir->{setNumber};
+ my $probNum = $envir->{probNum};
+ my $displayMode = $envir->{displayMode};
+ my $externalGif2EpsPath = $envir->{externalGif2EpsPath};
+ my $externalPng2EpsPath = $envir->{externalPng2EpsPath};
+
+ my $templateDirectory = $self->{templateDirectory};
+
+
+ # $adr_output is a url in HTML and Latex2HTML modes
+ # and a complete path in TEX mode.
+ my $adr_output;
+ my $ext = "gif";
+ ################################################################################
+ # .gif FILES in TeX mode
+ ################################################################################
+
+ $setNumber =~ s/\./_/g; ## extra dots confuse latex's graphics package
+ if ($envir->{texDisposition} eq "pdf") {
+ # We're going to create PDF files with our TeX (using pdflatex); so we
+ # need images in PNG format.
+
+ my $gifFilePath;
+
+ if ($aux_file_path =~ m/^$htmlDirectory/ or $aux_file_path =~ m/^$tempDirectory/) {
+ # we've got a full pathname to a file
+ $gifFilePath = "$aux_file_path.gif";
+ } else {
+ # we assume the file is in the same directory as the problem source file
+ $gifFilePath = $templateDirectory . directoryFromPath($fileName) . "$aux_file_path.gif";
+ }
+
+ my $gifFileName = fileFromPath($gifFilePath);
+
+ $gifFileName =~ /^(.*)\.gif$/;
+# my $pngFilePath = $self->surePathToTmpFile("${tempDirectory}png/$probNum-$1.png");
+ my $pngFilePath = $self->surePathToTmpFile("${tempDirectory}png/$setNumber-$probNum-$1.png");
+ my $returnCode = system "cat $gifFilePath | ${$envir->{externalGif2PngPath}} > $pngFilePath";
+
+ if ($returnCode or not -e $pngFilePath) {
+ die "failed to convert $gifFilePath to $pngFilePath using gif->png with ${$envir->{externalGif2PngPath}}: $!\n";
+ }
+
+ $adr_output = $pngFilePath;
+ } else {
+ # Since we're not creating PDF files; we're probably just using a plain
+ # vanilla latex. Hence; we need EPS images.
+
+ ################################################################################
+ # This is statement used below is system dependent.
+ # Notice that the range of colors is restricted when converting to postscript to keep the files small
+ # "cat $gifSourceFile | /usr/math/bin/giftopnm | /usr/math/bin/pnmtops -noturn > $adr_output"
+ # "cat $gifSourceFile | /usr/math/bin/giftopnm | /usr/math/bin/pnmdepth 1 | /usr/math/bin/pnmtops -noturn > $adr_output"
+ ################################################################################
+ if ($aux_file_path =~ m|^$htmlDirectory| or $aux_file_path =~ m|^$tempDirectory|) {
+ # To serve an eps file copy an eps version of the gif file to the subdirectory of eps/
+ my $linkPath = directoryFromPath($fileName);
+
+ my $gifSourceFile = "$aux_file_path.gif";
+ my $gifFileName = fileFromPath($gifSourceFile);
+ $adr_output = surePathToTmpFile("$tempDirectory/eps/$studentLogin-$psvnNumber-$gifFileName.eps") ;
+
+ if (-e $gifSourceFile) {
+ #system("cat $gifSourceFile | /usr/math/bin/giftopnm | /usr/math/bin/pnmdepth 1 | /usr/math/bin/pnmtops -noturn>$adr_output")
+ system("cat $gifSourceFile | ${externalGif2EpsPath} > $adr_output" )
+ && die "Unable to create eps file:\n |$adr_output| from file\n |$gifSourceFile|\n in problem $probNum " .
+ "using the system dependent script\n |${externalGif2EpsPath}| \n";
+ } else {
+ die "|$gifSourceFile| cannot be found. Problem number: |$probNum|";
+ }
+ } else {
+ # To serve an eps file copy an eps version of the gif file to a subdirectory of eps/
+ my $filePath = directoryFromPath($fileName);
+ my $gifSourceFile = "${templateDirectory}${filePath}$aux_file_path.gif";
+ #print "content-type: text/plain \n\nfileName = $fileName and aux_file_path =$aux_file_path<BR>";
+ $adr_output = surePathToTmpFile("eps/$studentLogin-$psvnNumber-set$setNumber-prob$probNum-$aux_file_path.eps");
+
+ if (-e $gifSourceFile) {
+ #system("cat $gifSourceFile | /usr/math/bin/giftopnm | /usr/math/bin/pnmdepth 1 | /usr/math/bin/pnmtops -noturn>$adr_output") &&
+ #warn "Unable to create eps file: |$adr_output|\n from file\n |$gifSourceFile|\n in problem $probNum";
+ #warn "Help ${:externalGif2EpsPath}" unless -x "${main::externalGif2EpsPath}";
+ system("cat $gifSourceFile | ${externalGif2EpsPath} > $adr_output" )
+ && die "Unable to create eps file:\n |$adr_output| from file\n |$gifSourceFile|\n in problem $probNum " .
+ "using the system dependent commands \n |${externalGif2EpsPath}| \n ";
+ } else {
+ die "|$gifSourceFile| cannot be found. Problem number: |$probNum|";
+ }
+ }
+ }
+ $adr_output;
+
+}
+sub alias_for_png_in_html_mode {
+ my $self = shift;
+ my $aux_file_path = shift;
+
+ my $envir = $self->{envir}; my $fileName = $envir->{fileName};
+ my $htmlDirectory = $envir->{htmlDirectory};
+ my $htmlURL = $envir->{htmlURL};
+ my $tempDirectory = $envir->{tempDirectory};
+ my $tempURL = $envir->{tempURL};
+ my $studentLogin = $envir->{studentLogin};
+ my $psvnNumber = $envir->{psvnNumber};
+ my $setNumber = $envir->{setNumber};
+ my $probNum = $envir->{probNum};
+ my $displayMode = $envir->{displayMode};
+ my $externalGif2EpsPath = $envir->{externalGif2EpsPath};
+ my $externalPng2EpsPath = $envir->{externalPng2EpsPath};
+
+ my $templateDirectory = $self->{templateDirectory};
+
+
+ # $adr_output is a url in HTML and Latex2HTML modes
+ # and a complete path in TEX mode.
+ my $adr_output;
+ my $ext = "png";
+ ################################################################################
+ # .png FILES in HTML; HTML_tth; HTML_dpng; HTML_img; etc. and Latex2HTML modes
+ ################################################################################
+
+ #warn "tempDirectory is $tempDirectory";
+ #warn "file Path for auxiliary file is $aux_file_path";
+
+ # No changes are made for auxiliary files in the htmlDirectory or in the tempDirectory subtree.
+ if ( $aux_file_path =~ m|^$tempDirectory| ) {
+ $adr_output = $aux_file_path;
+ $adr_output =~ s|$tempDirectory|$tempURL|;
+ $adr_output .= ".$ext";
+ #warn "adress out is $adr_output";
+ } elsif ($aux_file_path =~ m|^$htmlDirectory| ) {
+ $adr_output = $aux_file_path;
+ $adr_output =~ s|$htmlDirectory|$htmlURL|;
+ $adr_output .= ".$ext";
+ } else {
+ # files not in the htmlDirectory sub tree are assumed to live under the templateDirectory
+ # subtree in the same directory as the problem.
+
+ # For a png file the alias macro creates an alias under the html/images directory
+ # which points to the png file in the problem directory.
+ # All of the subdirectories of html/tmp/gif which are needed are also created.
+ my $filePath = directoryFromPath($fileName);
+
+ # $fileName is obtained from environment for PGeval
+ # it gives the full path to the current problem
+ my $pngSourceFile = convertPath("$templateDirectory${filePath}$aux_file_path.png");
+ my $link = "gif/".$self->{uniqIDstub}."-$aux_file_path.$ext";
+ my $linkPath = surePathToTmpFile($link);
+ $adr_output = "${tempURL}$link";
+ #warn "linkPath is $linkPath";
+ #warn "adr_output is $adr_output";
+ if (-e $pngSourceFile) {
+ if (-e $linkPath) {
+ unlink($linkPath) || warn "Unable to unlink old alias file at $linkPath";
+ }
+ symlink($pngSourceFile, $linkPath)
+ || warn "The macro alias cannot create a link from |$linkPath| to |$pngSourceFile| <BR>" ;
+ } else {
+ warn("The macro alias cannot find a PNG file at: |$pngSourceFile|");
+ }
+ }
+ $adr_output;
+
+}
+
+sub alias_for_png_in_tex_mode {
+
+ my $self = shift;
+ my $aux_file_path = shift;
+
+ my $envir = $self->{envir}; my $fileName = $envir->{fileName};
+ my $htmlDirectory = $envir->{htmlDirectory};
+ my $htmlURL = $envir->{htmlURL};
+ my $tempDirectory = $envir->{tempDirectory};
+ my $tempURL = $envir->{tempURL};
+ my $studentLogin = $envir->{studentLogin};
+ my $psvnNumber = $envir->{psvnNumber};
+ my $setNumber = $envir->{setNumber};
+ my $probNum = $envir->{probNum};
+ my $displayMode = $envir->{displayMode};
+ my $externalGif2EpsPath = $envir->{externalGif2EpsPath};
+ my $externalPng2EpsPath = $envir->{externalPng2EpsPath};
+
+ my $templateDirectory = $self->{templateDirectory};
+
+
+ # $adr_output is a url in HTML and Latex2HTML modes
+ # and a complete path in TEX mode.
+ my $adr_output;
+ my $ext = "png";
+ ################################################################################
+ # .png FILES in TeX mode
+ ################################################################################
+
+ $setNumber =~ s/\./_/g; ## extra dots confuse latex's graphics package
+ if ($envir->{texDisposition} eq "pdf") {
+ # We're going to create PDF files with our TeX (using pdflatex); so we
+ # need images in PNG format. what luck! they're already in PDF format!
+
+ my $pngFilePath;
+
+ if ($aux_file_path =~ m/^$htmlDirectory/ or $aux_file_path =~ m/^$tempDirectory/) {
+ # we've got a full pathname to a file
+ $pngFilePath = "$aux_file_path.png";
+ } else {
+ # we assume the file is in the same directory as the problem source file
+ $pngFilePath = $templateDirectory . directoryFromPath($fileName) . "$aux_file_path.png";
+ }
+
+ $adr_output = $pngFilePath;
+ } else {
+ # Since we're not creating PDF files; we're probably just using a plain
+ # vanilla latex. Hence; we need EPS images.
+
+ ################################################################################
+ # This is statement used below is system dependent.
+ # Notice that the range of colors is restricted when converting to postscript to keep the files small
+ # "cat $pngSourceFile | /usr/math/bin/pngtopnm | /usr/math/bin/pnmtops -noturn > $adr_output"
+ # "cat $pngSourceFile | /usr/math/bin/pngtopnm | /usr/math/bin/pnmdepth 1 | /usr/math/bin/pnmtops -noturn > $adr_output"
+ ################################################################################
+
+ if ($aux_file_path =~ m|^$htmlDirectory| or $aux_file_path =~ m|^$tempDirectory|) {
+ # To serve an eps file copy an eps version of the png file to the subdirectory of eps/
+ my $linkPath = directoryFromPath($fileName);
+
+ my $pngSourceFile = "$aux_file_path.png";
+ my $pngFileName = fileFromPath($pngSourceFile);
+ $adr_output = surePathToTmpFile("$tempDirectory/eps/$studentLogin-$psvnNumber-$pngFileName.eps") ;
+
+ if (-e $pngSourceFile) {
+ #system("cat $pngSourceFile | /usr/math/bin/pngtopnm | /usr/math/bin/pnmdepth 1 | /usr/math/bin/pnmtops -noturn>$adr_output")
+ system("cat $pngSourceFile | ${externalPng2EpsPath} > $adr_output" )
+ && die "Unable to create eps file:\n |$adr_output| from file\n |$pngSourceFile|\n in problem $probNum " .
+ "using the system dependent commands\n |${externalPng2EpsPath}| \n";
+ } else {
+ die "|$pngSourceFile| cannot be found. Problem number: |$probNum|";
+ }
+ } else {
+ # To serve an eps file copy an eps version of the png file to a subdirectory of eps/
+ my $filePath = directoryFromPath($fileName);
+ my $pngSourceFile = "${templateDirectory}${filePath}$aux_file_path.png";
+ #print "content-type: text/plain \n\nfileName = $fileName and aux_file_path =$aux_file_path<BR>";
+ $adr_output = surePathToTmpFile("eps/$studentLogin-$psvnNumber-set$setNumber-prob$probNum-$aux_file_path.eps") ;
+ if (-e $pngSourceFile) {
+ #system("cat $pngSourceFile | /usr/math/bin/pngtopnm | /usr/math/bin/pnmdepth 1 | /usr/math/bin/pnmtops -noturn>$adr_output") &&
+ #warn "Unable to create eps file: |$adr_output|\n from file\n |$pngSourceFile|\n in problem $probNum";
+ #warn "Help ${externalPng2EpsPath}" unless -x "${externalPng2EpsPath}";
+ system("cat $pngSourceFile | ${externalPng2EpsPath} > $adr_output" )
+ && die "Unable to create eps file:\n |$adr_output| from file\n |$pngSourceFile|\n in problem $probNum " .
+ "using the system dependent commands\n |${externalPng2EpsPath}| \n ";
+ } else {
+ die "|$pngSourceFile| cannot be found. Problem number: |$probNum|";
+ }
+ }
+ }
+ $adr_output;
+
+}
+
+################################################
+
+# More resource search macros
+
+################################################
+
+#
+# Look for a macro file in the directories specified in the macros path
+#
+
+# ^variable my $macrosPath
+our ($macrosPath,
+ # ^variable my $pwd
+ $pwd,
+ # ^variable my $appletPath
+ $appletPath,
+ # ^variable my $server_root_url
+ $server_root_url,
+ # ^variable my $templateDirectory
+ $templateDirectory,
+ # ^variable my $scriptDirectory
+ $scriptDirectory,
+ # ^variable my $externalTTHPath
+ $externalTTHPath,
+ );
+
+# ^function findMacroFile
+# ^uses $macrosPath
+# ^uses $pwd
+sub findMacroFile {
+ my $self = shift;
+ my $fileName = shift;
+ my $filePath;
+ foreach my $dir (@{$macrosPath}) {
+ $filePath = "$dir/$fileName";
+ $filePath =~ s!^\.\.?/!$pwd/!;
+ return $filePath if (-r $filePath);
+ }
+ return; # no file found
+}
+
+# ^function check_url
+# ^uses %envir
+sub check_url {
+ my $self = shift;
+ my $url = shift;
+ return undef if $url =~ /;/; # make sure we can't get a second command in the url
+ #FIXME -- check for other exploits of the system call
+ #FIXME -- ALARM feature so that the response cannot be held up for too long.
+ #FIXME doesn't seem to work with relative addresses.
+ #FIXME Can we get the machine name of the server?
+
+ my $check_url_command = $self->{envir}->{externalCheckUrl};
+ my $response = system("$check_url_command $url");
+ return ($response) ? 0 : 1; # 0 indicates success, 256 is failure possibly more checks can be made
+}
+
+# ^variable our %appletCodebaseLocations
+our %appletCodebaseLocations = ();
+# ^function findAppletCodebase
+# ^uses %appletCodebaseLocations
+# ^uses $appletPath
+# ^uses $server_root_url
+# ^uses check_url
+sub findAppletCodebase {
+ my $self = shift;
+ my $fileName = shift; # probably the name of a jar file
+ return $appletCodebaseLocations{$fileName} #check cache first
+ if defined($appletCodebaseLocations{$fileName})
+ and $appletCodebaseLocations{$fileName} =~/\S/;
+
+ foreach my $appletLocation (@{$appletPath}) {
+ if ($appletLocation =~ m|^/|) {
+ $appletLocation = "$server_root_url$appletLocation";
+ }
+ return $appletLocation; # --hack workaround -- just pick the first location and use that -- no checks
+#hack to workaround conflict between lwp-request and apache2
+# comment out the check_url block
+# my $url = "$appletLocation/$fileName";
+# if ($self->check_url($url)) {
+# $appletCodebaseLocations{$fileName} = $appletLocation; #update cache
+# return $appletLocation # return codebase part of url
+# }
+ }
+ return "Error: $fileName not found at ". join(", ", @{$appletPath} ); # no file found
+}
+
+
+1;
\ No newline at end of file
--- /dev/null
+++ lib/PGanswergroup.pm
@@ -0,0 +1,150 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# $CVSHeader: pg/lib/PGanswergroup.pm,v 1.1 2010/05/14 11:39:02 gage Exp $
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of either: (a) the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any later
+# version, or (b) the "Artistic License" which comes with this package.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
+# Artistic License for more details.
+################################################################################
+package PGanswergroup;
+use Exporter;
+use PGcore qw( not_null);
+use PGresponsegroup;
+
+our @ISA=qw(PGcore);
+
+#############################################
+# An object which contains an answer label and
+# an answer evaluator
+# and the links to and contents of all associated answer blanks
+# (i.e the student responses)
+#############################################
+# Notes
+# Answergroup -- input to a single answerEvaluator, may have several answer blanks
+# for example an array or a radio button group or several checkboxes
+# 1. create a answerEvaluator label name
+# 2. provide space for an answerEvaluator
+# 3. indicate that an answer blank or blanks has been published to receive the responses
+# for example store the number of response strings associated with this answerEvaluator label name
+# 4. space for the contents of the responses is provided in the PGresponse group
+# 5. provide a method for applying the evaluator to the responses
+#
+# use Tie: IxHash??? to create ordered hash? (see Perl Cookbook)
+
+sub new {
+ my $class = shift;
+ my $label = shift;
+ my $self = {
+ ans_label => $label,
+ ans_eval => undef, # usually an AnswerEvaluator, sometimes a CODE
+ response => new PGresponsegroup($label), # A PGresponse object which holds the responses
+ # which make up the answer
+ active => 1, # whether this answer group is currently active (for multistate problems)
+
+ @_,
+ };
+ bless $self, $class;
+ return $self;
+
+}
+
+sub evaluate { # applies the answer evaluator to the student response and returns an answer hash
+
+
+
+}
+
+sub complete { # test to see if answer evaluator and appropriate response blanks are all present
+
+
+
+}
+sub ans_eval {
+ my $self = shift;
+ my $ans_eval = shift;
+ $self->{ans_eval}= $ans_eval if ref($ans_eval);
+ $self->{ans_eval};
+}
+sub append_responses { #add or modify a response to the PGresponsegroup object
+ my $self = shift;
+ my @response_list = @_; # ordered list of label/ value pairs
+ $self->{response}->append_responses(@response_list);
+}
+
+sub insert_responses { # add a group of responses ( label/value pairs)
+ my $self = shift;
+ my @response_list = @_;
+ $self->{response}->clear();
+ $self->{response}->a...
[truncated message content] |
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 02:09:01
|
Log Message:
-----------
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:
PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash
dangerousMacros.pl is no longer used.
Modified Files:
--------------
pg/macros:
dangerousMacros.pl
Revision Data
-------------
Index: dangerousMacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/dangerousMacros.pl,v
retrieving revision 1.58
retrieving revision 1.59
diff -Lmacros/dangerousMacros.pl -Lmacros/dangerousMacros.pl -u -r1.58 -r1.59
--- macros/dangerousMacros.pl
+++ macros/dangerousMacros.pl
@@ -92,1292 +92,1308 @@
=cut
-BEGIN {
- be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
-
-}
-
-# ^variable my $debugON
-my $debugON = 0;
-
-# grab read only variables from the current safe compartment
-
-# ^variable my $macrosPath
-my ($macrosPath,
- # ^variable my $pwd
- $pwd,
- # ^variable my $appletPath
- $appletPath,
- # ^variable my $server_root_url
- $server_root_url,
- # ^variable my $templateDirectory
- $templateDirectory,
- # ^variable my $scriptDirectory
- $scriptDirectory,
- # ^variable my $externalTTHPath
- $externalTTHPath,
- );
+#
+# BEGIN {
+# be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
+#
+# }
+#
+# # ^variable my $debugON
+# my $debugON = 0;
+#
+# # grab read only variables from the current safe compartment
+#
+# # ^variable my $macrosPath
+# my ($macrosPath,
+# # ^variable my $pwd
+# $pwd,
+# # ^variable my $appletPath
+# $appletPath,
+# # ^variable my $server_root_url
+# $server_root_url,
+# # ^variable my $templateDirectory
+# $templateDirectory,
+# # ^variable my $scriptDirectory
+# $scriptDirectory,
+# # ^variable my $externalTTHPath
+# $externalTTHPath,
+# );
+#
+# # ^function _dangerousMacros_init
+# # ^uses %envir
+# # ^uses $macrosPath
+# # ^uses $pwd
+# # ^uses $appletPath
+# # ^uses $server_root_url
+# # ^uses $templateDirectory
+# # ^uses $scriptDirectory
+# # ^uses $externalTTHPath
+# # ^uses $debugON
-# ^function _dangerousMacros_init
-# ^uses %envir
-# ^uses $macrosPath
-# ^uses $pwd
-# ^uses $appletPath
-# ^uses $server_root_url
-# ^uses $templateDirectory
-# ^uses $scriptDirectory
-# ^uses $externalTTHPath
-# ^uses $debugON
sub _dangerousMacros_init { #use envir instead of local variables?
- # will allow easy addition of new directories -- is this too liberal? do some pg directories need to be protected?
- $macrosPath = eval('$main::envir{pgDirectories}{macrosPath}');
- # will allow easy addition of new directories -- is this too liberal? do some pg directories need to be protected?
- $pwd = eval('$main::envir{fileName}'); $pwd =~ s!/[^/]*$!!;
- $appletPath = eval('$main::envir{pgDirectories}{appletPath}');
- $server_root_url = eval('$main::envir{server_root_url}');
-
- $templateDirectory = eval('$main::envir{templateDirectory}');
- $scriptDirectory = eval('$main::envir{scriptDirectory}');
- $externalTTHPath = eval('$main::envir{externalTTHPath}');
- $pwd = $templateDirectory.$pwd unless substr($pwd,0,1) eq '/';
- $pwd =~ s!/tmpEdit/!/!;
- warn "dangerousmacros initialized" if $debugON;
- warn eval(q! "dangerousmacros.pl externalTTHPath is ".$main::externalTTHPath;!) if $debugON;
- warn eval(q! "dangerousmacros.pl: The envir variable $main::{envir} is".join(" ",%main::envir)!) if $debugON;
-}
-
-# ^function _dangerousMacros_export
-sub _dangerousMacros_export {
- my @EXPORT= (
- '&_dangerousMacros_init',
- '&alias',
- '&compile_file',
- '&insertGraph',
- '&loadMacros',
- '&HEADER_TEXT',
- '&sourceAlias',
- '&tth',
- );
- @EXPORT;
-}
-
-
-=head2 loadMacros
-
- loadMacros(@macroFiles)
-
-loadMacros takes a list of file names and evaluates the contents of each file.
-This is used to load macros which define and augment the PG language. The macro
-files are searched for in the directories specified by the array referenced by
-$macrosPath, which by default is the current course's macros directory followed
-by WeBWorK's pg/macros directory. The latter is where the default behaviour of
-the PG language is defined. The default path is set in the global.conf file.
-
-Macro files named PG.pl, IO.pl, or dangerousMacros.pl will be loaded with no
-opcode restrictions, hence any code in those files will be able to execute
-privileged operations. This is true no matter which macro directory the file is
-in. For example, if $macrosPath contains the path to a problem library macros
-directory which contains a PG.pl file, this file will be loaded and allowed to
-engage in privileged behavior.
-
-=head3 Overloading macro files
-
-An individual course can modify the PG language, for that course only, by
-duplicating one of the macro files in the system-wide macros directory and
-placing this file in the macros directory for the course. The new file in the
-course's macros directory will now be used instead of the file in the
-system-wide macros directory.
-
-The new file in the course macros directory can by modified by adding macros or
-modifying existing macros.
-
-=head3 Modifying existing macros
-
-I<Modifying macros is for users with some experience.>
-
-Modifying existing macros might break other standard macros or problems which
-depend on the unmodified behavior of these macors so do this with great caution.
-In addition problems which use new macros defined in these files or which depend
-on the modified behavior of existing macros will not work in other courses
-unless the macros are also transferred to the new course. It helps to document
-the problems by indicating any special macros which the problems require.
-
-There is no facility for modifying or overloading a single macro. The entire
-file containing the macro must be overloaded.
-
-Modifications to files in the course macros directory affect only that course,
-they will not interfere with the normal behavior of WeBWorK in other courses.
-
-=cut
-
-# Global variables used
-# ${main::macrosPath}
-# Global macros used
-# None
-
-# Because of the need to use the directory variables it is tricky to define this
-# in translate.pl since, as currently written, the directories are not available
-# at that time. Perhaps if I rewrite translate as an object that method will work.
-
-# The only difficulty with defining loadMacros inside the Safe compartment is that
-# the error reporting does not work with syntax errors.
-# A kludge using require works around this problem
-
-
-# ^function loadMacros
-# ^uses time_it
-# ^uses $debugON
-# ^uses $externalTTHPath
-# ^uses findMacroFile
-sub loadMacros {
- my @files = @_;
- my $fileName;
- eval {main::time_it("begin load macros");};
- ###############################################################################
- # At this point the directories have been defined from %envir and we can define
- # the directories for this file
- ###############################################################################
-
- # special case inits
- foreach my $file ('PG.pl','dangerousMacros.pl','IO.pl') {
- my $macro_file_name = $file;
- $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 $init_subroutine = eval { \&{$init_subroutine_name} };
- use strict;
- my $macro_file_loaded = defined($init_subroutine);
- warn "dangerousMacros: macro init $init_subroutine_name defined |$init_subroutine| |$macro_file_loaded|" if $debugON;
- if ( defined($init_subroutine) && defined( &{$init_subroutine} ) ) {
-
- warn "dangerousMacros: initializing $macro_file_name" if $debugON;
- &$init_subroutine();
- }
- }
- unless (defined( $externalTTHPath)){
- warn "WARNING::Please make sure that the DOCUMENT() statement comes before<BR>\n" .
- " the loadMacros() statement in the problem template.<p>" .
- " The externalTTHPath variable |$externalTTHPath| was\n".
- " not defined which usually indicates the problem above.<br>\n";
-
- }
- #warn "running load macros";
- while (@files) {
- $fileName = shift @files;
- next if ($fileName =~ /^PG.pl$/) ; # the PG.pl macro package is already loaded.
-
- 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";
- $init_subroutine_name =~ s![^a-zA-Z0-9_]!_!g; # remove dangerous chars
-
- ###############################################################################
- # For some reason the "no stict" which works on webwork-db doesn't work on
- # webwork. For this reason the constuction &{$init_subroutine_name}
- # was abandoned and replaced by eval. This is considerably more dangerous
- # since one could hide something nasty in a file name.
- # Keep an eye on this ???
- # webwork-db used perl 5.6.1 and webwork used perl 5.6.0
- ###############################################################################
-
- # compile initialization subroutine. (5.6.0 version)
-
-
-# eval( q{ \$init_subroutine = \\&main::}.$init_subroutine_name);
-# warn "dangerousMacros: failed to compile $init_subroutine_name. $@" if $@;
-
-
- ###############################################################################
- #compile initialization subroutine. (5.6.1 version) also works with 5.6.0
-
-# no strict;
- my $init_subroutine = eval { \&{'main::'.$init_subroutine_name} };
-# use strict;
-
- ###############################################################################
-
- # macros are searched for in the directories listed in the $macrosPath array reference.
-
- my $macro_file_loaded = defined($init_subroutine) && defined(&$init_subroutine);
- warn "dangerousMacros: macro init $init_subroutine_name defined |$init_subroutine| |$macro_file_loaded|" if $debugON;
- unless ($macro_file_loaded) {
- warn "loadMacros: loading macro file $fileName\n" if $debugON;
- my $filePath = findMacroFile($fileName);
- #### (check for renamed files here?) ####
- if ($filePath) {compile_file($filePath)}
- else {
- die "Can't locate macro file |$fileName| via path: |".join("|, |",@{$macrosPath})."|";
- }
- }
- ###############################################################################
- # Try again to define the initialization subroutine. (5.6.0 version)
-
-# eval( q{ \$init_subroutine = \\&main::}.$init_subroutine_name );
-# warn "dangerousMacros: failed to compile $init_subroutine_name. $@" if $@;
-# $init_subroutine = $temp::rf_init_subroutine;
- ###############################################################################
- # Try again to define the initialization subroutine. (5.6.1 version) also works with 5.6.0
-
-# no strict;
- $init_subroutine = eval { \&{'main::'.$init_subroutine_name} };
+# # will allow easy addition of new directories -- is this too liberal? do some pg directories need to be protected?
+# $macrosPath = eval('$main::envir{pgDirectories}{macrosPath}');
+# # will allow easy addition of new directories -- is this too liberal? do some pg directories need to be protected?
+# $pwd = eval('$main::envir{fileName}'); $pwd =~ s!/[^/]*$!!;
+# $appletPath = eval('$main::envir{pgDirectories}{appletPath}');
+# $server_root_url = eval('$main::envir{server_root_url}');
+#
+# $templateDirectory = eval('$main::envir{templateDirectory}');
+# $scriptDirectory = eval('$main::envir{scriptDirectory}');
+# $externalTTHPath = eval('$main::envir{externalTTHPath}');
+# $pwd = $templateDirectory.$pwd unless substr($pwd,0,1) eq '/';
+# $pwd =~ s!/tmpEdit/!/!;
+# warn "dangerousmacros initialized" if $debugON;
+# warn eval(q! "dangerousmacros.pl externalTTHPath is ".$main::externalTTHPath;!) if $debugON;
+# warn eval(q! "dangerousmacros.pl: The envir variable $main::{envir} is".join(" ",%main::envir)!) if $debugON;
+
+ }
+
+#
+# # ^function _dangerousMacros_export
+# sub _dangerousMacros_export {
+# my @EXPORT= (
+# '&_dangerousMacros_init',
+# '&alias',
+# '&compile_file',
+# '&insertGraph',
+# '&loadMacros',
+# '&HEADER_TEXT',
+# '&sourceAlias',
+# '&tth',
+# );
+# @EXPORT;
+# }
+#
+#
+# =head2 loadMacros
+#
+# loadMacros(@macroFiles)
+#
+# loadMacros takes a list of file names and evaluates the contents of each file.
+# This is used to load macros which define and augment the PG language. The macro
+# files are searched for in the directories specified by the array referenced by
+# $macrosPath, which by default is the current course's macros directory followed
+# by WeBWorK's pg/macros directory. The latter is where the default behaviour of
+# the PG language is defined. The default path is set in the global.conf file.
+#
+# Macro files named PG.pl, IO.pl, or dangerousMacros.pl will be loaded with no
+# opcode restrictions, hence any code in those files will be able to execute
+# privileged operations. This is true no matter which macro directory the file is
+# in. For example, if $macrosPath contains the path to a problem library macros
+# directory which contains a PG.pl file, this file will be loaded and allowed to
+# engage in privileged behavior.
+#
+# =head3 Overloading macro files
+#
+# An individual course can modify the PG language, for that course only, by
+# duplicating one of the macro files in the system-wide macros directory and
+# placing this file in the macros directory for the course. The new file in the
+# course's macros directory will now be used instead of the file in the
+# system-wide macros directory.
+#
+# The new file in the course macros directory can by modified by adding macros or
+# modifying existing macros.
+#
+# =head3 Modifying existing macros
+#
+# I<Modifying macros is for users with some experience.>
+#
+# Modifying existing macros might break other standard macros or problems which
+# depend on the unmodified behavior of these macors so do this with great caution.
+# In addition problems which use new macros defined in these files or which depend
+# on the modified behavior of existing macros will not work in other courses
+# unless the macros are also transferred to the new course. It helps to document
+# the problems by indicating any special macros which the problems require.
+#
+# There is no facility for modifying or overloading a single macro. The entire
+# file containing the macro must be overloaded.
+#
+# Modifications to files in the course macros directory affect only that course,
+# they will not interfere with the normal behavior of WeBWorK in other courses.
+#
+# =cut
+#
+# # Global variables used
+# # ${main::macrosPath}
+# # Global macros used
+# # None
+#
+# # Because of the need to use the directory variables it is tricky to define this
+# # in translate.pl since, as currently written, the directories are not available
+# # at that time. Perhaps if I rewrite translate as an object that method will work.
+#
+# # The only difficulty with defining loadMacros inside the Safe compartment is that
+# # the error reporting does not work with syntax errors.
+# # A kludge using require works around this problem
+#
+#
+# # ^function loadMacros
+# # ^uses time_it
+# # ^uses $debugON
+# # ^uses $externalTTHPath
+# # ^uses findMacroFile
+# sub loadMacros {
+# my @files = @_;
+# my $fileName;
+# eval {main::time_it("begin load macros");};
+# ###############################################################################
+# # At this point the directories have been defined from %envir and we can define
+# # the directories for this file
+# ###############################################################################
+#
+# # special case inits
+# foreach my $file ('PG.pl','dangerousMacros.pl','IO.pl') {
+# my $macro_file_name = $file;
+# $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 $init_subroutine = eval { \&{$init_subroutine_name} };
# use strict;
- ###############################################################################
- #warn "loadMacros: defining \$temp::rf_init_subroutine ",$temp::rf_init_subroutine;
- $macro_file_loaded = defined($init_subroutine) && defined(&$init_subroutine);
- warn "dangerousMacros: macro init $init_subroutine_name defined |$init_subroutine| |$macro_file_loaded|" if $debugON;
-
- if ( defined($init_subroutine) && defined( &{$init_subroutine} ) ) {
- warn "dangerousMacros: initializing $macro_file_name" if $debugON;
- &$init_subroutine();
- }
- #warn "main:: contains <br>\n $macro_file_name ".join("<br>\n $macro_file_name ", %main::);
- }
- eval{main::time_it("end load macros");};
-}
-
-#
-# Look for a macro file in the directories specified in the macros path
-#
-
-# ^function findMacroFile
-# ^uses $macrosPath
-# ^uses $pwd
-sub findMacroFile {
- my $fileName = shift;
- my $filePath;
- foreach my $dir (@{$macrosPath}) {
- $filePath = "$dir/$fileName";
- $filePath =~ s!^\.\.?/!$pwd/!;
- return $filePath if (-r $filePath);
- }
- return; # no file found
-}
-
-# ^function check_url
-# ^uses %envir
-sub check_url {
- my $url = shift;
- return undef if $url =~ /;/; # make sure we can't get a second command in the url
- #FIXME -- check for other exploits of the system call
- #FIXME -- ALARM feature so that the response cannot be held up for too long.
- #FIXME doesn't seem to work with relative addresses.
- #FIXME Can we get the machine name of the server?
-
- my $check_url_command = $envir{externalCheckUrl};
- my $response = system("$check_url_command $url");
- return ($response) ? 0 : 1; # 0 indicates success, 256 is failure possibly more checks can be made
-}
-
-# ^variable our %appletCodebaseLocations
-our %appletCodebaseLocations = ();
-# ^function findAppletCodebase
-# ^uses %appletCodebaseLocations
-# ^uses $appletPath
-# ^uses $server_root_url
-# ^uses check_url
-sub findAppletCodebase {
- my $fileName = shift; # probably the name of a jar file
- return $appletCodebaseLocations{$fileName} #check cache first
- if defined($appletCodebaseLocations{$fileName})
- and $appletCodebaseLocations{$fileName} =~/\S/;
-
- foreach my $appletLocation (@{$appletPath}) {
- if ($appletLocation =~ m|^/|) {
- $appletLocation = "$server_root_url$appletLocation";
- }
- my $url = "$appletLocation/$fileName";
- if (check_url($url)) {
- $appletCodebaseLocations{$fileName} = $appletLocation; #update cache
- return $appletLocation # return codebase part of url
- }
- }
- return "Error: $fileName not found at ". join(", ", @{$appletPath} ); # no file found
-}
-# errors in compiling macros is not always being reported.
-# ^function compile_file
-# ^uses @__eval__
-# ^uses PG_restricted_eval
-# ^uses $__files__
-sub compile_file {
- my $filePath = shift;
- warn "loading $filePath" if $debugON;
- local(*MACROFILE);
- local($/);
- $/ = undef; # allows us to treat the file as a single line
- open(MACROFILE, "<$filePath") || die "Cannot open file: $filePath";
- my $string = 'BEGIN {push @__eval__, __FILE__};' . "\n" . <MACROFILE>;
- my ($result,$error,$fullerror) = &PG_restricted_eval($string);
- eval ('$main::__files__->{pop @main::__eval__} = $filePath');
- if ($error) { # the $fullerror report has formatting and is never empty
- # this is now handled by PG_errorMessage() in the PG translator
- #$fullerror =~ s/\(eval \d+\)/ $filePath\n/; # attempt to insert file name instead of eval number
- die "Error detected while loading $filePath:\n$fullerror";
-
- }
-
- close(MACROFILE);
-
-}
-
-# This creates on the fly graphs
-
-=head2 insertGraph
-
- # returns a path to the file containing the graph image.
- $filePath = insertGraph($graphObject);
-
-insertGraph writes a GIF or PNG image file to the gif subdirectory of the
-current course's HTML temp directory. The file name is obtained from the graph
-object. Warnings are issued if errors occur while writing to the file.
-
-Returns a string containing the full path to the temporary file containing the
-image. This is most often used in the construct
-
- TEXT(alias(insertGraph($graph)));
-
-where alias converts the directory address to a URL when serving HTML pages and
-insures that an EPS file is generated when creating TeX code for downloading.
-
-=cut
-
-# ^function insertGraph
-# ^uses $WWPlot::use_png
-# ^uses convertPath
-# ^uses surePathToTmpFile
-# ^uses PG_restricted_eval
-# ^uses $refreshCachedImages
-# ^uses $templateDirectory
-# ^uses %envir
-sub insertGraph {
- # Convert the image to GIF and print it on standard output
- my $graph = shift;
- my $extension = ($WWPlot::use_png) ? '.png' : '.gif';
- my $fileName = $graph->imageName . $extension;
- my $filePath = convertPath("gif/$fileName");
- $filePath = &surePathToTmpFile( $filePath );
- my $refreshCachedImages = PG_restricted_eval(q!$refreshCachedImages!);
- # Check to see if we already have this graph, or if we have to make it
- if( not -e $filePath # does it exist?
- or ((stat "$templateDirectory"."$main::envir{fileName}")[9] > (stat $filePath)[9]) # source has changed
- or $graph->imageName =~ /Undefined_Set/ # problems from SetMaker and its ilk should always be redone
- or $refreshCachedImages
- ) {
- #createFile($filePath, $main::tmp_file_permission, $main::numericalGroupID);
- local(*OUTPUT); # create local file handle so it won't overwrite other open files.
- open(OUTPUT, ">$filePath")||warn ("$0","Can't open $filePath<BR>","");
- chmod( 0777, $filePath);
- print OUTPUT $graph->draw|| warn("$0","Can't print graph to $filePath<BR>","");
- close(OUTPUT)||warn("$0","Can't close $filePath<BR>","");
- }
- $filePath;
-}
-
-=head2 [DEPRECATED] tth
-
- # returns an HTML version of the TeX code passed to it.
- tth($texString);
-
-This macro sends $texString to the filter program TtH, a TeX to HTML translator
-written by Ian Hutchinson. TtH is available free of change non-commerical
-use at L<http://hutchinson.belmont.ma.us/tth/>.
-
-The purpose of TtH is to translate text in the TeX or LaTeX markup language into
-HTML markup as best as possible. Some symbols, such as square root symbols are
-not translated completely. Macintosh users must use the "MacRoman" encoding
-(available in 4.0 and higher browsers) in order to view the symbols correctly.
-WeBWorK attempts to force Macintosh browsers to use this encoding when such a
-browser is detected.
-
-The contents of the file F<tthPreamble.tex> in the courses template directory
-are prepended to each string. This allows one to define TeX macros which can be
-used in every problem. Currently there is no default F<tthPreamble.tex> file, so
-if the file is not present in the course template directory no TeX macro
-definitions are prepended. TtH already understands most LaTeX commands, but will
-not in general know AMS-LaTeX commands.
-
-This macro contains code which is system dependent and may need to be modified
-to run on different systems.
-
-=cut
-
-# the contents of this file will not change during problem compilation it
-# only needs to be read once. however, the contents of the file may change,
-# and indeed the file refered to may change, between rendering passes. thus,
-# we need to keep track of the file name and the mtime as well.
-# ^variable my $tthPreambleFile
-# ^variable my $tthPreambleMtime
-# ^variable my $tthPreambleContents
-my ($tthPreambleFile, $tthPreambleMtime, $tthPreambleContents);
-
-# ^function tth
-# ^uses $templateDirectory
-# ^uses $envir{externalTTHPath}
-# ^uses $tthPreambleFile
-# ^uses $tthPreambleMtime
-# ^uses $tthPreambleContents
-sub tth {
- my $inputString = shift;
-
- my $thisFile = "${templateDirectory}tthPreamble.tex" if -r "${templateDirectory}tthPreamble.tex";
-
- if (defined $thisFile) {
- my $thisMtime = (stat $thisFile)[9];
- my $load =
- # load preamble if we haven't loaded it ever
- (not defined $tthPreambleFile or not defined $tthPreambleMtime or not defined $tthPreambleContents)
- ||
- # load if the file path has changed
- ($tthPreambleFile ne $thisFile)
- ||
- # load if the file has been modified
- ($tthPreambleMtime < $thisMtime);
-
- if ($load) {
- local(*TTHIN);
- open (TTHIN, "${templateDirectory}tthPreamble.tex") || die "Can't open file ${templateDirectory}tthPreamble.tex";
- local($/);
- $/ = undef;
- $tthPreambleContents = <TTHIN>;
- close(TTHIN);
-
- $tthPreambleContents =~ s/(.)\n/$1%\n/g; # thanks to Jim Martino
- # each line in the definition file
- # should end with a % to prevent
- # adding supurious paragraphs to output.
-
- $tthPreambleContents .="%\n"; # solves the problem if the file doesn't end with a return.
- }
- } else {
- $tthPreambleContents = "";
- }
-
- $inputString = $tthPreambleContents . $inputString;
- $inputString = "<<END_OF_TTH_INPUT_STRING;\n\n\n" . $inputString . "\nEND_OF_TTH_INPUT_STRING\necho \"\" >/dev/null"; #it's not clear why another command is needed.
-
- # $tthpath is now taken from $Global::externalTTHPath via %envir.
- my $tthpath = $envir{externalTTHPath};
- my $out;
-
- if (-x $tthpath ) {
- my $tthcmd = "$tthpath -L -f5 -u -r 2>/dev/null " . $inputString;
- if (open(TTH, "$tthcmd |")) {
- local($/);
- $/ = undef;
- $out = <TTH>;
- $/ = "\n";
- close(TTH);
- }else {
- $out = "<BR>there has been an error in executing $tthcmd<BR>";
- }
- } else {
- $out = "<BR> Can't execute the program tth at |$tthpath|<BR>";
- }
-
- $out;
-}
-
-# possible solution to the tth font problem? Works only for iCab.
-# ^function symbolConvert
-sub symbolConvert {
- my $string = shift;
- $string =~ s/\x5C/\\/g; #\ 92 \
- $string =~ s/\x7B/\{/g; #{ 123 {
- $string =~ s/\x7D/\}/g; #} 125 }
- $string =~ s/\xE7/\Á/g; #Á 231 Á
- $string =~ s/\xE6/\Ê/g; #Ê 230 Ê
- $string =~ s/\xE8/\Ë/g; #Ë 232 Ë
- $string =~ s/\xF3/\Û/g; #Û 243 Û
- $string =~ s/\xA5/\•/g; # 165 •
- $string =~ s/\xB2/\≤/g; #¾ 178 ≤
- $string =~ s/\xB3/\≥/g; # 179 ≥
- $string =~ s/\xB6/\∂/g; # 182 ∂
- $string =~ s/\xCE/\Œ/g; # 206 Œ
- $string =~ s/\xD6/\˜/g; #÷ 214 ˜
- $string =~ s/\xD9/\Ÿ/g; # 217 Ÿ
- $string =~ s/\xDA/\⁄/g; # 218 ⁄
- $string =~ s/\xF5/\ı/g; # 245 ı
- $string =~ s/\xF6/\ˆ/g; # 246 ˆ
- $string =~ s/\xF7/\Á/g; # 247 Á
- $string =~ s/\xF8/\¯/g; #¯ 248 ¯
- $string =~ s/\xF9/\˘/g; # 249 ˘
- $string =~ s/\xFA/\˙/g; # 250 ˙
- $string =~ s/\xFB/\˚;/g; # 251 ˚
- $string;
-}
-
-# ----- ----- ----- -----
-
-=head2 [DEPRECATED] math2img
-
- # returns an IMG tag pointing to an image version of the supplied TeX
- math2img($texString);
-
-This macro was used by the HTML_img display mode, which no longer exists.
-
-=cut
-
-# ^variable my $math2imgCount
-my $math2imgCount = 0;
-
-# ^function math2img
-# ^uses $math2imgCount
-# ^uses $envir{templateDirectory}
-# ^uses $envir{fileName}
-# ^uses $envir{studentLogin}
-# ^uses $envir{setNumber}
-# ^uses $envir{probNum}
-# ^uses $envir{tempURL}
-# ^uses $envir{refreshMath2img}
-# ^uses $envir{dvipngTempDir}
-# ^uses $envir{externalLaTeXPath}
-# ^uses $envir{externalDvipngPath}
-sub math2img {
- my $tex = shift;
- my $mode = shift;
-
- my $sourcePath = $envir{templateDirectory} . "/" . $envir{fileName};
- my $tempFile = "m2i/$envir{studentLogin}.$envir{setNumber}.$envir{probNum}."
- . $math2imgCount++ . ".png";
- my $tempPath = surePathToTmpFile($tempFile); #my $tempPath = "$envir{tempDirectory}$tempFile";
- my $tempURL = "$envir{tempURL}/$tempFile";
- my $forceRefresh = $envir{refreshMath2img};
- my $imageMissing = not -e $tempPath;
- my $imageStale = (stat $sourcePath)[9] > (stat $tempPath)[9] if -e $tempPath;
- if ($forceRefresh or $imageMissing or $imageStale) {
- # image file doesn't exist, or source file is newer then image file
- #warn "math2img: refreshMath2img forcing image generation for $tempFile\n" if $forceRefresh;
- #warn "math2img: $tempFile doesn't exist, so generating it\n" if $imageMissing;
- #warn "math2img: source file (", (stat $sourcePath)[9], ") is newer than image file (",
- # (stat $tempPath)[9], ") so re-generating image\n" if $imageStale;
- if (-e $tempPath) {
- unlink $tempPath or die "Failed to delete stale math2img file $tempPath: $!";
- }
- dvipng(
- $envir{dvipngTempDir}, $envir{externalLaTeXPath},
- $envir{externalDvipngPath}, $tex, $tempPath
- );
- }
-
- if (-e $tempPath) {
- return "<img align=\"middle\" src=\"$tempURL\" alt=\"$tex\">" if $mode eq "inline";
- return "<div align=\"center\"><img src=\"$tempURL\" alt=\"$tex\"></div>" if $mode eq "display";
- } else {
- return "<b>[math2img failed]</b>";
- # it might be nice to call tth here as a fallback instead:
- #return tth($tex);
- }
-};
-
-=head2 [DEPRECATED] dvipng
-
- dvipng($working_directory, $latex_path, $dvipng_path, $tex_string, $target_path)
-
-This macro was used by the HTML_img display mode, which no longer exists.
-
-=cut
-
-# copied from IO.pm for backward compatibility with WeBWorK1.8;
-# ^function dvipng
-sub dvipng($$$$$) {
- my (
- $wd, # working directory, for latex and dvipng garbage
- # (must already exist!)
- $latex, # path to latex binary
- $dvipng, # path to dvipng binary
- $tex, # tex string representing equation
- $targetPath # location of resulting image file
- ) = @_;
-
- my $dvipngBroken = 0;
-
- my $texFile = "$wd/equation.tex";
- my $dviFile = "$wd/equation.dvi";
- my $dviFile2 = "$wd/equationequation.dvi";
- my $dviCall = "equation";
- my $pngFile = "$wd/equation1.png";
-
- unless (-e $wd) {
- die "dvipng working directory $wd doesn't exist -- caller should have created it for us!\n";
- return 0;
- }
-
- # write the tex file
- local *TEX;
- open TEX, ">", $texFile or warn "Failed to create $texFile: $!";
- print TEX <<'EOF';
-% BEGIN HEADER
-\batchmode
-\documentclass[12pt]{article}
-\usepackage{amsmath,amsfonts,amssymb}
-\def\gt{>}
-\def\lt{<}
-\usepackage[active,textmath,displaymath]{preview}
-\begin{document}
-% END HEADER
-EOF
- print TEX "\\( \\displaystyle{$tex} \\)\n";
- print TEX <<'EOF';
-% BEGIN FOOTER
-\end{document}
-% END FOOTER
-EOF
- close TEX;
-
- # call latex
- system "cd $wd && $latex $texFile > /dev/null"
- and warn "Failed to call $latex with $texFile: $!";
-
- unless (-e $dviFile) {
- warn "Failed to generate DVI file $dviFile";
- return 0;
- }
-
- if ($dvipngBroken) {
- # change the name of the DVI file to get around dvipng's
- # crackheadedness. This is no longer needed with the newest
- # version of dvipng (10 something)
- system "/bin/mv", $dviFile, $dviFile2;
- }
-
- # call dvipng -- using warn instead of die passes some extra information
- # back to the user the complete warning is still printed in the apache
- # error log and a simple message (math2img failed) is returned to the
- # webpage.
- my $cmdout;
- $cmdout = system "cd $wd && $dvipng $dviCall > /dev/null"
- and warn "Failed to call$dvipng with $dviCall: $! with signal $cmdout";
-
- unless (-e $pngFile) {
- warn "Failed to create PNG file $pngFile";
- return 0;
- }
-
- $cmdout = system "/bin/mv", $pngFile, $targetPath and warn "Failed to mv: /bin/mv $pngFile $targetPath $!. Call returned $cmdout. \n";
-}
-
-
+# my $macro_file_loaded = defined($init_subroutine);
+# warn "dangerousMacros: macro init $init_subroutine_name defined |$init_subroutine| |$macro_file_loaded|" if $debugON;
+# if ( defined($init_subroutine) && defined( &{$init_subroutine} ) ) {
+#
+# warn "dangerousMacros: initializing $macro_file_name" if $debugON;
+# &$init_subroutine();
+# }
+# }
+# unless (defined( $externalTTHPath)){
+# warn "WARNING::Please make sure that the DOCUMENT() statement comes before<BR>\n" .
+# " the loadMacros() statement in the problem template.<p>" .
+# " The externalTTHPath variable |$externalTTHPath| was\n".
+# " not defined which usually indicates the problem above.<br>\n";
+#
+# }
+# #warn "running load macros";
+# while (@files) {
+# $fileName = shift @files;
+# next if ($fileName =~ /^PG.pl$/) ; # the PG.pl macro package is already loaded.
+#
+# 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";
+# $init_subroutine_name =~ s![^a-zA-Z0-9_]!_!g; # remove dangerous chars
+#
+# ###############################################################################
+# # For some reason the "no stict" which works on webwork-db doesn't work on
+# # webwork. For this reason the constuction &{$init_subroutine_name}
+# # was abandoned and replaced by eval. This is considerably more dangerous
+# # since one could hide something nasty in a file name.
+# # Keep an eye on this ???
+# # webwork-db used perl 5.6.1 and webwork used perl 5.6.0
+# ###############################################################################
+#
+# # compile initialization subroutine. (5.6.0 version)
+#
+#
+# # eval( q{ \$init_subroutine = \\&main::}.$init_subroutine_name);
+# # warn "dangerousMacros: failed to compile $init_subroutine_name. $@" if $@;
+#
+#
+# ###############################################################################
+# #compile initialization subroutine. (5.6.1 version) also works with 5.6.0
+#
+# # no strict;
+# my $init_subroutine = eval { \&{'main::'.$init_subroutine_name} };
+# # use strict;
+#
+# ###############################################################################
+#
+# # macros are searched for in the directories listed in the $macrosPath array reference.
+#
+# my $macro_file_loaded = defined($init_subroutine) && defined(&$init_subroutine);
+# warn "dangerousMacros: macro init $init_subroutine_name defined |$init_subroutine| |$macro_file_loaded|" if $debugON;
+# unless ($macro_file_loaded) {
+# warn "loadMacros: loading macro file $fileName\n" if $debugON;
+# my $filePath = findMacroFile($fileName);
+# #### (check for renamed files here?) ####
+# if ($filePath) {
+# compile_file($filePath);
+# #warn "loadMacros is compiling $filePath\n";
+# }
+# else {
+# die "Can't locate macro file |$fileName| via path: |".join("|, |",@{$macrosPath})."|";
+# }
+# }
+# ###############################################################################
+# # Try again to define the initialization subroutine. (5.6.0 version)
+#
+# # eval( q{ \$init_subroutine = \\&main::}.$init_subroutine_name );
+# # warn "dangerousMacros: failed to compile $init_subroutine_name. $@" if $@;
+# # $init_subroutine = $temp::rf_init_subroutine;
+# ###############################################################################
+# # Try again to define the initialization subroutine. (5.6.1 version) also works with 5.6.0
+#
+# # no strict;
+# $init_subroutine = eval { \&{'main::'.$init_subroutine_name} };
+# # use strict;
+# ###############################################################################
+# #warn "loadMacros: defining \$temp::rf_init_subroutine ",$temp::rf_init_subroutine;
+# $macro_file_loaded = defined($init_subroutine) && defined(&$init_subroutine);
+# warn "dangerousMacros: macro init $init_subroutine_name defined |$init_subroutine| |$macro_file_loaded|" if $debugON;
+#
+# if ( defined($init_subroutine) && defined( &{$init_subroutine} ) ) {
+# warn "dangerousMacros: initializing $macro_file_name" if $debugON;
+# &$init_subroutine();
+# }
+# #warn "main:: contains <br>\n $macro_file_name ".join("<br>\n $macro_file_name ", %main::);
+# }
+# eval{main::time_it("end load macros");};
+# }
+#
+# #
+# # Look for a macro file in the directories specified in the macros path
+# #
+#
+# # ^function findMacroFile
+# # ^uses $macrosPath
+# # ^uses $pwd
+# sub findMacroFile {
+# my $fileName = shift;
+# my $filePath;
+# foreach my $dir (@{$macrosPath}) {
+# $filePath = "$dir/$fileName";
+# $filePath =~ s!^\.\.?/!$pwd/!;
+# return $filePath if (-r $filePath);
+# }
+# return; # no file found
+# }
+#
+# # ^function check_url
+# # ^uses %envir
+# sub check_url {
+# my $url = shift;
+# return undef if $url =~ /;/; # make sure we can't get a second command in the url
+# #FIXME -- check for other exploits of the system call
+# #FIXME -- ALARM feature so that the response cannot be held up for too long.
+# #FIXME doesn't seem to work with relative addresses.
+# #FIXME Can we get the machine name of the server?
+#
+# my $check_url_command = $envir{externalCheckUrl};
+# my $response = system("$check_url_command $url");
+# return ($response) ? 0 : 1; # 0 indicates success, 256 is failure possibly more checks can be made
+# }
+#
+# # ^variable our %appletCodebaseLocations
+# our %appletCodebaseLocations = ();
+# # ^function findAppletCodebase
+# # ^uses %appletCodebaseLocations
+# # ^uses $appletPath
+# # ^uses $server_root_url
+# # ^uses check_url
+# sub findAppletCodebase {
+# my $fileName = shift; # probably the name of a jar file
+# return $appletCodebaseLocations{$fileName} #check cache first
+# if defined($appletCodebaseLocations{$fileName})
+# and $appletCodebaseLocations{$fileName} =~/\S/;
+#
+# foreach my $appletLocation (@{$appletPath}) {
+# if ($appletLocation =~ m|^/|) {
+# $appletLocation = "$server_root_url$appletLocation";
+# }
+# return $appletLocation; # --hack workaround -- just pick the first location and use that -- no checks
+# #hack to workaround conflict between lwp-request and apache2
+# # comment out the check_url block
+# # my $url = "$appletLocation/$fileName";
+# # if (check_url($url)) {
+# # $appletCodebaseLocations{$fileName} = $appletLocation; #update cache
+# # return $appletLocation # return codebase part of url
+# # }
+# }
+# return "Error: $fileName not found at ". join(", ", @{$appletPath} ); # no file found
+# }
+# # errors in compiling macros is not always being reported.
+# # ^function compile_file
+# # ^uses @__eval__
+# # ^uses PG_restricted_eval
+# # ^uses $__files__
+# sub compile_file {
+# my $filePath = shift;
+# warn "loading $filePath" if $debugON;
+# local(*MACROFILE);
+# local($/);
+# $/ = undef; # allows us to treat the file as a single line
+# open(MACROFILE, "<$filePath") || die "Cannot open file: $filePath";
+# my $string = 'BEGIN {push @__eval__, __FILE__};' . "\n" . <MACROFILE>;
+# my ($result,$error,$fullerror) = &PG_restricted_eval($string);
+# eval ('$main::__files__->{pop @main::__eval__} = $filePath');
+# if ($error) { # the $fullerror report has formatting and is never empty
+# # this is now handled by PG_errorMessage() in the PG translator
+# #$fullerror =~ s/\(eval \d+\)/ $filePath\n/; # attempt to insert file name instead of eval number
+# die "Error detected while loading $filePath:\n$fullerror";
+#
+# }
+#
+# close(MACROFILE);
+#
+# }
+#
+# # This creates on the fly graphs
+#
+# =head2 insertGraph
+#
+# # returns a path to the file containing the graph image.
+# $filePath = insertGraph($graphObject);
+#
+# insertGraph writes a GIF or PNG image file to the gif subdirectory of the
+# current course's HTML temp directory. The file name is obtained from the graph
+# object. Warnings are issued if errors occur while writing to the file.
+#
+# Returns a string containing the full path to the temporary file containing the
+# image. This is most often used in the construct
+#
+# TEXT(alias(insertGraph($graph)));
+#
+# where alias converts the directory address to a URL when serving HTML pages and
+# insures that an EPS file is generated when creating TeX code for downloading.
+#
+# =cut
+#
+# # ^function insertGraph
+# # ^uses $WWPlot::use_png
+# # ^uses convertPath
+# # ^uses surePathToTmpFile
+# # ^uses PG_restricted_eval
+# # ^uses $refreshCachedImages
+# # ^uses $templateDirectory
+# # ^uses %envir
+# sub insertGraph {
+# # Convert the image to GIF and print it on standard output
+# my $graph = shift;
+# my $extension = ($WWPlot::use_png) ? '.png' : '.gif';
+# my $fileName = $graph->imageName . $extension;
+# my $filePath = convertPath("gif/$fileName");
+# $filePath = &surePathToTmpFile( $filePath );
+# my $refreshCachedImages = PG_restricted_eval(q!$refreshCachedImages!);
+# # Check to see if we already have this graph, or if we have to make it
+# if( not -e $filePath # does it exist?
+# or ((stat "$templateDirectory"."$main::envir{fileName}")[9] > (stat $filePath)[9]) # source has changed
+# or $graph->imageName =~ /Undefined_Set/ # problems from SetMaker and its ilk should always be redone
+# or $refreshCachedImages
+# ) {
+# #createFile($filePath, $main::tmp_file_permission, $main::numericalGroupID);
+# local(*OUTPUT); # create local file handle so it won't overwrite other open files.
+# open(OUTPUT, ">$filePath")||warn ("$0","Can't open $filePath<BR>","");
+# chmod( 0777, $filePath);
+# print OUTPUT $graph->draw|| warn("$0","Can't print graph to $filePath<BR>","");
+# close(OUTPUT)||warn("$0","Can't close $filePath<BR>","");
+# }
+# $filePath;
+# }
+#
+# =head2 [DEPRECATED] tth
+#
+# # returns an HTML version of the TeX code passed to it.
+# tth($texString);
+#
+# This macro sends $texString to the filter program TtH, a TeX to HTML translator
+# written by Ian Hutchinson. TtH is available free of change non-commerical
+# use at L<http://hutchinson.belmont.ma.us/tth/>.
+#
+# The purpose of TtH is to translate text in the TeX or LaTeX markup language into
+# HTML markup as best as possible. Some symbols, such as square root symbols are
+# not translated completely. Macintosh users must use the "MacRoman" encoding
+# (available in 4.0 and higher browsers) in order to view the symbols correctly.
+# WeBWorK attempts to force Macintosh browsers to use this encoding when such a
+# browser is detected.
+#
+# The contents of the file F<tthPreamble.tex> in the courses template directory
+# are prepended to each string. This allows one to define TeX macros which can be
+# used in every problem. Currently there is no default F<tthPreamble.tex> file, so
+# if the file is not present in the course template directory no TeX macro
+# definitions are prepended. TtH already understands most LaTeX commands, but will
+# not in general know AMS-LaTeX commands.
+#
+# This macro contains code which is system dependent and may need to be modified
+# to run on different systems.
+#
+# =cut
+#
+# # the contents of this file will not change during problem compilation it
+# # only needs to be read once. however, the contents of the file may change,
+# # and indeed the file refered to may change, between rendering passes. thus,
+# # we need to keep track of the file name and the mtime as well.
+# # ^variable my $tthPreambleFile
+# # ^variable my $tthPreambleMtime
+# # ^variable my $tthPreambleContents
+# my ($tthPreambleFile, $tthPreambleMtime, $tthPreambleContents);
+#
+# # ^function tth
+# # ^uses $templateDirectory
+# # ^uses $envir{externalTTHPath}
+# # ^uses $tthPreambleFile
+# # ^uses $tthPreambleMtime
+# # ^uses $tthPreambleContents
+# sub tth {
+# my $inputString = shift;
+#
+# my $thisFile = "${templateDirectory}tthPreamble.tex" if -r "${templateDirectory}tthPreamble.tex";
+#
+# if (defined $thisFile) {
+# my $thisMtime = (stat $thisFile)[9];
+# my $load =
+# # load preamble if we haven't loaded it ever
+# (not defined $tthPreambleFile or not defined $tthPreambleMtime or not defined $tthPreambleContents)
+# ||
+# # load if the file path has changed
+# ($tthPreambleFile ne $thisFile)
+# ||
+# # load if the file has been modified
+# ($tthPreambleMtime < $thisMtime);
+#
+# if ($load) {
+# local(*TTHIN);
+# open (TTHIN, "${templateDirectory}tthPreamble.tex") || die "Can't open file ${templateDirectory}tthPreamble.tex";
+# local($/);
+# $/ = undef;
+# $tthPreambleContents = <TTHIN>;
+# close(TTHIN);
+#
+# $tthPreambleContents =~ s/(.)\n/$1%\n/g; # thanks to Jim Martino
+# # each line in the definition file
+# # should end with a % to prevent
+# # adding supurious paragraphs to output.
+#
+# $tthPreambleContents .="%\n"; # solves the problem if the file doesn't end with a return.
+# }
+# } else {
+# $tthPreambleContents = "";
+# }
+#
+# $inputString = $tthPreambleContents . $inputString;
+# $inputString = "<<END_OF_TTH_INPUT_STRING;\n\n\n" . $inputString . "\nEND_OF_TTH_INPUT_STRING\necho \"\" >/dev/null"; #it's not clear why another command is needed.
+#
+# # $tthpath is now taken from $Global::externalTTHPath via %envir.
+# my $tthpath = $envir{externalTTHPath};
+# my $out;
+#
+# if (-x $tthpath ) {
+# my $tthcmd = "$tthpath -L -f5 -u -r 2>/dev/null " . $inputString;
+# if (open(TTH, "$tthcmd |")) {
+# local($/);
+# $/ = undef;
+# $out = <TTH>;
+# $/ = "\n";
+# close(TTH);
+# }else {
+# $out = "<BR>there has been an error in executing $tthcmd<BR>";
+# }
+# } else {
+# $out = "<BR> Can't execute the program tth at |$tthpath|<BR>";
+# }
+#
+# $out;
+# }
+#
+# # possible solution to the tth font problem? Works only for iCab.
+# # ^function symbolConvert
+# sub symbolConvert {
+# my $string = shift;
+# $string =~ s/\x5C/\\/g; #\ 92 \
+# $string =~ s/\x7B/\{/g; #{ 123 {
+# $string =~ s/\x7D/\}/g; #} 125 }
+# $string =~ s/\xE7/\Á/g; #Á 231 Á
+# $string =~ s/\xE6/\Ê/g; #Ê 230 Ê
+# $string =~ s/\xE8/\Ë/g; #Ë 232 Ë
+# $string =~ s/\xF3/\Û/g; #Û 243 Û
+# $string =~ s/\xA5/\•/g; # 165 •
+# $string =~ s/\xB2/\≤/g; #¾ 178 ≤
+# $string =~ s/\xB3/\≥/g; # 179 ≥
+# $string =~ s/\xB6/\∂/g; # 182 ∂
+# $string =~ s/\xCE/\Œ/g; # 206 Œ
+# $string =~ s/\xD6/\˜/g; #÷ 214 ˜
+# $string =~ s/\xD9/\Ÿ/g; # 217 Ÿ
+# $string =~ s/\xDA/\⁄/g; # 218 ⁄
+# $string =~ s/\xF5/\ı/g; # 245 ı
+# $string =~ s/\xF6/\ˆ/g; # 246 ˆ
+# $string =~ s/\xF7/\Á/g; # 247 Á
+# $string =~ s/\xF8/\¯/g; #¯ 248 ¯
+# $string =~ s/\xF9/\˘/g; # 249 ˘
+# $string =~ s/\xFA/\˙/g; # 250 ˙
+# $string =~ s/\xFB/\˚;/g; # 251 ˚
+# $string;
+# }
+#
+# # ----- ----- ----- -----
+#
+# =head2 [DEPRECATED] math2img
+#
+# # returns an IMG tag pointing to an image version of the supplied TeX
+# math2img($texString);
+#
+# This macro was used by the HTML_img display mode, which no longer exists.
+#
+# =cut
+#
+# # ^variable my $math2imgCount
+# my $math2imgCount = 0;
+#
+# # ^function math2img
+# # ^uses $math2imgCount
+# # ^uses $envir{templateDirectory}
+# # ^uses $envir{fileName}
+# # ^uses $envir{studentLogin}
+# # ^uses $envir{setNumber}
+# # ^uses $envir{probNum}
+# # ^uses $envir{tempURL}
+# # ^uses $envir{refreshMath2img}
+# # ^uses $envir{dvipngTempDir}
+# # ^uses $envir{externalLaTeXPath}
+# # ^uses $envir{externalDvipngPath}
+# sub math2img {
+# my $tex = shift;
+# my $mode = shift;
+#
+# my $sourcePath = $envir{templateDirectory} . "/" . $envir{fileName};
+# my $tempFile = "m2i/$envir{studentLogin}.$envir{setNumber}.$envir{probNum}."
+# . $math2imgCount++ . ".png";
+# my $tempPath = surePathToTmpFile($tempFile); #my $tempPath = "$envir{tempDirectory}$tempFile";
+# my $tempURL = "$envir{tempURL}/$tempFile";
+# my $forceRefresh = $envir{refreshMath2img};
+# my $imageMissing = not -e $tempPath;
+# my $imageStale = (stat $sourcePath)[9] > (stat $tempPath)[9] if -e $tempPath;
+# if ($forceRefresh or $imageMissing or $imageStale) {
+# # image file doesn't exist, or source file is newer then image file
+# #warn "math2img: refreshMath2img forcing image generation for $tempFile\n" if $forceRefresh;
+# #warn "math2img: $tempFile doesn't exist, so generating it\n" if $imageMissing;
+# #warn "math2img: source file (", (stat $sourcePath)[9], ") is newer than image file (",
+# # (stat $tempPath)[9], ") so re-generating image\n" if $imageStale;
+# if (-e $tempPath) {
+# unlink $tempPath or die "Failed to delete stale math2img file $tempPath: $!";
+# }
+# dvipng(
+# $envir{dvipngTempDir}, $envir{externalLaTeXPath},
+# $envir{externalDvipngPath}, $tex, $tempPath
+# );
+# }
+#
+# if (-e $tempPath) {
+# return "<img align=\"middle\" src=\"$tempURL\" alt=\"$tex\">" if $mode eq "inline";
+# return "<div align=\"center\"><img src=\"$tempURL\" alt=\"$tex\"></div>" if $mode eq "display";
+# } else {
+# return "<b>[math2img failed]</b>";
+# # it might be nice to call tth here as a fallback instead:
+# #return tth($tex);
+# }
+# };
+#
+# =head2 [DEPRECATED] dvipng
+#
+# dvipng($working_directory, $latex_path, $dvipng_path, $tex_string, $target_path)
+#
+# This macro was used by the HTML_img display mode, which no longer exists.
+#
+# =cut
+#
+# # copied from IO.pm for backward compatibility with WeBWorK1.8;
+# # ^function dvipng
+# sub dvipng($$$$$) {
+# my (
+# $wd, # working directory, for latex and dvipng garbage
+# # (must already exist!)
+# $latex, # path to latex binary
+# $dvipng, # path to dvipng binary
+# $tex, # tex string representing equation
+# $targetPath # location of resulting image file
+# ) = @_;
+#
+# my $dvipngBroken = 0;
+#
+# my $texFile = "$wd/equation.tex";
+# my $dviFile = "$wd/equation.dvi";
+# my $dviFile2 = "$wd/equationequation.dvi";
+# my $dviCall = "equation";
+# my $pngFile = "$wd/equation1.png";
+#
+# unless (-e $wd) {
+# die "dvipng working directory $wd doesn't exist -- caller should have created it for us!\n";
+# return 0;
+# }
+#
+# # write the tex file
+# local *TEX;
+# open TEX, ">", $texFile or warn "Failed to create $texFile: $!";
+# print TEX <<'EOF';
+# % BEGIN HEADER
+# \batchmode
+# \documentclass[12pt]{article}
+# \usepackage{amsmath,amsfonts,amssymb}
+# \def\gt{>}
+# \def\lt{<}
+# \usepackage[active,textmath,displaymath]{preview}
+# \begin{document}
+# % END HEADER
+# EOF
+# print TEX "\\( \\displaystyle{$tex} \\)\n";
+# print TEX <<'EOF';
+# % BEGIN FOOTER
+# \end{document}
+# % END FOOTER
+# EOF
+# close TEX;
+#
+# # call latex
+# system "cd $wd && $latex $texFile > /dev/null"
+# and warn "Failed to call $latex with $texFile: $!";
+#
+# unless (-e $dviFile) {
+# warn "Failed to generate DVI file $dviFile";
+# return 0;
+# }
+#
+# if ($dvipngBroken) {
+# # change the name of the DVI file to get around dvipng's
+# # crackheadedness. This is no longer needed with the newest
+# # version of dvipng (10 something)
+# system "/bin/mv", $dviFile, $dviFile2;
+# }
+#
+# # call dvipng -- using warn instead of die passes some extra information
+# # back to the user the complete warning is still printed in the apache
+# # error log and a simple message (math2img failed) is returned to the
+# # webpage.
+# my $cmdout;
+# $cmdout = system "cd $wd && $dvipng $dviCall > /dev/null"
+# and warn "Failed to call$dvipng with $dviCall: $! with signal $cmdout";
+#
+# unless (-e $pngFile) {
+# warn "Failed to create PNG file $pngFile";
+# return 0;
+# }
+#
+# $cmdout = system "/bin/mv", $pngFile, $targetPath and warn "Failed to mv: /bin/mv $pngFile $targetPath $!. Call returned $cmdout. \n";
+# }
+#
# ----- ----- ----- -----
+#
+# =head2 alias
+#
+# # In HTML modes, returns the URL of a web-friendly version of the specified file.
+# # In TeX mode, returns the path to a TeX-friendly version of the specified file.
+# alias($pathToFile);
+#
+# alias allows you to refer to auxiliary files which are in a directory along with
+# the problem definition. In addition alias creates an EPS version of GIF or PNG
+# files when called in TeX mode.
+#
+# As a rule auxiliary files that are used by a number of problems in a course
+# should be placed in C<html/gif> or C<html> or in a subdirectory of the C<html>
+# directory, while auxiliary files which are used in only one problem should be
+# placed in the same directory as the problem in order to make the problem more
+# portable.
+#
+# =head3 Specific behavior of the alias macro
+#
+# =head4 Files in the html subdirectory
+#
+# =over
+#
+# =item When not in TeX mode
+#
+# If the file lies under the F<html> subdirectory, then the approriate URL for the
+# file is returned. Since the F<html> subdirectory is already accessible to the
+# webserver no other changes need to be made. The file path for this type of file
+# should be the complete file path. The path should start with the prefix defined
+# in $courseDirs{html_temp} in global.conf.
+#
+# =item When in TeX mode
+#
+# GIF and PNG files will be translated into EPS files and placed in the directory
+# F<tmp/eps>. The full path to this file is returned for use by TeX in producing
+# the hard copy. The conversion is done by a system dependent commands defined in
+# F<global.conf> $externalPrograms{gif2eps} (for GIF images) or
+# $externalPrograms{png2eps} (for PNG images). The URLs for the other files are
+# produced as in non-TeX mode but will of course not be usable to TeX.
+#
+# =back
+#
+# =head4 Files in the tmp subdirectory
+#
+# =over
+#
+# =item When not in TeX mode
+#
+# If the file lies under the F<tmp> subdirectory, then the approriate URL for the
+# file is created. Since the F<tmp> subdirectory is already accessible to the
+# webserver no other changes need to be made. The file path for this type of file
+# should be the complete file path. The path should start with the prefix defined
+# in $courseDirs{html_temp} in global.conf.
+#
+# =item When in TeX mode
+#
+# GIF and PNG files will be translated into EPS files and placed in the directory
+# F<tmp/eps>. The full path to this file is returned for use by TeX in producing
+# the hard copy. The conversion is done by a system dependent commands defined in
+# F<global.conf> $externalPrograms{gif2eps} (for GIF images) or
+# $externalPrograms{png2eps} (for PNG images). The URLs for the other files are
+# produced as in non-TeX mode but will of course not be usable to TeX.
+#
+# =back
+#
+# =head4 Files in the course template subdirectory
+#
+# =over
+#
+# =item When not in TeX mode
+#
+# If the file lies under the course templates subdirectory, it is assumed to lie
+# in subdirectory rooted in the directory containing the problem template file. An
+# alias is created under the F<html/tmp/gif> or F<html/tmp/html> directory and
+# linked to the original file. The file path for this type of file is a relative
+# path rooted at the directory containing the problem template file.
+#
+# =item When in TeX mode
+#
+# GIF and PNG files will be translated into EPS files and placed in the directory
+# F<tmp/eps>. The full path to this file is returned for use by TeX in producing
+# the hard copy. The conversion is done by a system dependent commands defined in
+# F<global.conf> $externalPrograms{gif2eps} (for GIF images) or
+# $externalPrograms{png2eps} (for PNG images). The URLs for the other files are
+# produced as in non-TeX mode but will of course not be usable to TeX.
+#
+# =back
+#
+# =cut
+#
+
+#
+# # Currently gif, html and types are supported.
+# #
+# # If the auxiliary file path has not extension then the extension .gif isassumed.
+# #
+# # If the auxiliary file path leads to a file in the ${Global::htmlDirectory}
+# # no changes are made to the file path.
+# #
+# # If the auxiliary file path is not complete, than it is assumed that it refers
+# # to a subdirectoy of the directory containing the problem..
+# #
+# # The output is either the correct URL for the file
+# # or (in TeX mode) the complete path to the eps version of the file
+# # and can be used as input into the image macro.
+# #
+# # surePathToTmpFile takes a path and outputs the complete path:
+# # ${main::htmlDirectory}/tmp/path
+# # It insures that all of the directories in the path have been created,
+# # but does not create the
+# # final file.
+#
+# # For postscript printing, alias generates an eps version of the gif image and places
+# # it in the directory eps. This slows down downloading postscript versions somewhat,
+# # but not excessivevly.
+# # Alias does not do any garbage collection, so files and alias may accumulate and
+# # need to be removed manually or by a reaper daemon.
+#
+# # This subroutine has commands which will not work on non-UNIX environments.
+# # system("cat $gifSourceFile | /usr/math/bin/giftopnm | /usr/math/bin/pnmdepth 1 | /usr/math/bin/pnmtops -noturn>$adr_output") &&
+#
+# # ^function alias
+# # ^uses %envir
+# # ^uses $envir{fileName}
+# # ^uses $envir{htmlDirectory}
+# # ^uses $envir{htmlURL}
+# # ^uses $envir{tempDirectory}
+# # ^uses $envir{tempURL}
+# # ^uses $envir{studentLogin}
+# # ^uses $envir{psvnNumber}
+# # ^uses $envir{setNumber}
+# # ^uses $envir{probNum}
+# # ^uses $envir{displayMode}
+# # ^uses $envir{externalGif2EpsPath}
+# # ^uses $envir{externalPng2EpsPath}
+# # ^uses &surePathToTmpFile
+# # ^uses &convertPath
+# # ^uses &directoryFromPath
+# # ^uses &fileFromPath
+# # ^uses $envir{texDisposition}
+
+# sub alias {
+# # input is a path to the original auxiliary file
+# my $envir = eval(q!\%main::envir!); # get the current root environment
+# my $fileName = $envir->{fileName};
+# my $htmlDirectory = $envir->{htmlDirectory};
+# my $htmlURL = $envir->{htmlURL};
+# my $tempDirectory = $envir->{tempDirectory};
+# my $tempURL = $envir->{tempURL};
+# my $studentLogin = $envir->{studentLogin};
+# my $psvnNumber = $envir->{psvnNumber};
+# my $setNumber = $envir->{setNumber};
+# my $probNum = $envir->{probNum};
+# my $displayMode ...
[truncated message content] |
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 02:08:58
|
Log Message:
-----------
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:
PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash
Modified Files:
--------------
pg/macros:
PGanswermacros.pl
PG.pl
Revision Data
-------------
Index: PG.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PG.pl,v
retrieving revision 1.40
retrieving revision 1.41
diff -Lmacros/PG.pl -Lmacros/PG.pl -u -r1.40 -r1.41
--- macros/PG.pl
+++ macros/PG.pl
@@ -1,6 +1,559 @@
+
+#use AnswerEvaluator;
+
+
+# provided by the translator
+# initialize PGcore and PGrandom
+
+
+ $main::VERSION ="WW2";
+
+sub _PG_init{
+ $main::VERSION ="WW2.9+";
+}
+sub not_null {PGcore::not_null(@_)};
+
+
+our $PG;
+
+sub DEBUG_MESSAGE {
+ $PG->append_debug_message(@_);
+}
+
+
+sub DOCUMENT {
+
+ # get environment
+ $rh_envir = \%envir; #KLUDGE FIXME
+ # warn "rh_envir is ",ref($rh_envir);
+ $PG = new PGcore($rh_envir, # can add key/value options to modify
+ );
+ $PG->clear_internal_debug_messages;
+
+ # initialize main:: variables
+
+ $ANSWER_PREFIX = $PG->{ANSWER_PREFIX};
+ $QUIZ_PREFIX = $PG->{QUIZ_PREFIX};
+ $showPartialCorrectAnswers = $PG->{PG_FLAGS}->{showPartialCorrectAnswers};
+ $showHint = $PG->{PG_FLAGS}->{showHint};
+ $solutionExists = $PG->{PG_FLAGS}->{solutionExists};
+ $hintExists = $PG->{PG_FLAGS}->{hintExists};
+ $pgComment = '';
+ %gifs_created = %{ $PG->{gifs_created}};
+ %external_refs = %{ $PG->{external_refs}};
+
+ @KEPT_EXTRA_ANSWERS =(); #temporary hack
+
+ my %envir = %$rh_envir;
+ $displayMode = $PG->{displayMode};
+ $PG_random_generator = $PG->{PG_random_generator};
+ # Save the file name for use in error messages
+ # Doesn't appear to be used FIXME
+# my ($callpkg,$callfile) = caller(0);
+# $envir{__files__}{$callfile} = $envir{templateDirectory}.$envir{fileName};
+
+ #no strict;
+ foreach my $var (keys %envir) {
+ PG_restricted_eval(qq!\$main::$var = \$envir{$var}!); #whew!! makes sure $var is interpolated but $main:: is evaluated at run time.
+ warn "Problem defining $var while initializing the PG problem: $@" if $@;
+ }
+ #use strict;
+ #FIXME
+ # load java script needed for displayModes
+ if ($envir{displayMode} eq 'HTML_jsMath') {
+ my $prefix = "";
+ if (!$envir{jsMath}{reportMissingFonts}) {
+ $prefix .= '<SCRIPT>noFontMessage = 1</SCRIPT>'."\n";
+ } elsif ($main::envir{jsMath}{missingFontMessage}) {
+ $prefix .= '<SCRIPT>missingFontMessage = "'.$main::envir{jsMath}{missingFontMessage}.'"</SCRIPT>'."\n";
+ }
+ $prefix .= '<SCRIPT>processDoubleClicks = '.($main::envir{jsMath}{processDoubleClicks}?'1':'0')."</SCRIPT>\n";
+ TEXT(
+ $prefix,
+ '<SCRIPT SRC="'.$envir{jsMathURL}. '"></SCRIPT>' . "\n" ,
+ '<NOSCRIPT><CENTER><FONT COLOR="#CC0000">' ,
+ "$BBOLD", 'Warning: the mathematics on this page requires JavaScript.', ,$BR,
+ 'If your browser supports it, be sure it is enabled.',
+ "$EBOLD",
+ '</FONT></CENTER><p>
+ </NOSCRIPT>'
+ );
+ TEXT('<SCRIPT>jsMath.Setup.Script("plugins/noImageFonts.js")</SCRIPT>')
+ if ($envir{jsMath}{noImageFonts});
+ } elsif ($envir{displayMode} eq 'HTML_asciimath') {
+ TEXT('<SCRIPT SRC="'.$main::envir{asciimathURL}.'"></SCRIPT>' . "\n" ,
+ '<SCRIPT>mathcolor = "black"</SCRIPT>' );
+ } elsif ($envir{displayMode} eq 'HTML_LaTeXMathML') {
+ TEXT('<SCRIPT SRC="'.$envir{LaTeXMathMLURL}.'"></SCRIPT>'."\n");
+
+ }
+
+}
+$main::displayMode = $PG->{displayMode};
+$main::PG = $PG;
+sub TEXT {
+ $PG->TEXT(@_) ;
+}
+
+sub HEADER_TEXT {
+ $PG->HEADER_TEXT(@_);
+}
+
+sub LABELED_ANS {
+ $PG->LABELED_ANS(@_); # returns pointer to the labeled answer group
+}
+
+sub NAMED_ANS {
+ $PG->LABELED_ANS(@_); # returns pointer to the labeled answer group
+}
+
+sub ANS {
+ #warn "using PGnew for ANS";
+ $PG->ANS(@_); # returns pointer to the labeled answer group
+}
+
+sub RECORD_ANS_NAME {
+ $PG->record_ans_name(@_);
+}
+
+sub inc_ans_rule_count {
+ #$PG->{unlabeled_answer_blank_count}++;
+ #my $num = $PG->{unlabeled_answer_blank_count};
+ DEBUG_MESSAGE( " using PG to inc_ans_rule_count = $num ", caller(2));
+ warn " using PG to inc_ans_rule_count = $num ", caller(2);
+ $PG->{unlabeled_answer_blank_count};
+}
+sub ans_rule_count {
+ $PG->{unlabeled_answer_blank_count};
+}
+sub NEW_ANS_NAME {
+ return "" if $PG_STOP_FLAG;
+ #my $number=shift;
+ # we have an internal count so the number not actually used.
+ my $name =$PG->record_unlabeled_ans_name();
+ $name;
+}
+sub NEW_ARRAY_NAME {
+ return "" if $PG_STOP_FLAG;
+ my $name =$PG->record_unlabeled_array_name();
+ $name;
+}
+
+# new subroutine
+sub NEW_ANS_BLANK {
+ return "" if $PG_STOP_FLAG;
+ $PG->record_unlabeled_ans_name(@_);
+}
+
+sub ANS_NUM_TO_NAME {
+ $PG->new_label(@_); # behaves as in PG.pl
+}
+
+sub store_persistent_data {
+ $PG->store_persistent_data(@_); #needs testing
+}
+sub RECORD_FORM_LABEL { # this stores form data (such as sticky answers), but does nothing more
+ # it's a bit of hack since we are storing these in the
+ # KEPT_EXTRA_ANSWERS queue even if they aren't answers per se.
+ warn "Using RECORD_FORM_LABEL -- deprecated?";
+ RECORD_EXTRA_ANSWERS(@_);
+}
+
+sub RECORD_EXTRA_ANSWERS {
+ return "" if $PG_STOP_FLAG;
+ my $label = shift; # the label of the input box or textarea
+ eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes
+ $label;
+
+}
+
+
+sub NEW_ANS_ARRAY_NAME { # this keeps track of the answers within an array which are entered implicitly,
+ # rather than with a specific label
+ return "" if $PG_STOP_FLAG;
+ my $number=shift;
+ $main::vecnum = -1;
+ my $row = shift;
+ my $col = shift;
+# my $array_ans_eval_label = "ArRaY"."$number"."__"."$vecnum".":";
+ my $label = $PG->{QUIZ_PREFIX}.$PG->{ARRAY_PREFIX}."$number"."__"."$vecnum".":"."$row".":"."$col"."__";
+# my $response_group = new PGresponsegroup($label,undef);
+# $PG->record_ans_name($array_ans_eval_label, $response_group);
+# What does vecnum do?
+# The name is simply so that it won't conflict when placed on the HTML page
+# my $array_label = shift;
+ $PG->record_array_name($label); # returns $array_label, $ans_label
+}
+
+sub NEW_ANS_ARRAY_NAME_EXTENSION {
+ NEW_ANS_ARRAY_ELEMENT_NAME(@_);
+}
+
+sub NEW_ANS_ARRAY_ELEMENT_NAME { # creates a new array element answer name and records it
+
+ return "" if $PG_STOP_FLAG;
+ my $number=shift;
+ my $row_num = shift;
+ my $col_num = shift;
+ if( $row_num == 0 && $col_num == 0 ){
+ $main::vecnum += 1;
+ }
+# my $ans_label = "ArRaY".sprintf("%04u", $number);
+ my $ans_label = $PG->new_array_label($number);
+ my $element_ans_label = $PG->new_array_element_label($ans_label,$row_num, $col_num,vec_num=>$vecnum);
+ my $response = new PGresponsegroup($ans_label,$element_ans_label, undef);
+ $PG->extend_ans_group($ans_label,$response);
+ $element_ans_label;
+}
+sub NEW_LABELED_ANS_ARRAY { #not in PG_original
+ my $ans_label = shift;
+ my @response_list = @_;
+ #$PG->extend_ans_group($ans_label,@response_list);
+ $PG->{PG_ANSWERS_HASH}->{$ans_label}->insert_responses(@response_list);
+ # should this return an array of labeled answer blanks???
+}
+sub EXTEND_ANS_ARRAY { #not in PG_original
+ my $ans_label = shift;
+ my @response_list = @_;
+ #$PG->extend_ans_group($ans_label,@response_list);
+ $PG->{PG_ANSWERS_HASH}->{$ans_label}->append_responses(@response_list);
+}
+sub CLEAR_RESPONSES {
+ my $ans_label = shift;
+# my $response_label = shift;
+# my $ans_value = shift;
+ if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
+ my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
+ if ( ref($responsegroup) ) {
+ $responsegroup->clear;
+ } else {
+ $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response} = new PGresponsegroup($label);
+ }
+ }
+ '';
+}
+sub INSERT_RESPONSE {
+ my $ans_label = shift;
+ my $response_label = shift;
+ my $ans_value = shift;
+ my $selected = shift;
+ # warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value";
+ if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
+ my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
+ $responsegroup->append_response($response_label, $ans_value, $selected);
+ #warn "\n$responsegroup responses are now ", $responsegroup->responses;
+ }
+ '';
+}
+
+sub EXTEND_RESPONSE { # for radio buttons and checkboxes
+ my $ans_label = shift;
+ my $response_label = shift;
+ my $ans_value = shift;
+ my $selected = shift;
+ # warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value";
+ if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) {
+ my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response};
+ $responsegroup->extend_response($response_label, $ans_value,$selected);
+ warn "\n$responsegroup responses are now ", pretty_print($response_group);
+ }
+ '';
+}
+sub ENDDOCUMENT {
+ # check that answers match
+ # gather up PG_FLAGS elements
+
+
+ my @elements = qw(showPartialCorrectAnswers
+ recordSubmittedAnswers refreshCachedImages
+ hintExists solutionExists
+ );
+ while (@elements) {
+ my $var= shift @elements;
+ $PG->{PG_FLAGS}->{$var} = ${$var};
+ }
+ $PG->{PG_FLAGS}->{comment} = $pgComment; #KLUDGE #FIXME
+ $PG->{PG_FLAGS}->{showHintLimit} = $showHint; #KLUDGE #FIXME
+
+
+ # install problem grader
+ if (defined($PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE}) ) {
+ # problem grader defined within problem -- no further action needed
+ } elsif ( defined( $rh_envir->{PROBLEM_GRADER_TO_USE} ) ) {
+ if (ref($rh_envir->{PROBLEM_GRADER_TO_USE}) eq 'CODE' ) { # user defined grader
+ $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = $rh_envir->{PROBLEM_GRADER_TO_USE};
+ } elsif ($rh_envir->{PROBLEM_GRADER_TO_USE} eq 'std_problem_grader' ) {
+ if (defined(&std_problem_grader) ){
+ $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
+ } # std_problem_grader is the default in any case so don't give a warning.
+ } elsif ($rh_envir->{PROBLEM_GRADER_TO_USE} eq 'avg_problem_grader' ) {
+ if (defined(&avg_problem_grader) ){
+ $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = \&avg_problem_grader; # defined in PGanswermacros.pl
+ }
+ } else {
+ warn "Error: ". $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} . "is not a known program grader.";
+ }
+ } elsif (defined(&std_problem_grader)) {
+ $PG->{PG_FLAGS}->{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
+ } else {
+ # PGtranslator will install its default problem grader
+ }
+
+ # add javaScripts
+ if ($rh_envir->{displayMode} eq 'HTML_jsMath') {
+ TEXT('<SCRIPT> jsMath.wwProcess() </SCRIPT>');
+ } elsif ($rh_envir->{displayMode} eq 'HTML_asciimath') {
+ TEXT('<SCRIPT> translate() </SCRIPT>');
+ my $STRING = join("", @{$PG->{HEADER_ARRAY} });
+ unless ($STRING =~ m/mathplayer/) {
+ HEADER_TEXT('<object id="mathplayer" classid="clsid:32F66A20-7614-11D4-BD11-00104BD3F987">' . "\n" .
+ '</object><?import namespace="mml" implementation="#mathplayer"?>'
+ );
+ }
+
+ }
+ TEXT( MODES(%{$rh_envir->{problemPostamble}}) );
+
+
+
+
+
+ @PG_ANSWERS=();
+
+ #warn keys %{ $PG->{PG_ANSWERS_HASH} };
+ @PG_ANSWER_ENTRY_ORDER = ();
+ my $ans_debug = 0;
+ foreach my $key (keys %{ $PG->{PG_ANSWERS_HASH} }) {
+ $answergroup = $PG->{PG_ANSWERS_HASH}->{$key};
+ #warn "$key is defined =", defined($answergroup), "PG object is $PG";
+ #################
+ # EXTRA ANSWERS KLUDGE
+ #################
+ # The first response in each answer group is placed in @PG_ANSER_ENTRY_ORDER and %PG_ANSWERS_HASH
+ # The remainder of the response keys are placed in the EXTRA ANSWERS ARRAY
+ if (defined($answergroup)) {
+ my @response_keys = $answergroup->{response}->response_labels;
+ warn pretty_print($answergroup->{response}) if $ans_debug==1;
+ my $response_key = shift @response_keys;
+ #unshift @response_keys, $response_key unless ($response_key eq $answer_group->{ans_label});
+ # don't save the first response key if it is the same as the ans_label
+ # maybe we should insure that the first response key is always the same as the answer label?
+ # even if no answer blank is printed for it? or a hidden answer blank?
+ # this is still a KLUDGE
+ # for compatibility the first response key is closer to the old method than the $ans_label
+ # this is because a response key might indicate an array but an answer label won't
+ push @PG_ANSWERS, $response_key,$answergroup->{ans_eval};
+ push @PG_ANSWER_ENTRY_ORDER, $response_key;
+ push @KEPT_EXTRA_ANSWERS, @response_keys;
+ } else {
+ #warn "$key is ", join("|",%{$PG->{PG_ANSWERS_HASH}->{$key}});
+ }
+ }
+ push @KEPT_EXTRA_ANSWERS, keys %{$PG->{PERSISTENCE_HASH}};
+ my %PG_ANSWERS_HASH = @PG_ANSWERS;
+ $PG->{PG_FLAGS}->{KEPT_EXTRA_ANSWERS} = \@KEPT_EXTRA_ANSWERS;
+ $PG->{PG_FLAGS}->{ANSWER_ENTRY_ORDER} = \@PG_ANSWER_ENTRY_ORDER;
+ warn "KEPT_EXTRA_ANSWERS", join(" ", @KEPT_EXTRA_ANSWERS), $BR if $ans_debug==1;
+ warn "PG_ANSWER_ENTRY_ORDER",join(" ",@PG_ANSWER_ENTRY_ORDER), $BR if $ans_debug==1;
+ warn "DEBUG messages", join( "$BR",@{$PG->get_debug_messages} ) if $ans_debug==1;
+ warn "INTERNAL_DEBUG messages", join( "$BR",@{$PG->get_internal_debug_messages} ) if $ans_debug==1;
+ $STRINGforOUTPUT = join("", @{$PG->{OUTPUT_ARRAY} });
+
+
+ $STRINGforHEADER_TEXT = join("", @{$PG->{HEADER_ARRAY} });
+
+ # warn pretty_print($PG->{PG_ANSWERS_HASH});
+ #warn "printing another warning";
+
+ (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT,\%PG_ANSWERS_HASH, $PG->{PG_FLAGS} , $PG );
+}
+################################################################################
+#
+# macros from dangerousMacros
+#
+################################################################################
+sub alias {
+ #warn "alias called ",@_;
+ $PG->{PG_alias}->make_alias(@_) ;
+}
+sub insertGraph {
+ $PG->insertGraph(@_);
+}
+
+sub findMacroFile {
+ $PG->{PG_alias}->findMacroFile(@_);
+}
+sub check_url {
+ $PG->{PG_alias}->check_url(@_);
+}
+sub findAppletCodebase {
+ $PG->{PG_alias}->findAppletCodebase(@_);
+}
+
+sub loadMacros {
+ $PG->{PG_loadMacros}->loadMacros(@_);
+}
+# FIXME? these were taken from the former dangerousMacros.pl file and might have issues when placed here.
+#
+# Some constants that can be used in perl experssions
+#
+
+# ^function i
+# ^uses $_parser_loaded
+# ^uses &Complex::i
+# ^uses &Value::Package
+sub i () {
+ # check if Parser.pl is loaded, otherwise use Complex package
+ if (!eval(q!$main::_parser_loaded!)) {return Complex::i}
+ return Value->Package("Formula")->new('i')->eval;
+}
+
+# ^function j
+# ^uses $_parser_loaded
+# ^uses &Value::Package
+sub j () {
+ if (!eval(q!$main::_parser_loaded!)) {return 'j'}
+ Value->Package("Formula")->new('j')->eval;
+}
+
+# ^function k
+# ^uses $_parser_loaded
+# ^uses &Value::Package
+sub k () {
+ if (!eval(q!$main::_parser_loaded!)) {return 'k'}
+ Value->Package("Formula")->new('k')->eval;
+}
+
+# ^function pi
+# ^uses &Value::Package
+sub pi () {Value->Package("Formula")->new('pi')->eval}
+
+# ^function Infinity
+# ^uses &Value::Package
+sub Infinity () {Value->Package("Infinity")->new()}
+
+
+# ^function abs
+# ^function sqrt
+# ^function exp
+# ^function log
+# ^function sin
+# ^function cos
+# ^function atan2
+#
+# Allow these functions to be overridden
+# (needed for log() to implement $useBaseTenLog)
+#
+use subs 'abs', 'sqrt', 'exp', 'log', 'sin', 'cos', 'atan2';
+sub abs($) {return CORE::abs($_[0])};
+sub sqrt($) {return CORE::sqrt($_[0])};
+sub exp($) {return CORE::exp($_[0])};
+sub log($) {return CORE::log($_[0])};
+sub sin($) {return CORE::sin($_[0])};
+sub cos($) {return CORE::cos($_[0])};
+sub atan2($$) {return CORE::atan2($_[0],$_[1])};
+
+sub Parser::defineLog {eval {sub log($) {CommonFunction->Call("log",@_)}}};
+=head2 Filter utilities
+
+These two subroutines can be used in filters to set default options. They
+help make filters perform in uniform, predictable ways, and also make it
+easy to recognize from the code which options a given filter expects.
+
+
+=head4 assign_option_aliases
+
+Use this to assign aliases for the standard options. It must come before set_default_options
+within the subroutine.
+
+ assign_option_aliases(\%options,
+ 'alias1' => 'option5'
+ 'alias2' => 'option7'
+ );
+
+
+If the subroutine is called with an option " alias1 => 23 " it will behave as if it had been
+called with the option " option5 => 23 "
+
+=cut
+
+
+# ^function assign_option_aliases
+sub assign_option_aliases {
+ my $rh_options = shift;
+ warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
+ my @option_aliases = @_;
+ while (@option_aliases) {
+ my $alias = shift @option_aliases;
+ my $option_key = shift @option_aliases;
+
+ if (defined($rh_options->{$alias} )) { # if the alias appears in the option list
+ if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined,
+ $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value
+ # the FIRST alias for a given option takes precedence
+ # (after the option itself)
+ } else {
+ warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
+ "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
+ " was ignored.";
+ }
+ }
+ delete($rh_options->{$alias}); # remove the alias from the initial list
+ }
+
+}
+
+=head4 set_default_options
+
+ set_default_options(\%options,
+ '_filter_name' => 'filter',
+ 'option5' => .0001,
+ 'option7' => 'ascii',
+ 'allow_unknown_options => 0,
+ }
+
+Note that the first entry is a reference to the options with which the filter was called.
+
+The option5 is set to .0001 unless the option is explicitly set when the subroutine is called.
+
+The B<'_filter_name'> option should always be set, although there is no error if it is missing.
+It is used mainly for debugging answer evaluators and allows
+you to keep track of which filter is currently processing the answer.
+
+If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the
+set_default_options list an error will be signaled and a warning message will be printed out. This provides
+error checking against misspelling an option and is generally what is desired for most filters.
+
+Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance,
+but only uses a subset of the options
+provided. In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled.
+
+=cut
+
+# ^function set_default_options
+# ^uses pretty_print
+sub set_default_options {
+ my $rh_options = shift;
+ warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
+ my %default_options = @_;
+ unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
+ foreach my $key1 (keys %$rh_options) {
+ warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
+ }
+ }
+ foreach my $key (keys %default_options) {
+ if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) {
+ $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define
+ # this key unless tol is explicitly defined.
+ }
+ }
+}
+1;
+__END__
+
################################################################################
# WeBWorK Online Homework Delivery System
-# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
# $CVSHeader$
#
# This program is free software; you can redistribute it and/or modify it under
@@ -93,195 +646,8 @@
The HEADER_TEXT(), TEXT(), and ANS() macros add to the header text string,
body text string, and answer evaluator queue, respectively.
-=cut
-
-BEGIN {
- be_strict();
-}
-
-sub _PG_init{
-
-}
-
-#package PG;
-
-# Private variables for the PG.pl file.
-
-# ^variable my $STRINGforOUTPUT
-my $STRINGforOUTPUT;
-# ^variable my $STRINGforHEADER_TEXT
-my $STRINGforHEADER_TEXT;
-# ^variable my @PG_ANSWERS
-my @PG_ANSWERS;
-# ^variable my @PG_UNLABELED_ANSWERS
-my @PG_UNLABELED_ANSWERS;
-# ^variable my %PG_ANSWERS_HASH
-my %PG_ANSWERS_HASH;
-
-# ^variable our $PG_STOP_FLAG
-our $PG_STOP_FLAG;
-
-# my variables are unreliable if two DOCUMENTS were to be called before an ENDDOCUMENT
-# there could be conflicts. As I understand the behavior of the Apache child
-# this cannot occur -- a child finishes with one request before obtaining the next
-
-################################################################################
-
-=head1 MACROS
-
-These macros may be used from PG problem files.
-
=over
-=item DOCUMENT()
-
-DOCUMENT() should be the first statement in each problem template. It can
-only be used once in each problem.
-
-DOCUMENT() initializes some empty variables and unpacks the variables in the
-%envir hash which is implicitly passed from WeBWorK to the problem. It must be
-the first statement in any problem. It also unpacks any answers submitted and
-places them in the @submittedAnswer list, saves the problem seed in
-$PG_original_problemSeed in case you need it later, and initializes the pseudo
-random number generator object in $PG_random_generator.
-
-You can reset the standard number generator using the command:
-
- $PG_random_generator->srand($new_seed_value);
-
-See also SRAND() in the L<PGbasicmacros.pl> file.
-
-=cut
-
-# ^function DOCUMENT
-# ^uses $STRINGforOUTPUT
-# ^uses $STRINGforHEADER_TEXT
-# ^uses @PG_ANSWERS
-# ^uses $PG_STOP_FLAG
-# ^uses @PG_UNLABELED_ANSWERS
-# ^uses %PG_ANSWERS_HASH
-# ^uses @PG_ANSWER_ENTRY_ORDER
-# ^uses $ANSWER_PREFIX
-# ^uses %PG_FLAGS
-# ^uses $showPartialCorrectAnswers
-# ^uses $showHints
-# ^uses $solutionExists
-# ^uses $hintExists
-# ^uses $pgComment
-# ^uses %gifs_created
-# ^uses %envir
-# ^uses $refSubmittedAnswers
-# ^uses @submittedAnswers
-# ^uses $PG_original_problemSeed
-# ^uses $problemSeed
-# ^uses $PG_random_generator
-# ^uses $ans_rule_count
-# ^uses $QUIZ_PREFIX
-# (Also creates a package scalar named after each key in %envir containing a copy of the corresponding value.)
-# ^uses &PGrandom::new
-sub DOCUMENT {
-
- $STRINGforOUTPUT ="";
- $STRINGforHEADER_TEXT ="";
- @PG_ANSWERS=();
- $PG_STOP_FLAG=0;
- @PG_UNLABELED_ANSWERS = ();
- %PG_ANSWERS_HASH = ();
- # FIXME: We are initializing these variables into both Safe::Root1 (the cached safe compartment)
- # and Safe::Root2 (the current one)
- # There is a good chance they won't be properly updated in one or the other of these compartments.
-
-
-# @main::PG_ANSWER_ENTRY_ORDER = ();
-# $main::ANSWER_PREFIX = 'AnSwEr';
-# %main::PG_FLAGS=(); #global flags
-# $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers );
-# $main::showHint = 1 unless defined($main::showHint);
-# $main::solutionExists =0;
-# $main::hintExists =0;
-# %main::gifs_created = ();
- eval(q!
- # set perl to use capital E for scientific notation: e.g. 5.4E-05 instead of 5.4e-05
- # $#="%G"; #FIXME -- this causes bad warnings in perl 5.10
-
- @main::PG_ANSWER_ENTRY_ORDER = ();
- $main::ANSWER_PREFIX = 'AnSwEr';
- %main::PG_FLAGS=(); #global flags
- $main::showPartialCorrectAnswers = 0 unless defined($main::showPartialCorrectAnswers );
- $main::showHint = 1 unless defined($main::showHint);
- $main::solutionExists =0;
- $main::hintExists =0;
- $main::pgComment = '';
- %main::gifs_created = ();
-
- !);
-# warn eval(q! "PG.pl: The envir variable $main::{envir} is".join(" ",%main::envir)!);
- my $rh_envir = eval(q!\%main::envir!);
- my %envir = %$rh_envir;
-
- # Save the file name for use in error messages
- my ($callpkg,$callfile) = caller(0);
- $envir{__files__}{$callfile} = $envir{templateDirectory}.$envir{fileName};
-
- #no strict;
- foreach my $var (keys %envir) {
- eval(q!$main::!.$var.q! = $main::envir{!.$var.q!}! ); #whew!! makes sure $var is interpolated but $main:: is evaluated at run time.
- # warn eval(q! "var $var is defined ". $main::!.$var);
- warn "Problem defining ", q{\$main::}.$var, " while initializing the PG problem: $@" if $@;
- }
- #use strict;
- #FIXME these strict pragmas don't seem to be needed and they cause trouble in perl 5.6.0
-
-
-
- eval(q!
- @main::submittedAnswers = @{$main::refSubmittedAnswers} if defined($main::refSubmittedAnswers);
- $main::PG_original_problemSeed = $main::problemSeed;
- $main::PG_random_generator = new PGrandom($main::problemSeed) || die "Can't create random number generator.";
- $main::ans_rule_count = 0; # counts questions
-
- # end unpacking of environment variables.
- $main::QUIZ_PREFIX = '' unless defined($main::QUIZ_PREFIX)
-
- !);
-# @main::submittedAnswers = @{$main::refSubmittedAnswers} if defined($main::refSubmittedAnswers);
-# $main::PG_original_problemSeed = $main::problemSeed;
-# $main::PG_random_generator = new PGrandom($main::problemSeed) || die "Can't create random number generator.";
-# $main::ans_rule_count = 0; # counts questions
-
- # end unpacking of environment variables.
-# $main::QUIZ_PREFIX = '' unless defined($main::QUIZ_PREFIX)
-
- if ($main::envir{displayMode} eq 'HTML_jsMath') {
- my $prefix = "";
- if (!$main::envir{jsMath}{reportMissingFonts}) {
- $prefix .= '<SCRIPT>noFontMessage = 1</SCRIPT>'."\n";
- } elsif ($main::envir{jsMath}{missingFontMessage}) {
- $prefix .= '<SCRIPT>missingFontMessage = "'.$main::envir{jsMath}{missingFontMessage}.'"</SCRIPT>'."\n";
- }
- $prefix .= '<SCRIPT>processDoubleClicks = '.($main::envir{jsMath}{processDoubleClicks}?'1':'0')."</SCRIPT>\n";
- $STRINGforOUTPUT =
- $prefix .
- '<SCRIPT SRC="'.$main::envir{jsMathURL}.'"></SCRIPT>' . "\n" .
- '<NOSCRIPT><CENTER><FONT COLOR="#CC0000">' .
- '<B>Warning: the mathematics on this page requires JavaScript.<BR>' .
- 'If your browser supports it, be sure it is enabled.</B>'.
- '</FONT></CENTER><p></NOSCRIPT>' .
- $STRINGforOUTPUT;
- $STRINGforOUTPUT .=
- '<SCRIPT>jsMath.Setup.Script("plugins/noImageFonts.js")</SCRIPT>'
- if ($main::envir{jsMath}{noImageFonts});
- }
-
- $STRINGforOUTPUT = '<SCRIPT SRC="'.$main::envir{asciimathURL}.'"></SCRIPT>' . "\n" .
- '<SCRIPT>mathcolor = "black"</SCRIPT>' . $STRINGforOUTPUT
- if ($main::envir{displayMode} eq 'HTML_asciimath');
-
- $STRINGforOUTPUT = '<SCRIPT SRC="'.$main::envir{LaTeXMathMLURL}.'"></SCRIPT>'."\n" . $STRINGforOUTPUT
- if ($main::envir{displayMode} eq 'HTML_LaTeXMathML');
-
-}
-
=item HEADER_TEXT()
HEADER_TEXT("string1", "string2", "string3");
@@ -296,14 +662,7 @@
introduced between the existing content of the header text string and the new
content being appended.
-=cut
-# ^function HEADER_TEXT
-# ^uses $STRINGforHEADER_TEXT
-sub HEADER_TEXT {
- my @in = @_;
- $STRINGforHEADER_TEXT .= join(" ",@in);
- }
=item TEXT()
@@ -326,16 +685,7 @@
introduced between the existing content of the header text string and the new
content being appended.
-=cut
-# ^function TEXT
-# ^uses $PG_STOP_FLAG
-# ^uses $STRINGforOUTPUT
-sub TEXT {
- return "" if $PG_STOP_FLAG;
- my @in = @_;
- $STRINGforOUTPUT .= join(" ",@in);
-}
=item ANS()
@@ -352,21 +702,7 @@
evaluator generator such as the cmp() method of MathObjects or the num_cmp()
macro in L<PGanswermacros.pl>.
-=cut
-# ^function ANS
-# ^uses $PG_STOP_FLAG
-# ^uses @PG_ANSWERS
-sub ANS{
- return "" if $PG_STOP_FLAG;
- my @in = @_;
- while (@in ) {
- warn("<BR><B>Error in ANS:$in[0]</B> -- inputs must be references to
- subroutines<BR>")
- unless ref($in[0]);
- push(@PG_ANSWERS, shift @in );
- }
-}
=item LABELED_ANS()
@@ -378,35 +714,8 @@
order entered. This allows pairing of answer evaluators and answer rules that
may not have been entered in the same order.
-=cut
-
-# ^function LABELED_ANS
-# ^uses &NAMED_ANS
-sub LABELED_ANS {
- &NAMED_ANS;
-}
-
-=item NAMED_ANS()
-Old name for LABELED_ANS(). DEPRECATED.
-
-=cut
-# ^function NAMED_ANS
-# ^uses $PG_STOP_FLAG
-sub NAMED_ANS{
- return "" if $PG_STOP_FLAG;
- my @in = @_;
- while (@in ) {
- my $label = shift @in;
- $label = eval(q!$main::QUIZ_PREFIX.$label!);
- my $ans_eval = shift @in;
- TEXT("<BR><B>Error in NAMED_ANS:$in[0]</B>
- -- inputs must be references to subroutines<BR>")
- unless ref($ans_eval);
- $PG_ANSWERS_HASH{$label}= $ans_eval;
- }
-}
=item STOP_RENDERING()
@@ -415,14 +724,7 @@
Temporarily suspends accumulation of problem text and storing of answer blanks
and answer evaluators until RESUME_RENDERING() is called.
-=cut
-# ^function STOP_RENDERING
-# ^uses $PG_STOP_FLAG
-sub STOP_RENDERING {
- $PG_STOP_FLAG=1;
- "";
-}
=item RESUME_RENDERING()
@@ -431,14 +733,7 @@
Resumes accumulating problem text and storing answer blanks and answer
evaluators. Reverses the effect of STOP_RENDERING().
-=cut
-# ^function RESUME_RENDERING
-# ^uses $PG_STOP_FLAG
-sub RESUME_RENDERING {
- $PG_STOP_FLAG=0;
- "";
-}
=item ENDDOCUMENT()
@@ -449,7 +744,8 @@
be the last executable statement of every problem. It can only appear once. It
returns a list consisting of:
-=over
+
+
=item *
@@ -468,7 +764,7 @@
A reference to a hash containing various flags:
-=over
+
=item *
@@ -532,85 +828,9 @@
=back
-=back
-
-=cut
-
-# ^function ENDDOCUMENT
-# ^uses @PG_UNLABELED_ANSWERS
-# ^uses %PG_ANSWERS_HASH
-# ^uses @PG_ANSWERS
-sub ENDDOCUMENT {
- my $index=0;
- foreach my $label (@PG_UNLABELED_ANSWERS) {
- if ( defined($PG_ANSWERS[$index]) ) {
- $PG_ANSWERS_HASH{"$label"}= $PG_ANSWERS[$index];
- #warn "recording answer label = $label";
- } else {
- warn "No answer provided by instructor for answer $label";
- }
- $index++;
- }
- $STRINGforOUTPUT .="\n";
- eval q{ #make sure that "main" points to the current safe compartment by evaluating these lines.
- $main::PG_FLAGS{'showPartialCorrectAnswers'} = $main::showPartialCorrectAnswers;
- $main::PG_FLAGS{'recordSubmittedAnswers'} = $main::recordSubmittedAnswers;
- $main::PG_FLAGS{'refreshCachedImages'} = $main::refreshCachedImages;
- $main::PG_FLAGS{'comment'} = $main::pgComment;
- $main::PG_FLAGS{'hintExists'} = $main::hintExists;
- $main::PG_FLAGS{'showHintLimit'} = $main::showHint;
- $main::PG_FLAGS{'solutionExists'} = $main::solutionExists;
- $main::PG_FLAGS{ANSWER_ENTRY_ORDER} = \@main::PG_ANSWER_ENTRY_ORDER;
- $main::PG_FLAGS{KEPT_EXTRA_ANSWERS} = \@main::KEPT_EXTRA_ANSWERS;##need to keep array labels that don't call "RECORD_ANS_NAME"
- $main::PG_FLAGS{ANSWER_PREFIX} = $main::ANSWER_PREFIX;
- # install problem grader
- if (defined($main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) ) {
- # problem grader defined within problem -- no further action needed
- } elsif ( defined( $main::envir{PROBLEM_GRADER_TO_USE} ) ) {
- if (ref($main::envir{PROBLEM_GRADER_TO_USE}) eq 'CODE' ) { # user defined grader
- $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = $main::envir{PROBLEM_GRADER_TO_USE};
- } elsif ($main::envir{PROBLEM_GRADER_TO_USE} eq 'std_problem_grader' ) {
- if (defined(&std_problem_grader) ){
- $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
- } # std_problem_grader is the default in any case so don't give a warning.
- } elsif ($main::envir{PROBLEM_GRADER_TO_USE} eq 'avg_problem_grader' ) {
- if (defined(&avg_problem_grader) ){
- $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&avg_problem_grader; # defined in PGanswermacros.pl
- }
- #else { # avg_problem_grader will be installed by PGtranslator so there is no need for a warning.
- # warn "The problem grader 'avg_problem_grader' has not been defined. Has PGanswermacros.pl been loaded?";
- #}
- } else {
- warn "Error: $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} is not a known program grader.";
- }
- } elsif (defined(&std_problem_grader)) {
- $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = \&std_problem_grader; # defined in PGanswermacros.pl
- } else {
- # PGtranslator will install its default problem grader
- }
-
- warn "ERROR: The problem grader is not a subroutine" unless ref( $main::PG_FLAGS{PROBLEM_GRADER_TO_USE}) eq 'CODE'
- or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'std_problem_grader'
- or $main::PG_FLAGS{PROBLEM_GRADER_TO_USE} = 'avg_problem_grader';
- # return results
- };
-
- $STRINGforOUTPUT .= '<SCRIPT> jsMath.wwProcess() </SCRIPT>'
- if ($main::envir{displayMode} eq 'HTML_jsMath');
-
- if ($main::envir{displayMode} eq 'HTML_asciimath') {
- $STRINGforOUTPUT .= '<SCRIPT> translate() </SCRIPT>';
- $STRINGforHEADER_TEXT .=
- '<object id="mathplayer" classid="clsid:32F66A20-7614-11D4-BD11-00104BD3F987">' . "\n" .
- '</object><?import namespace="mml" implementation="#mathplayer"?>'
- unless ($STRINGforHEADER_TEXT =~ m/mathplayer/);
- }
- $STRINGforOUTPUT .= MODES(%{PG_restricted_eval('$main::problemPostamble')});
-
- (\$STRINGforOUTPUT, \$STRINGforHEADER_TEXT,\%PG_ANSWERS_HASH,eval(q!\%main::PG_FLAGS!));
-}
+=cut
################################################################################
@@ -624,7 +844,7 @@
=item inc_ans_rule_count()
- NEW_ANS_NAME(inc_ans_rule_count());
+ NEW_ANS_NAME();
Increments the internal count of the number of answer blanks that have been
defined ($ans_rule_count) and returns the new count. This should only be used
@@ -632,55 +852,25 @@
=cut
-# ^function inc_ans_rule_count
-# ^uses $ans_rule_count
-sub inc_ans_rule_count {
- eval(q!++$main::ans_rule_count!); # evalute at runtime to get correct main::
-}
-
=item RECORD_ANS_NAME()
- RECORD_ANS_NAME("label");
+ RECORD_ANS_NAME("label", "VALUE");
Records the label for an answer blank. Used internally by L<PGbasicmacros.pl>
to record the order of explicitly-labelled answer blanks.
=cut
-# ^function RECORD_ANS_NAME
-# ^uses $PG_STOP_FLAG
-# ^uses @PG_ANSWER_ENTRY_ORDER
-sub RECORD_ANS_NAME {
- return "" if $PG_STOP_FLAG;
- my $label = shift;
- eval(q!push(@main::PG_ANSWER_ENTRY_ORDER, $label)!);
- $label;
-}
-
=item NEW_ANS_NAME()
- NEW_ANS_NAME($num);
+ NEW_ANS_NAME();
-Generates an answer label from the supplied answer number. The label is
+Generates an anonymous answer label from the internal count The label is
added to the list of implicity-labeled answers. Used internally by
L<PGbasicmacros.pl> to generate labels for unlabeled answer blanks.
=cut
-# ^function NEW_ANS_NAME
-# ^uses $PG_STOP_FLAG
-# ^uses $QUIZ_PREFIX
-# ^uses $ANSWER_PREFIX
-# ^uses @PG_UNLABELED_ANSWERS
-sub NEW_ANS_NAME {
- return "" if $PG_STOP_FLAG;
- my $number=shift;
- my $prefix = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!);
- my $label = $prefix.$number;
- push(@PG_UNLABELED_ANSWERS,$label);
- $label;
-}
-
=item ANS_NUM_TO_NAME()
ANS_NUM_TO_NAME($num);
@@ -694,17 +884,6 @@
=cut
-# ^function ANS_NUM_TO_NAME
-# ^uses $QUIZ_PREFIX
-# ^uses $ANSWER_PREFIX
-sub ANS_NUM_TO_NAME {
- my $number=shift;
- my $label = eval(q!$main::QUIZ_PREFIX.$main::ANSWER_PREFIX!).$number;
- $label;
-}
-
-my $vecnum;
-
=item RECORD_FROM_LABEL()
RECORD_FORM_LABEL("label");
@@ -714,17 +893,6 @@
=cut
-# ^function RECORD_FORM_LABEL
-# ^uses $PG_STOP_FLAG
-# ^uses @KEPT_EXTRA_ANSWERS
-sub RECORD_FORM_LABEL { # this stores form data (such as sticky answers), but does nothing more
- # it's a bit of hack since we are storing these in the KEPT_EXTRA_ANSWERS queue even if they aren't answers per se.
- return "" if $PG_STOP_FLAG;
- my $label = shift; # the label of the input box or textarea
- eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!); #put the labels into the hash to be caught later for recording purposes
- $label;
-}
-
=item NEW_ANS_ARRAY_NAME()
NEW_ANS_ARRAY_NAME($num, $row, $col);
@@ -734,23 +902,6 @@
=cut
-# ^function NEW_ANS_ARRAY_NAME
-# ^uses $PG_STOP_FLAG
-# ^uses $QUIZ_PREFIX
-# ^uses @PG_UNLABELED_ANSWERS
-sub NEW_ANS_ARRAY_NAME { # this keeps track of the answers which are entered implicitly,
- # rather than with a specific label
- return "" if $PG_STOP_FLAG;
- my $number=shift;
- $vecnum = 0;
- my $row = shift;
- my $col = shift;
-# my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]";
- my $label = eval(q!$main::QUIZ_PREFIX."ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__"!);
- push(@PG_UNLABELED_ANSWERS,$label);
- $label;
-}
-
=item NEW_ANS_ARRAY_NAME_EXTENSION()
NEW_ANS_ARRAY_NAME_EXTENSION($num, $row, $col);
@@ -760,26 +911,6 @@
=cut
-# ^function NEW_ANS_ARRAY_NAME_EXTENSION
-# ^uses $PG_STOP_FLAG
-sub NEW_ANS_ARRAY_NAME_EXTENSION { # this keeps track of the answers which are entered implicitly,
- # rather than with a specific label
- return "" if $PG_STOP_FLAG;
- my $number=shift;
- my $row = shift;
- my $col = shift;
- if( $row == 0 && $col == 0 ){
- $vecnum += 1;
- }
- #FIXME change made to conform to HTML 4.01 standards. "Name" attributes can only contain
- # alphanumeric characters, _ : and .
- # Also need to make corresponding changes in PGmorematrixmacros. grep for ArRaY.
- #my $label = "ArRaY"."$number"."["."$vecnum".","."$row".","."$col"."]";
- my $label = eval(q!$main::QUIZ_PREFIX."ArRaY"."$number"."__"."$vecnum".":"."$row".":"."$col"."__"!);
- eval(q!push(@main::KEPT_EXTRA_ANSWERS, $label)!);#put the labels into the hash to be caught later for recording purposes
- $label;
-}
-
=item get_PG_ANSWERS_HASH()
get_PG_ANSWERS_HASH();
@@ -789,37 +920,6 @@
=cut
-# ^function get_PG_ANSWERS_HASH
-# ^uses %PG_ANSWERS_HASH
-# ^uses @PG_UNLABELED_ANSWERS
-# ^uses @PG_ANSWERS
-sub get_PG_ANSWERS_HASH {
- # update the PG_ANSWWERS_HASH, then report the result.
- # This is used in writing sequential problems
- # if there is an input, use that as a key into the answer hash
- my $key = shift;
- my (%pg_answers_hash, @pg_unlabeled_answers);
- %pg_answers_hash= %PG_ANSWERS_HASH;
- #warn "order ", eval(q!@main::PG_ANSWER_ENTRY_ORDER!);
- #warn "pg answers", %PG_ANSWERS_HASH;
- #warn "unlabeled", @PG_UNLABELED_ANSWERS;
- my $index=0;
- foreach my $label (@PG_UNLABELED_ANSWERS) {
- if ( defined($PG_ANSWERS[$index]) ) {
- $pg_answers_hash{"$label"}= $PG_ANSWERS[$index];
- #warn "recording answer label = $label";
- } else {
- warn "No answer provided by instructor for answer $label";
- }
- $index++;
- }
- if ($key) {
- return $pg_answers_hash{$key};
- } else {
- return %pg_answers_hash;
- }
-}
-
=item includePGproblem($filePath)
includePGproblem($filePath);
@@ -830,33 +930,6 @@
=cut
-# ^function includePGproblem
-# ^uses %envir
-# ^uses &read_whole_problem_file
-# ^uses &includePGtext
-sub includePGproblem {
- my $filePath = shift;
- my %save_envir = %main::envir;
- my $fullfilePath = $main::envir{templateDirectory}.$filePath;
- my $r_string = read_whole_problem_file($fullfilePath);
- if (ref($r_string) eq 'SCALAR') {
- $r_string = $$r_string;
- }
-
- # The problem calling this should provide DOCUMENT and ENDDOCUMENT,
- # so we remove them from the included file.
- $r_string=~ s/^\s*(END)?DOCUMENT(\(\s*\));?//gm;
-
- # Reset the problem path so that static images can be found via
- # their relative paths.
- eval('$main::envir{probFileName} = $filePath');
- eval('$main::envir{fileName} = $filePath');
- includePGtext($r_string);
- # Reset the environment to what it is before.
- %main::envir = %save_envir;
-}
-
-
=back
=head1 SEE ALSO
@@ -865,4 +938,7 @@
=cut
-1;
+
+
+
+1;
\ No newline at end of file
Index: PGanswermacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGanswermacros.pl,v
retrieving revision 1.72
retrieving revision 1.73
diff -Lmacros/PGanswermacros.pl -Lmacros/PGanswermacros.pl -u -r1.72 -r1.73
--- macros/PGanswermacros.pl
+++ macros/PGanswermacros.pl
@@ -1447,100 +1447,6 @@
-=head2 Filter utilities
-
-These two subroutines can be used in filters to set default options. They
-help make filters perform in uniform, predictable ways, and also make it
-easy to recognize from the code which options a given filter expects.
-
-
-=head4 assign_option_aliases
-
-Use this to assign aliases for the standard options. It must come before set_default_options
-within the subroutine.
-
- assign_option_aliases(\%options,
- 'alias1' => 'option5'
- 'alias2' => 'option7'
- );
-
-
-If the subroutine is called with an option " alias1 => 23 " it will behave as if it had been
-called with the option " option5 => 23 "
-
-=cut
-
-
-# ^function assign_option_aliases
-sub assign_option_aliases {
- my $rh_options = shift;
- warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
- my @option_aliases = @_;
- while (@option_aliases) {
- my $alias = shift @option_aliases;
- my $option_key = shift @option_aliases;
-
- if (defined($rh_options->{$alias} )) { # if the alias appears in the option list
- if (not defined($rh_options->{$option_key}) ) { # and the option itself is not defined,
- $rh_options->{$option_key} = $rh_options->{$alias}; # insert the value defined by the alias into the option value
- # the FIRST alias for a given option takes precedence
- # (after the option itself)
- } else {
- warn "option $option_key is already defined as", $rh_options->{$option_key}, "<br>\n",
- "The attempt to override this option with the alias $alias with value ", $rh_options->{$alias},
- " was ignored.";
- }
- }
- delete($rh_options->{$alias}); # remove the alias from the initial list
- }
-
-}
-
-=head4 set_default_options
-
- set_default_options(\%options,
- '_filter_name' => 'filter',
- 'option5' => .0001,
- 'option7' => 'ascii',
- 'allow_unknown_options => 0,
- }
-
-Note that the first entry is a reference to the options with which the filter was called.
-
-The option5 is set to .0001 unless the option is explicitly set when the subroutine is called.
-
-The B<'_filter_name'> option should always be set, although there is no error if it is missing.
-It is used mainly for debugging answer evaluators and allows
-you to keep track of which filter is currently processing the answer.
-
-If B<'allow_unknown_options'> is set to 0 then if the filter is called with options which do NOT appear in the
-set_default_options list an error will be signaled and a warning message will be printed out. This provides
-error checking against misspelling an option and is generally what is desired for most filters.
-
-Occasionally one wants to write a filter which accepts a long list of options, not all of which are known in advance,
-but only uses a subset of the options
-provided. In this case, setting 'allow_unkown_options' to 1 prevents the error from being signaled.
-
-=cut
-
-# ^function set_default_options
-# ^uses pretty_print
-sub set_default_options {
- my $rh_options = shift;
- warn "The first entry to set_default_options must be a reference to the option hash" unless ref($rh_options) eq 'HASH';
- my %default_options = @_;
- unless ( defined($default_options{allow_unknown_options}) and $default_options{allow_unknown_options} == 1 ) {
- foreach my $key1 (keys %$rh_options) {
- warn "This option |$key1| is not recognized in this subroutine<br> ", pretty_print($rh_options) unless exists($default_options{$key1});
- }
- }
- foreach my $key (keys %default_options) {
- if ( not defined($rh_options->{$key} ) and defined( $default_options{$key} ) ) {
- $rh_options->{$key} = $default_options{$key}; #this allows tol => undef to allow the tol option, but doesn't define
- # this key unless tol is explicitly defined.
- }
- }
-}
=head2 Problem Grader Subroutines
@@ -1875,14 +1781,20 @@
my $r_input = shift;
my $out = '';
if ( not ref($r_input) ) {
- $out = $r_input; # not a reference
- $out =~ s/</</g; # protect for HTML output
+ $out = $r_input if defined $r_input; # not a reference
+ $out =~ s/</</g ; # protect for HTML output
} elsif ("$r_input" =~/hash/i) { # this will pick up objects whose '$self' is hash and so works better than ref($r_iput).
local($^W) = 0;
+
$out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
+
+
foreach my $key (lex_sort( keys %$r_input )) {
$out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print($r_input->{$key}) . "</td></tr>";
}
+
+
+
$out .="</table>";
} elsif (ref($r_input) eq 'ARRAY' ) {
my @array = @$r_input;
@@ -1895,7 +1807,7 @@
$out = "$r_input";
} else {
$out = $r_input;
- $out =~ s/</</g; # protect for HTML output
+ $out =~ s/</</g ; # protect for HTML output
}
$out;
}
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 02:08:57
|
Log Message:
-----------
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:
PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash
Modified Files:
--------------
pg/macros:
PGbasicmacros.pl
Added Files:
-----------
pg/macros:
LiveGraphics3D.pl
source.pl
Revision Data
-------------
Index: PGbasicmacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGbasicmacros.pl,v
retrieving revision 1.64
retrieving revision 1.65
diff -Lmacros/PGbasicmacros.pl -Lmacros/PGbasicmacros.pl -u -r1.64 -r1.65
--- macros/PGbasicmacros.pl
+++ macros/PGbasicmacros.pl
@@ -192,6 +192,28 @@
$r_ans_rule_count = PG_restricted_eval(q!\$ans_rule_count!);
}
+=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;
+ }
+}
+
=head2 Answer blank macros:
These produce answer blanks of various sizes or pop up lists or radio answer buttons.
@@ -258,11 +280,11 @@
These auxiliary macros are defined in PG.pl
- NEW_ANS_NAME( number ); # produces a new answer blank name from a number by adding a prefix (AnSwEr)
+ NEW_ANS_NAME( ); # produces a new anonymous answer blank name by appending a number to the prefix (AnSwEr)
# and registers this name as an implicitly labeled answer
# Its use is paired with each answer evaluator being entered using ANS()
- ANS_NUM_TO_NAME(number); # adds the prefix (AnSwEr) to the number, but does nothing else.
+ ANS_NUM_TO_NAME(number); # prepends the prefix (AnSwEr) to the number, but does nothing else.
RECORD_ANS_NAME( name ); # records the order in which the answer blank is rendered
# This is called by all of the constructs above, but must
@@ -271,9 +293,9 @@
These are legacy macros:
- ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME(number), width)
- ANS_BOX( question_number,height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME(number), height, width)
- ANS_RADIO( question_number, value,tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_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)
@@ -283,14 +305,16 @@
sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE
my($name,$col) = @_;
- $col = 20 unless defined($col);
+ $col = 20 unless not_null($col);
NAMED_ANS_RULE($name,$col);
}
sub NAMED_ANS_RULE {
my($name,$col) = @_;
+ $col = 20 unless not_null($col);
my $answer_value = '';
$answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
+ #FIXME -- code factoring needed
if ($answer_value =~ /\0/ ) {
my @answers = split("\0", $answer_value);
$answer_value = shift(@answers); # use up the first answer
@@ -302,15 +326,17 @@
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
+ # 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; #`## make sure student answers can not be interpolated by e.g. EV3
+ $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
- $name = RECORD_ANS_NAME($name);
-
+ DEBUG_MESSAGE( "RECORD_ANS_NAME($name, $answer_value)");
+ $name = RECORD_ANS_NAME($name, $answer_value);
+ #INSERT_RESPONSE($name,$name,$answer_value); #FIXME -- why can't we do this inside RECORD_ANS_NAME?
+
my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
$tcol = $tcol < 40 ? $tcol : 40; ## get min
@@ -325,6 +351,7 @@
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/ ) {
@@ -345,8 +372,8 @@
$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
- $name = RECORD_ANS_NAME($name);
-
+ $name = RECORD_ANS_NAME($name, $answer_value);
+ #INSERT_RESPONSE($name,$name,$answer_value);
my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
$tcol = $tcol < 40 ? $tcol : 40; ## get min
@@ -371,6 +398,7 @@
}
$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
+ INSERT_RESPONSE($name,$name,$answer_value); #hack -- this needs more work to decide how to make it work
my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
$tcol = $tcol < 40 ? $tcol : 40; ## get min
MODES(
@@ -392,11 +420,13 @@
my($name,$row,$col) = @_;
$row = 10 unless defined($row);
$col = 80 unless defined($col);
- $name = RECORD_ANS_NAME($name);
+
my $height = .07*$row;
my $answer_value = '';
$answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} );
+ $name = RECORD_ANS_NAME($name, $answer_value);
# $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3
+ INSERT_RESPONSE($name,$name,$answer_value);
my $out = MODES(
TeX => qq!\\vskip $height in \\hrulefill\\quad !,
Latex2HTML => qq!\\begin{rawhtml}<TEXTAREA NAME="$name" id="$name" ROWS="$row" COLS="$col"
@@ -411,7 +441,7 @@
sub ANS_BOX { #deprecated
my($number,$row,$col) = @_;
- my $name = NEW_ANS_NAME($number);
+ my $name = NEW_ANS_NAME();
NAMED_ANS_BOX($name,$row,$col);
}
@@ -419,7 +449,7 @@
my $name = shift;
my $value = shift;
my $tag =shift;
- $name = RECORD_ANS_NAME($name);
+
my $checked = '';
if ($value =~/^\%/) {
$value =~ s/^\%//;
@@ -433,7 +463,7 @@
}
}
-
+ $name = RECORD_ANS_NAME($name, {$value=>$checked} );
MODES(
TeX => qq!\\item{$tag}\n!,
Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
@@ -465,7 +495,7 @@
}
}
-
+ EXTEND_RESPONSE($name,$name,$value, $checked);
MODES(
TeX => qq!\\item{$tag}\n!,
Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=RADIO NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
@@ -493,7 +523,7 @@
my $number = shift;
my $value = shift;
my $tag =shift;
- my $name = NEW_ANS_NAME($number);
+ my $name = NEW_ANS_NAME();
NAMED_ANS_RADIO($name,$value,$tag);
}
@@ -501,8 +531,6 @@
my $number = shift;
my $value = shift;
my $tag =shift;
-
-
my $name = ANS_NUM_TO_NAME($number);
NAMED_ANS_RADIO_OPTION($name,$value,$tag);
}
@@ -559,7 +587,7 @@
my $name = shift;
my $value = shift;
my $tag =shift;
- $name = RECORD_ANS_NAME($name);
+
my $checked = '';
if ($value =~/^\%/) {
@@ -576,7 +604,7 @@
}
}
-
+ $name = RECORD_ANS_NAME($name, {$value => $checked});
MODES(
TeX => qq!\\item{$tag}\n!,
Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
@@ -605,7 +633,7 @@
}
}
-
+ EXTEND_RESPONSE($name,$name,$value, $checked);
MODES(
TeX => qq!\\item{$tag}\n!,
Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=CHECKBOX NAME="$name" id="$name" VALUE="$value" $checked>\\end{rawhtml}$tag!,
@@ -635,7 +663,7 @@
my $number = shift;
my $value = shift;
my $tag =shift;
- my $name = NEW_ANS_NAME($number);
+ my $name = NEW_ANS_NAME();
NAMED_ANS_CHECKBOX($name,$value,$tag);
}
@@ -671,17 +699,19 @@
sub ans_rule {
my $len = shift; # gives the optional length of the answer blank
$len = 20 unless $len ;
- my $name = NEW_ANS_NAME(inc_ans_rule_count());
+ #my $name = NEW_ANS_NAME();
+ my $name = NEW_ANS_NAME(); # increment is done internally
NAMED_ANS_RULE($name ,$len);
}
sub ans_rule_extension {
my $len = shift;
$len = 20 unless $len ;
+ warn "ans_rule_extension may be misnumbering the answers";
my $name = NEW_ANS_NAME($$r_ans_rule_count); # don't update the answer name
NAMED_ANS_RULE($name ,$len);
}
sub ans_radio_buttons {
- my $name = NEW_ANS_NAME(inc_ans_rule_count());
+ my $name = NEW_ANS_NAME();
my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_);
if ($displayMode eq 'TeX') {
@@ -694,7 +724,7 @@
#added 6/14/2000 by David Etlinger
sub ans_checkbox {
- my $name = NEW_ANS_NAME( inc_ans_rule_count() );
+ my $name = NEW_ANS_NAME( );
my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS( $name, @_ );
if ($displayMode eq 'TeX') {
@@ -713,7 +743,7 @@
sub tex_ans_rule {
my $len = shift;
$len = 20 unless $len ;
- my $name = NEW_ANS_NAME(inc_ans_rule_count());
+ my $name = NEW_ANS_NAME();
my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes.
my $out = MODES(
'TeX' => $answer_rule,
@@ -728,6 +758,7 @@
sub tex_ans_rule_extension {
my $len = shift;
$len = 20 unless $len ;
+ warn "tex_ans_rule_extension may be missnumbering the answer";
my $name = NEW_ANS_NAME($$r_ans_rule_count);
my $answer_rule = NAMED_ANS_RULE($name ,$len); # we don't want to create three answer rules in different modes.
my $out = MODES(
@@ -776,7 +807,7 @@
my $col =shift;
$row = 5 unless $row;
$col = 80 unless $col;
- my $name = NEW_ANS_NAME(inc_ans_rule_count());
+ my $name = NEW_ANS_NAME();
NAMED_ANS_BOX($name ,$row,$col);
}
@@ -794,7 +825,7 @@
my @list1 = @{$list[0]};
@list = map { $_ => $_ } @list1;
}
- $name = RECORD_ANS_NAME($name); # record answer name
+
my $answer_value = '';
$answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
my $out = "";
@@ -819,12 +850,13 @@
} elsif ( $displayMode eq "TeX") {
$out .= "\\fbox{?}";
}
-
+ $name = RECORD_ANS_NAME($name,$answer_value); # record answer name
+ $out;
}
sub pop_up_list {
my @list = @_;
- my $name = NEW_ANS_NAME(inc_ans_rule_count()); # get new answer name
+ my $name = NEW_ANS_NAME(); # get new answer name
NAMED_POP_UP_LIST($name, @list);
}
@@ -876,6 +908,7 @@
my $name = shift;
my $col = shift;
+ my %options = @_;
$col = 20 unless $col;
my $answer_value = '';
@@ -891,6 +924,10 @@
}
$answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3
+ warn "ans_label $options{ans_label} $name $answer_value";
+ if (defined($options{ans_label}) ) {
+ INSERT_RESPONSE($options{ans_label}, $name, $answer_value);
+ }
MODES(
TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ",
Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME="$name" id="$name" VALUE = "">\n\\end{rawhtml}\n!,
@@ -903,19 +940,21 @@
my $n = shift;
my $col = shift;
$col = 20 unless $col;
- my $num = inc_ans_rule_count() ;
- my $name = NEW_ANS_ARRAY_NAME($num,0,0);
+ my $ans_label = NEW_ANS_NAME();
+ my $num = ans_rule_count();
my @options = @_;
my @array=();
- my $string;
my $answer_value = "";
-
- $array[0][0] = NAMED_ANS_RULE($name,$col);
-
- for( my $i = 1; $i < $n; $i+=1)
+ my @response_list = ();
+ 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);
- $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col);
+ $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col,ans_label=>$ans_label);
}
@@ -924,8 +963,7 @@
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);
-
+ $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label);
}
}
@@ -939,19 +977,18 @@
my $n = shift;
my $col = shift;
$col = 20 unless $col;
- my $num = PG_restricted_eval(q!$main::ans_rule_count!);
+ my $num = ans_rule_count(); #hack -- ans_rule_count is updated after being used
my @options = @_;
+ my @response_list = ();
my $name;
my @array=();
- my $string;
- my $answer_value = "";
-
+ my $ans_label = $main::PG->new_label($num);
for( my $j = 0; $j < $m; $j+=1 ){
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);
+ $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name,$col, ans_label=>$ans_label);
}
@@ -1069,8 +1106,7 @@
sub COMMENT {
my @in = @_;
my $out = join("$BR", @in);
- my $out = '<div class=\"AuthorComment\">'.$out.'</div>';
-
+ $out = '<div class=\"AuthorComment\">'.$out.'</div>';
PG_restricted_eval(q!$main::pgComment = "!.$out.q!"!);
return('');
}
@@ -1182,18 +1218,18 @@
my %options = @_;
# is a string supplied for the current display mode? if so, return it
- return $options{$displayMode} if defined $options{$displayMode};
+ return $options{$main::displayMode} if defined $options{$main::displayMode};
# otherwise, fail over to backup modes
my @backup_modes;
- if (exists $DISPLAY_MODE_FAILOVER{$displayMode}) {
- @backup_modes = @{$DISPLAY_MODE_FAILOVER{$displayMode}};
+ if (exists $DISPLAY_MODE_FAILOVER{$main::displayMode}) {
+ @backup_modes = @{$DISPLAY_MODE_FAILOVER{$main::displayMode}};
foreach my $mode (@backup_modes) {
return $options{$mode} if defined $options{$mode};
}
}
- die "ERROR in defining MODES: neither display mode $displayMode nor",
- " any fallback modes (", join(", ", @backup_modes), ") supplied.\n";
+ die "ERROR in defining MODES: neither display mode '$main::displayMode' nor",
+ " any fallback modes (", join(", ", @backup_modes), ") supplied.";
}
# end display macros
@@ -1261,7 +1297,7 @@
#sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
# Alternate definition of BR which is slightly more flexible and gives more white space in printed output
# which looks better but kills more trees.
-sub BR { MODES( TeX => '\\leavevmode\\\\\\relax ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
+sub BR { MODES( TeX => '\\leavevmode\\\\\\relax ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR/>'); };
sub LQ { MODES( TeX => "\\lq\\lq{}", Latex2HTML => '"', HTML => '"' ); };
sub RQ { MODES( TeX => "\\rq\\rq{}", Latex2HTML => '"', HTML => '"' ); };
sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML => ''); }; # begin math mode
@@ -1469,6 +1505,7 @@
}
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/;
$out =~s/\\/\\\\/g; # protect any new backslashes introduced.
($out,$PG_eval_errors,$PG_full_error_report)
}
@@ -1810,7 +1847,7 @@
sub beginproblem {
my $out = "";
- my $problemValue = $envir->{problemValue};
+ my $problemValue = $envir->{problemValue} || 0;
my $fileName = $envir->{fileName};
my $probNum = $envir->{probNum};
my $TeXFileName = protect_underbar($envir->{fileName});
@@ -1949,6 +1986,7 @@
my %typeHash = (
'interval notation' => 'IntervalNotation.html',
'units' => 'Units.html',
+ 'syntax' => 'Syntax.html',
);
my $infoRef = $typeHash{$type};
@@ -1985,7 +2023,7 @@
} else {
# we are set to include the applet
}
- my $appletHeader = qq! archive = "$archive " codebase = "$codebase" !;
+ $appletHeader = qq! archive = "$archive " codebase = "$codebase" !;
foreach my $key ('name', 'code','width','height', ) {
if ( defined($applet->{$key}) ) {
$appletHeader .= qq! $key = "!.$applet->{$key}.q!" ! ;
@@ -2058,10 +2096,10 @@
}
sub lex_sort {
- PGsort sub {$_[0] lt $_[1]}, @_;
+ PGsort( sub {$_[0] lt $_[1]}, @_);
}
sub num_sort {
- PGsort sub {$_[0] < $_[1]}, @_;
+ PGsort( sub {$_[0] < $_[1]}. @_);
}
@@ -2130,7 +2168,7 @@
$out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n";
}
$out;
- }
+}
sub row {
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 02:08:56
|
Log Message:
-----------
major change to the base
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:
PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash
Modified Files:
--------------
pg/lib/WeBWorK/PG:
Translator.pm
Revision Data
-------------
Index: Translator.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/WeBWorK/PG/Translator.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -Llib/WeBWorK/PG/Translator.pm -Llib/WeBWorK/PG/Translator.pm -u -r1.25 -r1.26
--- lib/WeBWorK/PG/Translator.pm
+++ lib/WeBWorK/PG/Translator.pm
@@ -12,6 +12,9 @@
use Net::SMTP;
use WeBWorK::PG::IO;
+#use PadWalker; # used for processing error messages
+#use Data::Dumper;
+
# loading GD within the Safe compartment has occasionally caused infinite recursion
# Putting these use statements here seems to avoid this problem
@@ -389,7 +392,7 @@
# All other files are loaded with restriction
#
# construct a regex that matches only these three files safely
- my @unrestricted_files = qw/PG.pl dangerousMacros.pl IO.pl/;
+ my @unrestricted_files = (); # no longer needed? FIXME w/PG.pl dangerousMacros.pl IO.pl/;
my $unrestricted_files = join("|", map { quotemeta } @unrestricted_files);
my $store_mask;
@@ -536,13 +539,15 @@
my $macro_file_name = fileFromPath($filePath);
$macro_file_name =~s/\.pl//; # trim off the extenstion
my $export_subroutine_name = "_${macro_file_name}_export";
- my $init_subroutine_name = "_${macro_file_name}_init";
+ my $init_subroutine_name = "${safe_cmpt_package_name}::_${macro_file_name}_init";
+
my $local_errors = "";
no strict;
# warn "dangerousMacros main:: contains <br>\n ".join("<br>\n ", %main::) if $debugON;
- my $init_subroutine = eval { \&{"${safe_cmpt_package_name}::$init_subroutine_name"} };
+ my $init_subroutine = eval { \&{$init_subroutine_name} };
+ warn "No init routine for $init_subroutine_name: $@" if $debugON and $@;
use strict;
- my $macro_file_loaded = defined(&$init_subroutine);
+ my $macro_file_loaded = ref($init_subroutine) =~ /CODE/;
#print STDERR "$macro_file_name has not yet been loaded\n" unless $macro_file_loaded;
unless ($macro_file_loaded) {
@@ -552,7 +557,7 @@
my $local_errors = "";
if (-r $filePath ) {
my $rdoResult = $safe_cmpt->rdo($filePath);
- #warn "There were problems compiling the file: $filePath: <BR>--$@" if $@;
+ #warn "unrestricted load: $filePath\n";
$local_errors ="\nThere were problems compiling the file:\n $filePath\n $@\n" if $@;
$self ->{errors} .= $local_errors if $local_errors;
use strict;
@@ -564,11 +569,11 @@
}
# try again to define the initization subroutine
- $init_subroutine = eval { \&{"${safe_cmpt_package_name}::$init_subroutine_name"} };
- $macro_file_loaded = defined(&$init_subroutine );
+ $init_subroutine = eval { \&{"$init_subroutine_name"} };
+ $macro_file_loaded = ref($init_subroutine) =~ /CODE/;
if ( $macro_file_loaded ) {
- # warn "unrestricted load: initializing $macro_file_name $init_subroutine" ;
+ #warn "unrestricted load: initializing $macro_file_name $init_subroutine" ;
&$init_subroutine();
}
$local_errors .= "\nUnknown error. Unable to load $filePath\n" if ($local_errors eq '' and not $macro_file_loaded);
@@ -739,7 +744,7 @@
=cut
sub PG_errorMessage {
- my $return = shift; my $frame = 2;
+ my $return = shift; my $frame = 2; # return can be 'message' or 'traceback'
my $message = join("\n",@_); $message =~ s/\.?\s+$//;
my $files = eval ('$main::__files__'); $files = {} unless $files;
my $tmpl = $files->{tmpl} || '$';
@@ -783,6 +788,36 @@
return join("\n",@trace,'');
}
+=head2 PG_undef_var_check
+
+=pod
+
+ Produces warnings of this type in order to help you guess which local variable is undefined
+ Warning: Use of uninitialized value in concatenation (.) or string at mpu.cgi line 25.
+ Possible variables are:
+ '$GLOBAL_VARIABLE' => \'global',
+ '$t' => \undef,
+ '$s' => \'regular output'
+
+
+
+
+=cut
+
+sub PG_undef_var_check {
+ if($_[0] !~ /^Use of uninitialized value/) {
+ return @_;
+ } else {
+ # If there are objects, the output can be VERY large when you increase this
+ local $Data::Dumper::Maxdepth = 2;
+ # takes all lexical variables from caller-nemaspace
+ my $possibles = Data::Dumper::Dumper({ %{PadWalker::peek_my(1)}, %{PadWalker::peek_our(1)} });
+
+ $possibles ne "\$VAR1 = {};\n" ? ($possibles =~ s/^.*?\n(.*)\n.*?\n$/$1/ms) : ($possibles = '');
+ return "Warning: " . join(', ', @_) . "Possible variables are:\n$possibles\n";
+ }
+
+}
############################################################################
=head2 Translate
@@ -910,7 +945,7 @@
my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF)
=$safe_cmpt->reval(" $evalString");
-
+ #warn "using safe compartment ", $safe_cmpt->root;
# This section could use some more error messages. In particular if a problem doesn't produce the right output, the user needs
# information about which problem was at fault.
#
@@ -1150,7 +1185,7 @@
$self->{safe}->share('$rf_fun','$temp_ans');
# clear %errorTable for each problem
- %errorTable = ();
+ %errorTable = (); # is the error table being used? perhaps by math objects?
my $rh_ans_evaluation_result;
if (ref($rf_fun) eq 'CODE' ) {
@@ -1158,7 +1193,7 @@
warn "Error in Translator.pm::process_answers: Answer $ans_name: |$temp_ans|\n $@\n" if $@;
} elsif (ref($rf_fun) =~ /AnswerEvaluator/) {
$rh_ans_evaluation_result = $self->{safe} ->reval('$rf_fun->evaluate($temp_ans, ans_label => \''.$ans_name.'\')');
- $@ = $errorTable{$@} if $@ && defined($errorTable{$@});
+ $@ = $errorTable{$@} if $@ && defined($errorTable{$@}); #Are we redefining error messages here?
warn "Error in Translator.pm::process_answers: Answer $ans_name: |$temp_ans|\n $@\n" if $@;
warn "Evaluation error: Answer $ans_name:<BR>\n",
$rh_ans_evaluation_result->error_flag(), " :: ",
@@ -1562,7 +1597,7 @@
local $SIG{__DIE__} = "DEFAULT";
no strict;
- my $out = eval ("package main; be_strict();" . $string );
+ my $out = eval ("package main; be_strict();\n" . $string );
my $errors =$@;
my $full_error_report = "PG_macro_file_eval detected error at line $line of file $file \n"
. $errors .
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 02:08:55
|
Log Message:
-----------
minor formatting changes
Modified Files:
--------------
pg/macros:
PGmatrixmacros.pl
Revision Data
-------------
Index: PGmatrixmacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGmatrixmacros.pl,v
retrieving revision 1.15
retrieving revision 1.16
diff -Lmacros/PGmatrixmacros.pl -Lmacros/PGmatrixmacros.pl -u -r1.15 -r1.16
--- macros/PGmatrixmacros.pl
+++ macros/PGmatrixmacros.pl
@@ -175,16 +175,16 @@
$main::defaultDisplayMatrixStyle : "(s)";
set_default_options(\%opts,
- '_filter_name' => 'display_matrix',
- 'force_tex' => 0,
- 'left' => substr($styleParams,0,1),
- 'right' => substr($styleParams,2,1),
- 'midrule' => substr($styleParams,1,1),
- 'top_labels' => 0,
- 'box'=>[-1,-1], # pair location of boxed element
- 'allow_unknown_options'=> 1,
- 'num_format' => "%.0f",
- );
+ '_filter_name' => 'display_matrix',
+ 'force_tex' => 0,
+ 'left' => substr($styleParams,0,1),
+ 'right' => substr($styleParams,2,1),
+ 'midrule' => substr($styleParams,1,1),
+ 'top_labels' => 0,
+ 'box'=>[-1,-1], # pair location of boxed element
+ 'allow_unknown_options'=> 1,
+ 'num_format' => "%.0f",
+ );
my ($numRows, $numCols, @myRows);
@@ -616,10 +616,11 @@
}
set_default_options(\%opts,
- '_filter_name' => 'mbox',
- 'valign' => 'middle',
- 'allowbreaks' => 'no',
- 'allow_unknown_options'=> 0);
+ '_filter_name' => 'mbox',
+ 'valign' => 'middle',
+ 'allowbreaks' => 'no',
+ 'allow_unknown_options'=> 0
+ );
if(! $opts{'allowbreaks'}) { $opts{'allowbreaks'}='no';}
my $out = "";
my $j;
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 02:08:52
|
Log Message:
-----------
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:
PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.128
retrieving revision 1.129
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.128 -r1.129
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -366,13 +366,15 @@
sub ans_matrix {
my $self = shift;
my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
- my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
- my $new_name = pgRef('RECORD_FORM_LABEL');
+ #my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
+ my $named_extension = pgRef('NAMED_ANS_ARRAY_EXTENSION');
+ my $new_name = sub {@_}; # pgRef('RECORD_EXTRA_ANSWERS');
my $HTML = ""; my $ename = $name;
if ($name eq '') {
- my $n = pgCall('inc_ans_rule_count');
+ #my $n = pgCall('inc_ans_rule_count');
$name = pgCall('NEW_ANS_NAME',$n);
- $ename = $answerPrefix.$n;
+ #$name = pgCall('NEW_ARRAY_NAME',$n);
+ $ename = "${answerPrefix}_${name}_";
}
$self->{ans_name} = $ename;
$self->{ans_rows} = $rows;
@@ -382,10 +384,15 @@
my @row = ();
foreach my $j (0..$cols-1) {
if ($i == 0 && $j == 0) {
- if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))}
- else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))}
+ if ($extend) {
+ push(@row,&$named_extension(&$new_name($name),$size,ans_label=>$name));
+ #push(@row,&$named_extension(&$new_name($name),$size))
+ }else {
+ push(@row,pgCall('NAMED_ANS_RULE',$name,$size))
+ }
} else {
- push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size));
+ push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size,ans_label=>$name));
+ #push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size,ans_label=>$name));
}
}
push(@array,[@row]);
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 02:08:50
|
Log Message:
-----------
insure that MatrixReal1.pm is used
Modified Files:
--------------
pg/lib:
Matrix.pm
Revision Data
-------------
Index: Matrix.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Matrix.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -Llib/Matrix.pm -Llib/Matrix.pm -u -r1.9 -r1.10
--- lib/Matrix.pm
+++ lib/Matrix.pm
@@ -21,6 +21,7 @@
# be_strict(); # an alias for use strict. This means that all global variable must contain main:: as a prefix.
#
# }
+use MatrixReal1;
package Matrix;
@Matrix::ISA = qw(MatrixReal1);
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:25:23
|
Log Message:
-----------
back out of mistaken commit
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
ProblemRenderer.pm
Revision Data
-------------
Index: ProblemRenderer.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/ProblemRenderer.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/WeBWorK/ContentGenerator/ProblemRenderer.pm -Llib/WeBWorK/ContentGenerator/ProblemRenderer.pm -u -r1.2 -r1.3
--- lib/WeBWorK/ContentGenerator/ProblemRenderer.pm
+++ lib/WeBWorK/ContentGenerator/ProblemRenderer.pm
@@ -16,7 +16,6 @@
package WeBWorK::ContentGenerator::ProblemRenderer;
use base qw(WeBWorK::ContentGenerator);
-use MIME::Base64 qw( encode_base64 decode_base64);
=head1 NAME
@@ -28,33 +27,23 @@
use strict;
use warnings;
use WeBWorK::CGI;
-use WeBWorK::Utils qw(pretty_print_rh);
use WeBWorK::Utils::Tasks qw(renderProblems);
sub pre_header_initialize {
my ($self) = @_;
my $r = $self->r;
- my $db = new WeBWorK::DB($r->ce->{dbLayout});
- $r->db($db);
-
+
my $pg = $r->param('pg');
- $pg = decode_base64($r->param('problemSource'));
my $file = $r->param('file');
my $seed = $r->param('seed');
- $seed = $r->param('problemSeed');
my $mode = $r->param('mode');
my $hint = $r->param('hint');
my $sol = $r->param('sol');
- # pretty_print_rh($r);
- # pretty_print_rh($r->{paramcache});
- warn "answers", @{ $r->{paramcache}->{AnSwEr0001}},"answersSubmitted",@{ $r->{paramcache}->{answersSubmitted}};
- warn "problemSource" , @{ $r->{paramcache}->{problemSource} };
- warn "request object", ${$r->{r}};
- #die "view warning";
+
die "must specify either a PG problems (param 'pg') or a path to a PG file (param 'file') and not both"
unless defined $pg and length $pg xor defined $file and length $file;
- #my $problem = $self->get_problem($pg, $file);
+ my $problem = $self->get_problem($pg, $file);
my @options = (r=>$r, problem_list=>[\$pg]);
#push @options, (problem_seed=>$seed) if defined $seed;
@@ -65,15 +54,15 @@
($self->{result}) = renderProblems(@options);
}
-# sub get_problem {
-# my ($self, $pg, $file) = @_;
-#
-# if (defined $pg) {
-# return \$pg;
-# } else {
-# return $file;
-# }
-# }
+sub get_problem {
+ my ($self, $pg, $file) = @_;
+
+ if (defined $pg) {
+ return \$pg;
+ } else {
+ return $file;
+ }
+}
use Data::Dumper;
sub content {
@@ -93,92 +82,4 @@
EOF
}
-# ideas from renderProblem.pl
-
-# new version of output:
-# my $out2 = {
-# text => encode_base64( $pg->{body_text} ),
-# header_text => encode_base64( $pg->{head_text} ),
-# answers => $pg->{answers},
-# errors => $pg->{errors},
-# WARNINGS => encode_base64($pg->{warnings} ),
-# problem_result => $pg->{result},
-# problem_state => $pg->{state},
-# #PG_flag => $pg->{flags},
-#
-#
-#
-# };
-sub formatAnswerRow {
- my $rh_answer = shift;
- my $problemNumber = shift;
- my $answerString = $rh_answer->{original_student_ans}||' ';
- my $correctAnswer = $rh_answer->{correct_ans}||'';
- my $score = ($rh_answer->{score}) ? 'Correct' : 'Incorrect';
- my $row = qq{
- <tr>
- <td>
- $problemNumber
- </td>
- <td>
- $answerString
- </td>
- <td>
- $score
- </td>
- <td>
- Correct answer is $correctAnswer
- </td>
- <td>
- <i></i>
- </td>
- </tr>\n
- };
- $row;
-}
-
-# sub formatRenderedProblem {
-# my $rh_result = shift; # wrap problem in formats
-# my $problemText = decode_base64($rh_result->{text});
-# my $rh_answers = $rh_result->{answers};
-#
-# my $warnings = '';
-# if ( defined ($rh_result->{WARNINGS}) and $rh_result->{WARNINGS} ){
-# $warnings = "<div style=\"background-color:pink\">
-# <p >WARNINGS</p><p>".decode_base64($rh_result->{WARNINGS})."</p></div>";
-# }
-#
-# ;
-# # collect answers
-# my $answerTemplate = q{<hr>ANSWERS <table border="3" align="center">};
-# my $problemNumber = 1;
-# foreach my $key (sort keys %{$rh_answers}) {
-# $answerTemplate .= formatAnswerRow($rh_answers->{$key}, $problemNumber++);
-# }
-# $answerTemplate .= q{</table> <hr>};
-#
-#
-#
-# my $problemTemplate = <<ENDPROBLEMTEMPLATE;
-#
-# $answerTemplate
-# $warnings
-# <form action="http://webhost.math.rochester.edu/webworkdocs/ww/render" method="post">
-# $problemText
-# <input type="hidden" name="answersSubmitted" value="1">
-# <input type="hidden" name="problemAddress" value="probSource">
-# <input type="hidden" name="problemSource" value="$encodedSource">
-# <input type="hidden" name="problemSeed" value="1234">
-# <input type="hidden" name="pathToProblemFile" value="foobar">
-# <p><input type="submit" name="submit" value="submit answers"></p>
-# </form>
-#
-#
-# ENDPROBLEMTEMPLATE
-#
-#
-#
-# $problemTemplate;
-# }
-
1;
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:21:37
|
Log Message:
-----------
minor changes to configuration section
Modified Files:
--------------
webwork2/lib:
WebworkWebservice.pm
webwork2/lib/Apache:
WeBWorK.pm
webwork2/lib/WeBWorK/ContentGenerator:
ProblemRenderer.pm
Revision Data
-------------
Index: WebworkWebservice.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WebworkWebservice.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/WebworkWebservice.pm -Llib/WebworkWebservice.pm -u -r1.5 -r1.6
--- lib/WebworkWebservice.pm
+++ lib/WebworkWebservice.pm
@@ -17,8 +17,18 @@
# warn "Assuming webwork directory is |$webwork_directory| and |$webwork_directory2|", $webwork_directory eq $webwork_directory2;
# #WTF??? why don't these two methods give me the same directory name?
- my $webwork_directory = '/opt/webwork/webwork2';
-
+###############################################################################
+# Configuration -- set to top webwork directory (webwork2) (set in webwork.apache2-config)
+# Configuration -- set server name
+###############################################################################
+
+ my $webwork_directory = $WeBWorK::Constants::WEBWORK_DIRECTORY; #'/opt/webwork/webwork2';
+
+ $WebworkWebservice::HOST_NAME = 'localhost'; # Apache->server->server_hostname;
+ $WebworkWebservice::HOST_PORT = '80'; # Apache->server->port;
+
+###############################################################################
+
eval "use lib '$webwork_directory/lib'"; die $@ if $@;
eval "use WeBWorK::CourseEnvironment"; die $@ if $@;
my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_directory });
@@ -29,16 +39,19 @@
$WebworkWebservice::WW_DIRECTORY = $webwork_directory;
$WebworkWebservice::PG_DIRECTORY = $pg_dir;
$WebworkWebservice::SeedCE = $ce;
- $WebworkWebservice::HOST_NAME = 'localhost'; #Apache->server->server_hostname;
- $WebworkWebservice::HOST_PORT = '80'; #Apache->server->port;
+
+###############################################################################
+
$WebworkWebservice::PASSWORD = 'xmluser';
$WebworkWebservice::COURSENAME = 'daemon2_course'; # default course
+
+ warn "webwork_directory set to ", $WeBWorK::Constants::WEBWORK_DIRECTORY;
}
use strict;
-###############################################################################
+
package WebworkWebservice;
Index: ProblemRenderer.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/ProblemRenderer.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/WeBWorK/ContentGenerator/ProblemRenderer.pm -Llib/WeBWorK/ContentGenerator/ProblemRenderer.pm -u -r1.1 -r1.2
--- lib/WeBWorK/ContentGenerator/ProblemRenderer.pm
+++ lib/WeBWorK/ContentGenerator/ProblemRenderer.pm
@@ -16,6 +16,7 @@
package WeBWorK::ContentGenerator::ProblemRenderer;
use base qw(WeBWorK::ContentGenerator);
+use MIME::Base64 qw( encode_base64 decode_base64);
=head1 NAME
@@ -27,23 +28,33 @@
use strict;
use warnings;
use WeBWorK::CGI;
+use WeBWorK::Utils qw(pretty_print_rh);
use WeBWorK::Utils::Tasks qw(renderProblems);
sub pre_header_initialize {
my ($self) = @_;
my $r = $self->r;
-
+ my $db = new WeBWorK::DB($r->ce->{dbLayout});
+ $r->db($db);
+
my $pg = $r->param('pg');
+ $pg = decode_base64($r->param('problemSource'));
my $file = $r->param('file');
my $seed = $r->param('seed');
+ $seed = $r->param('problemSeed');
my $mode = $r->param('mode');
my $hint = $r->param('hint');
my $sol = $r->param('sol');
-
+ # pretty_print_rh($r);
+ # pretty_print_rh($r->{paramcache});
+ warn "answers", @{ $r->{paramcache}->{AnSwEr0001}},"answersSubmitted",@{ $r->{paramcache}->{answersSubmitted}};
+ warn "problemSource" , @{ $r->{paramcache}->{problemSource} };
+ warn "request object", ${$r->{r}};
+ #die "view warning";
die "must specify either a PG problems (param 'pg') or a path to a PG file (param 'file') and not both"
unless defined $pg and length $pg xor defined $file and length $file;
- my $problem = $self->get_problem($pg, $file);
+ #my $problem = $self->get_problem($pg, $file);
my @options = (r=>$r, problem_list=>[\$pg]);
#push @options, (problem_seed=>$seed) if defined $seed;
@@ -54,15 +65,15 @@
($self->{result}) = renderProblems(@options);
}
-sub get_problem {
- my ($self, $pg, $file) = @_;
-
- if (defined $pg) {
- return \$pg;
- } else {
- return $file;
- }
-}
+# sub get_problem {
+# my ($self, $pg, $file) = @_;
+#
+# if (defined $pg) {
+# return \$pg;
+# } else {
+# return $file;
+# }
+# }
use Data::Dumper;
sub content {
@@ -82,4 +93,92 @@
EOF
}
+# ideas from renderProblem.pl
+
+# new version of output:
+# my $out2 = {
+# text => encode_base64( $pg->{body_text} ),
+# header_text => encode_base64( $pg->{head_text} ),
+# answers => $pg->{answers},
+# errors => $pg->{errors},
+# WARNINGS => encode_base64($pg->{warnings} ),
+# problem_result => $pg->{result},
+# problem_state => $pg->{state},
+# #PG_flag => $pg->{flags},
+#
+#
+#
+# };
+sub formatAnswerRow {
+ my $rh_answer = shift;
+ my $problemNumber = shift;
+ my $answerString = $rh_answer->{original_student_ans}||' ';
+ my $correctAnswer = $rh_answer->{correct_ans}||'';
+ my $score = ($rh_answer->{score}) ? 'Correct' : 'Incorrect';
+ my $row = qq{
+ <tr>
+ <td>
+ $problemNumber
+ </td>
+ <td>
+ $answerString
+ </td>
+ <td>
+ $score
+ </td>
+ <td>
+ Correct answer is $correctAnswer
+ </td>
+ <td>
+ <i></i>
+ </td>
+ </tr>\n
+ };
+ $row;
+}
+
+# sub formatRenderedProblem {
+# my $rh_result = shift; # wrap problem in formats
+# my $problemText = decode_base64($rh_result->{text});
+# my $rh_answers = $rh_result->{answers};
+#
+# my $warnings = '';
+# if ( defined ($rh_result->{WARNINGS}) and $rh_result->{WARNINGS} ){
+# $warnings = "<div style=\"background-color:pink\">
+# <p >WARNINGS</p><p>".decode_base64($rh_result->{WARNINGS})."</p></div>";
+# }
+#
+# ;
+# # collect answers
+# my $answerTemplate = q{<hr>ANSWERS <table border="3" align="center">};
+# my $problemNumber = 1;
+# foreach my $key (sort keys %{$rh_answers}) {
+# $answerTemplate .= formatAnswerRow($rh_answers->{$key}, $problemNumber++);
+# }
+# $answerTemplate .= q{</table> <hr>};
+#
+#
+#
+# my $problemTemplate = <<ENDPROBLEMTEMPLATE;
+#
+# $answerTemplate
+# $warnings
+# <form action="http://webhost.math.rochester.edu/webworkdocs/ww/render" method="post">
+# $problemText
+# <input type="hidden" name="answersSubmitted" value="1">
+# <input type="hidden" name="problemAddress" value="probSource">
+# <input type="hidden" name="problemSource" value="$encodedSource">
+# <input type="hidden" name="problemSeed" value="1234">
+# <input type="hidden" name="pathToProblemFile" value="foobar">
+# <p><input type="submit" name="submit" value="submit answers"></p>
+# </form>
+#
+#
+# ENDPROBLEMTEMPLATE
+#
+#
+#
+# $problemTemplate;
+# }
+
1;
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:19:35
|
Log Message:
-----------
work around for mysqldump bug (or bad documentation)
new version will work fine as long as only one defaults file is to be read.
Modified Files:
--------------
webwork2/lib/WeBWorK/DB/Schema/NewSQL:
Std.pm
Revision Data
-------------
Index: Std.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Schema/NewSQL/Std.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -Llib/WeBWorK/DB/Schema/NewSQL/Std.pm -Llib/WeBWorK/DB/Schema/NewSQL/Std.pm -u -r1.22 -r1.23
--- lib/WeBWorK/DB/Schema/NewSQL/Std.pm
+++ lib/WeBWorK/DB/Schema/NewSQL/Std.pm
@@ -219,7 +219,8 @@
# 2>&1 is specified first, which apparently makes stderr go to stdout
# and stdout (not including stderr) go to the dumpfile. see bash(1).
my $dump_cmd = "2>&1 " . shell_quote($mysqldump)
- . " --defaults-extra-file=" . shell_quote($my_cnf->filename)
+# . " --defaults-extra-file=" . shell_quote($my_cnf->filename)
+ . " --defaults-file=" . shell_quote($my_cnf->filename) # work around for mysqldump bug
. " " . shell_quote($database)
. " " . shell_quote($self->sql_table_name)
. " > " . shell_quote($dumpfile_path);
@@ -242,7 +243,8 @@
my $mysql = $self->{params}{mysql_path};
my $restore_cmd = "2>&1 " . shell_quote($mysql)
- . " --defaults-extra-file=" . shell_quote($my_cnf->filename)
+# . " --defaults-extra-file=" . shell_quote($my_cnf->filename)
+ . " --defaults-file=" . shell_quote($my_cnf->filename) # work around for mysqldump bug
. " " . shell_quote($database)
. " < " . shell_quote($dumpfile_path);
my $restore_out = readpipe $restore_cmd;
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:17:44
|
Log Message:
-----------
No longer need to preload PG.pl, dangerousMacros.pl and IO.pl
Modified Files:
--------------
webwork2/lib/WeBWorK/PG:
Local.pm
Revision Data
-------------
Index: Local.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/PG/Local.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -Llib/WeBWorK/PG/Local.pm -Llib/WeBWorK/PG/Local.pm -u -r1.28 -r1.29
--- lib/WeBWorK/PG/Local.pm
+++ lib/WeBWorK/PG/Local.pm
@@ -266,11 +266,11 @@
# at compile time.
#
# TO ENABLE CACHEING UNCOMMENT THE FOLLOWING:
- eval{$translator->pre_load_macro_files(
- $WeBWorK::PG::Local::safeCache,
- $ce->{pg}->{directories}->{macros},
- 'PG.pl', 'dangerousMacros.pl','IO.pl','PGbasicmacros.pl','PGanswermacros.pl'
- )};
+# eval{$translator->pre_load_macro_files(
+# $WeBWorK::PG::Local::safeCache,
+# $ce->{pg}->{directories}->{macros},
+# #'PG.pl', 'dangerousMacros.pl','IO.pl','PGbasicmacros.pl','PGanswermacros.pl'
+# )};
warn "Error while preloading macro files: $@" if $@;
# STANDARD LOADING CODE: for cached script files, this merely
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:16:21
|
Log Message:
-----------
Try to catch user_id's with bad characters -- not sure this is successful yet.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.95
retrieving revision 1.96
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.95 -r1.96
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -69,6 +69,7 @@
#use CGI qw(-nosticky );
use WeBWorK::CGI;
use WeBWorK::File::Classlist;
+use WeBWorK::DB;
use WeBWorK::Utils qw(readFile readDirectory cryptPassword);
use constant HIDE_USERS_THRESHHOLD => 200;
use constant EDIT_FORMS => [qw(cancelEdit saveEdit)];
@@ -1328,6 +1329,10 @@
my %record = %$record;
my $user_id = $record{user_id};
+ unless (WeBWorK::DB::check_user_id($user_id) ) { # try to catch lines with bad characters
+ push @skipped, $user_id;
+ next;
+ }
if ($user_id eq $user) { # don't replace yourself!!
push @skipped, $user_id;
next;
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:15:12
|
Log Message:
-----------
remove commented out cruft
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ProblemSetDetail.pm
Revision Data
-------------
Index: ProblemSetDetail.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm,v
retrieving revision 1.79
retrieving revision 1.80
diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm -u -r1.79 -r1.80
--- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetDetail.pm
@@ -1794,14 +1794,6 @@
1, # prune against path relative to $templates
);
- # this just takes too much time to search
-# my @problemFileList = listFilesRecursive(
-# $templates,
-# qr/\.pg$/i, # problem files don't say problem
-# qr/^(?:$skip|CVS)$/, # prune these directories
-# 0, # match against file name only
-# 1, # prune against path relative to $templates
-# );
# Display a useful warning message
if ($forUsers) {
@@ -2051,15 +2043,7 @@
$viewProblemLink = $self->systemLink($viewProblemPage, params => { effectiveUser => ($forOneUser ? $editForUser[0] : $userID)});
}
- ###-----
- ### The array @fields never gets used in the following, so
- ### I'm commenting it out. If there's a reason it should
- ### be here, someone else can add it back in and maybe
- ### comment why. Thanks, Gavin. -glarose 6/19/08
- ### my @fields = @{ PROBLEM_FIELDS() };
- ### push @fields, @{ USER_PROBLEM_FIELDS() } if $forOneUser;
- ###-----
-
+
my $problemFile = $r->param("problem.$problemID.source_file") || $problemRecord->source_file;
# warn of repeat problems
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:13:47
|
Log Message:
-----------
stop printing the problem path and the problem seed in hidden variables
students could use this to reverse engineer the problem using the library
website.
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
Problem.pm
Revision Data
-------------
Index: Problem.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm,v
retrieving revision 1.220
retrieving revision 1.221
diff -Llib/WeBWorK/ContentGenerator/Problem.pm -Llib/WeBWorK/ContentGenerator/Problem.pm -u -r1.220 -r1.221
--- lib/WeBWorK/ContentGenerator/Problem.pm
+++ lib/WeBWorK/ContentGenerator/Problem.pm
@@ -1129,15 +1129,17 @@
-value => $self->{editMode},
)
) if defined($self->{editMode}) and $self->{editMode} eq 'temporaryFile';
- print( CGI::hidden(
- -name => 'sourceFilePath',
- -value => $self->{problem}->{source_file}
- )) if defined($self->{problem}->{source_file});
+
+ # this is a security risk -- students can use this to find the source code for the problem
+# print( CGI::hidden(
+# -name => 'sourceFilePath',
+# -value => $self->{problem}->{source_file}
+# )) if defined($self->{problem}->{source_file});
- print( CGI::hidden(
- -name => 'problemSeed',
- -value => $r->param("problemSeed")
- )) if defined($r->param("problemSeed"));
+# print( CGI::hidden(
+# -name => 'problemSeed',
+# -value => $r->param("problemSeed")
+# )) if defined($r->param("problemSeed"));
# end of main form
print CGI::endform();
@@ -1171,27 +1173,6 @@
CGI::endform();
}
- ## feedback form url
- #my $feedbackPage = $urlpath->newFromModule("WeBWorK::ContentGenerator::Feedback",
- # courseID => $courseName);
- #my $feedbackURL = $self->systemLink($feedbackPage, authen => 0); # no authen info for form action
- #
- ##print feedback form
- #print
- # CGI::start_form(-method=>"POST", -action=>$feedbackURL),"\n",
- # $self->hidden_authen_fields,"\n",
- # CGI::hidden("module", __PACKAGE__),"\n",
- # CGI::hidden("set", $set->set_id),"\n",
- # CGI::hidden("problem", $problem->problem_id),"\n",
- # CGI::hidden("displayMode", $self->{displayMode}),"\n",
- # CGI::hidden("showOldAnswers", $will{showOldAnswers}),"\n",
- # CGI::hidden("showCorrectAnswers", $will{showCorrectAnswers}),"\n",
- # CGI::hidden("showHints", $will{showHints}),"\n",
- # CGI::hidden("showSolutions", $will{showSolutions}),"\n",
- # CGI::p({-align=>"left"},
- # CGI::submit(-name=>"feedbackForm", -label=>"Email instructor")
- # ),
- # CGI::endform(),"\n";
print $self->feedbackMacro(
module => __PACKAGE__,
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:12:32
|
Log Message:
-----------
minor variable name changes
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
renderViaXMLRPC.pm
Revision Data
-------------
Index: renderViaXMLRPC.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm -Llib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm -u -r1.1 -r1.2
--- lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm
+++ lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm
@@ -24,11 +24,10 @@
use strict;
use warnings;
+
package WeBWorK::ContentGenerator::renderViaXMLRPC;
use base qw(WeBWorK::ContentGenerator);
-
-
#use Crypt::SSLeay;
use XMLRPC::Lite;
use MIME::Base64 qw( encode_base64 decode_base64);
@@ -37,17 +36,17 @@
# configuration section -- point back to the current server to process answers
##################################################
use constant PROTOCOL => 'http';
-use constant HOSTURL => 'localhost';
+use constant HOSTNAME => 'localhost';
use constant HOSTPORT => 80;
-our $FULL_URL = PROTOCOL."://".HOSTURL; # .":".HOSTPORT;
+our $FULL_URL = PROTOCOL."://".HOSTNAME; # .":".HOSTPORT;
our $FORM_ACTION_URL = "/webwork2/html2xml"; # points back to current server
# use constant PROTOCOL => 'https'; # or 'http';
-# use constant HOSTURL => 'hosted2.webwork.rochester.edu'; # 'localhost';
+# use constant HOSTNAME => 'hosted2.webwork.rochester.edu'; # 'localhost';
# use constant HOSTPORT => 443; #( for secure https) # 80;
-# our $FULL_URL = PROTOCOL."://".HOSTURL; # .":".HOSTPORT;
-# our $FORM_ACTION_URL = "$FULL_URL/webwork2/html2xml"; # points back to current server
+# our $FULL_URL = PROTOCOL."://".HOSTNAME; # .":".HOSTPORT;
+# our $FORM_ACTION_URL = "/webwork2/html2xml"; # points back to current server
use constant TRANSPORT_METHOD => 'XMLRPC::Lite';
use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!!
@@ -112,7 +111,7 @@
$command = 'listLibraries' unless $command;
my $requestResult = TRANSPORT_METHOD
- #->uri('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_CLASS)
+ #->uri('http://'.HOSTNAME.':'.HOSTPORT.'/'.REQUEST_CLASS)
-> proxy($FULL_URL.'/'.REQUEST_URI);
my $input = $self->setInputTable();
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-14 01:10:56
|
Log Message:
-----------
major update which adds objective methods to the basic code of PG.
HEAD should be considered more beta than usual for a few days until minor glitches
are shaken out.
new modules needed:
PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash
Modified Files:
--------------
webwork2/conf:
global.conf.dist
Revision Data
-------------
Index: global.conf.dist
===================================================================
RCS file: /webwork/cvs/system/webwork2/conf/global.conf.dist,v
retrieving revision 1.221
retrieving revision 1.222
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.221 -r1.222
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -467,7 +467,7 @@
# required permissions
# GRANT SELECT ON webwork.* TO webworkRead@localhost IDENTIFIED BY 'passwordRO';
-# GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, ALTER, DROP, LOCK TABLES ON webwork.* TO webworkWrite@localhost IDENTIFIED BY 'passwordRW';
+# GRANT SELECT, INSERT, UPDATE, DELETE, CREATE, ALTER, DROP, INDEX, LOCK TABLES ON webwork.* TO webworkWrite@localhost IDENTIFIED BY 'passwordRW';
$database_dsn = "dbi:mysql:webwork";
$database_username = "webworkWrite";
@@ -899,10 +899,10 @@
# Locations of CAPA resources. (Only necessary if you need to use converted CAPA
# problems.)
-$pg{specialPGEnvironmentVars}{CAPA_Tools} = "/opt/webwork/CAPA/CAPA_Tools/",
-$pg{specialPGEnvironmentVars}{CAPA_MCTools} = "/opt/webwork/CAPA/CAPA_MCTools/",
-$pg{specialPGEnvironmentVars}{CAPA_GraphicsDirectory} = "$webworkDirs{htdocs}/CAPA_Graphics/",
-$pg{specialPGEnvironmentVars}{CAPA_Graphics_URL} = "$webworkURLs{htdocs}/CAPA_Graphics/",
+$pg{specialPGEnvironmentVars}{CAPA_Tools} = "$courseDirs{macros}/CAPA_Tools/",
+$pg{specialPGEnvironmentVars}{CAPA_MCTools} = "$courseDirs{macros}/CAPA_MCTools/",
+$pg{specialPGEnvironmentVars}{CAPA_GraphicsDirectory} = "$courseDirs{html}/CAPA_Graphics/",
+$pg{specialPGEnvironmentVars}{CAPA_Graphics_URL} = "$courseURLs{html}/CAPA_Graphics/",
# Size in pixels of dynamically-generated images, i.e. graphs.
$pg{specialPGEnvironmentVars}{onTheFlyImageSize} = 400,
@@ -963,6 +963,7 @@
# [qw(Chromatic)], # for Northern Arizona graph problems
# # -- follow instructions at libraries/nau_problib/lib/README to install
[qw(Applet FlashApplet JavaApplet)],
+ [qw(PGcore PGalias PGresource PGloadfiles PGanswergroup PGresponsegroup Tie::IxHash)],
];
##### Problem creation defaults
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-12 02:08:45
|
Log Message:
-----------
Clarification updates on documentation.
Rearranged the configuration lines to emphasize what has to be customized.
Modified Files:
--------------
webwork2/clients:
README
renderProblem.pl
Revision Data
-------------
Index: renderProblem.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/renderProblem.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -Lclients/renderProblem.pl -Lclients/renderProblem.pl -u -r1.4 -r1.5
--- clients/renderProblem.pl
+++ clients/renderProblem.pl
@@ -27,7 +27,7 @@
The formatting allows the browser presentation to be interactive with the
daemon running the script webwork2/lib/renderViaXMLRPC.pm
-
+Rembember to configure the local output file and display command !!!!!!!!
=cut
@@ -42,6 +42,15 @@
##################################################
# configuration section for client
##################################################
+# configure the local output file and display command !!!!!!!!
+
+use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html'; # client only
+use constant DISPLAY_COMMAND => 'open -a firefox '; # mac client only opens tempoutputfile above
+# other command lines for opening the html file gnome-open or firefox file.html
+
+# the rest can be configured later to use a different server
+
+# the rest can work!!
# use constant PROTOCOL => 'http';
# use constant HOSTNAME => 'localhost';
# use constant HOSTPORT => 80;
@@ -57,8 +66,7 @@
use constant TRANSPORT_METHOD => 'XMLRPC::Lite';
use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!!
use constant REQUEST_URI => 'mod_xmlrpc';
-use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html'; # client only
-use constant DISPLAY_COMMAND => 'open -a firefox '; # client only
+
use constant XML_PASSWORD => 'xmlwebwork';
use constant XML_COURSE => 'daemon_course';
Index: README
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/README,v
retrieving revision 1.5
retrieving revision 1.6
diff -Lclients/README -Lclients/README -u -r1.5 -r1.6
--- clients/README
+++ clients/README
@@ -12,9 +12,12 @@
The webwork_xmplrp_client and webwork_soap_client.pl have not been updated, but may still work.
to do:
- add facilities for inspecting libraries via xmlrpc and html2xml links
- figure out how to automate the configuration of these xmlrpc files
- Apache2::ServerUtil should do this?? but I can't figure out how.
+ â¢add facilities for inspecting libraries via xmlrpc and html2xml links
+ â¢figure out how to automate the configuration of these xmlrpc files
+ Apache2::ServerUtil should do this?? but I can't figure out how.
+ â¢I suspect that auxiliary html files and applets don't work yet.
+ â¢finish factoring the code into xmlrpc_clients_inc.pl
+ â¢get checkProblem working again.
I'm pretty sure that there is no security checking to insure that only appropriate
people have access to the xmlrpc webservice.
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-11 23:14:15
|
Log Message:
-----------
update clients to work with apache2 servers
update README
Modified Files:
--------------
webwork2/clients:
README
checkProblem.pl
hello_world_soap_client.pl
hello_world_xmlrpc_client.pl
renderProblem_rawoutput.pl
webwork_soap_client.pl
webwork_xmlrpc_client.pl
webwork_xmlrpc_inc.pl
Revision Data
-------------
Index: webwork_xmlrpc_client.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/webwork_xmlrpc_client.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -Lclients/webwork_xmlrpc_client.pl -Lclients/webwork_xmlrpc_client.pl -u -r1.4 -r1.5
--- clients/webwork_xmlrpc_client.pl
+++ clients/webwork_xmlrpc_client.pl
@@ -18,14 +18,14 @@
use MIME::Base64 qw( encode_base64 decode_base64);
# configuration section
-use constant PROTOCOL => 'https'; # or 'http';
-use constant HOSTURL => 'webwork.rochester.edu';
-use constant HOSTPORT => '443'; # or 80
+use constant PROTOCOL => 'http'; # or 'http';
+use constant HOSTURL => 'localhost';
+use constant HOSTPORT => '80'; # or 80
use constant TRANSPORT_METHOD => 'XMLRPC::Lite';
use constant REQUEST_CLASS =>'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!!
use constant REQUEST_URI =>'mod_xmlrpc';
use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html';
-use constant COURSE => 'daemon2_course';
+use constant COURSE => 'gage_course';
@@ -74,7 +74,7 @@
#->uri('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_CLASS)
-> proxy(PROTOCOL.'://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_URI);
- my $test = [3,4,5,6];
+ # my $test = [3,4,5,6];
my $input = setInputTable();
print "displayMode=",$input->{envir}->{displayMode},"\n";
local( $result);
@@ -146,7 +146,7 @@
$out = {
pw => 'geometry',
set => 'set0',
- library_name => 'rochesterLibrary',
+ library_name => 'Library',
command => 'all',
};
@@ -156,7 +156,7 @@
$out = {
pw => 'geometry',
set => 'set0',
- library_name => 'rochesterLibrary',
+ library_name => 'Library',
command => 'all',
answer_form_submitted => 1,
course => COURSE(),
Index: webwork_xmlrpc_inc.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/webwork_xmlrpc_inc.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lclients/webwork_xmlrpc_inc.pl -Lclients/webwork_xmlrpc_inc.pl -u -r1.2 -r1.3
--- clients/webwork_xmlrpc_inc.pl
+++ clients/webwork_xmlrpc_inc.pl
@@ -18,9 +18,9 @@
use MIME::Base64 qw( encode_base64 decode_base64);
# configuration section
-use constant PROTOCOL => 'https'; # or 'http';
-use constant HOSTURL => 'webwork.rochester.edu';
-use constant HOSTPORT => 443;
+use constant PROTOCOL => 'http'; # or 'http';
+use constant HOSTURL => 'localhost';
+use constant HOSTPORT => 80;
use constant TRANSPORT_METHOD => 'XMLRPC::Lite';
use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!!
use constant REQUEST_URI => 'mod_xmlrpc';
@@ -127,7 +127,7 @@
#password => 'geometry',
pw => 'geometry',
set => 'set0',
- library_name => 'rochesterLibrary',
+ library_name => 'Library',
command => 'all',
};
@@ -139,7 +139,7 @@
#password => 'geometry',
pw => 'geometry',
set => 'set0',
- library_name => 'rochesterLibrary',
+ library_name => 'Library',
command => 'all',
answer_form_submitted => 1,
course => COURSE(),
Index: renderProblem_rawoutput.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/renderProblem_rawoutput.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lclients/renderProblem_rawoutput.pl -Lclients/renderProblem_rawoutput.pl -u -r1.2 -r1.3
--- clients/renderProblem_rawoutput.pl
+++ clients/renderProblem_rawoutput.pl
@@ -28,13 +28,7 @@
-# $pg{displayModes} = [
-# "plainText", # display raw TeX for math expressions
-# "formattedText", # format math expressions using TtH
-# "images", # display math expressions as images generated by dvipng
-# "jsMath", # render TeX math expressions on the client side using jsMath
-# "asciimath", # render TeX math expressions on the client side using ASCIIMathML
-# ];
+
use constant DISPLAYMODE => 'images';
Index: checkProblem.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/checkProblem.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lclients/checkProblem.pl -Lclients/checkProblem.pl -u -r1.2 -r1.3
--- clients/checkProblem.pl
+++ clients/checkProblem.pl
@@ -5,8 +5,7 @@
This script will take a command and an input
file.
-It will list available libraries, list the contents of libraries
-or render the input file.
+It will render the input file.
All of this is done by contacting the webservice.
Index: hello_world_xmlrpc_client.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/hello_world_xmlrpc_client.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lclients/hello_world_xmlrpc_client.pl -Lclients/hello_world_xmlrpc_client.pl -u -r1.2 -r1.3
--- clients/hello_world_xmlrpc_client.pl
+++ clients/hello_world_xmlrpc_client.pl
@@ -3,9 +3,9 @@
#
use XMLRPC::Lite;
my $soap = XMLRPC::Lite
- -> proxy('https://math.webwork.rochester.edu:443/mod_xmlrpc/');
+ # -> proxy('https://math.webwork.rochester.edu/mod_xmlrpc/');
#-> proxy('https://devel.webwork.rochester.edu:8002/mod_xmlrpc/');
- # -> proxy('http://localhost/mod_xmlrpc/');
+ -> proxy('http://localhost/mod_xmlrpc/');
my $result = $soap->call("WebworkXMLRPC.hi");
Index: webwork_soap_client.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/webwork_soap_client.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lclients/webwork_soap_client.pl -Lclients/webwork_soap_client.pl -u -r1.1 -r1.2
--- clients/webwork_soap_client.pl
+++ clients/webwork_soap_client.pl
@@ -1,10 +1,10 @@
-#!/usr/local/bin/perl -w
+#!/usr/bin/perl -w
use SOAP::Lite;
# configuration section
-use constant HOSTURL => 'devel.webwork.rochester.edu';
-use constant HOSTPORT => 8002;
+use constant HOSTURL => 'localhost';
+use constant HOSTPORT => 80;
use constant TRANSPORT_METHOD => 'SOAP::Lite';
use constant REQUEST_CLASS =>'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!!
use constant REQUEST_URI =>'mod_soap';
Index: hello_world_soap_client.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/hello_world_soap_client.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lclients/hello_world_soap_client.pl -Lclients/hello_world_soap_client.pl -u -r1.2 -r1.3
--- clients/hello_world_soap_client.pl
+++ clients/hello_world_soap_client.pl
@@ -3,10 +3,10 @@
use SOAP::Lite;
my $soap = SOAP::Lite
--> uri('https://math.webwork.rochester.edu/WebworkXMLRPC')
--> proxy('https://math.webwork.rochester.edu/mod_soap/WebworkWebservice');
-#-> uri('http://localhost/WebworkXMLRPC')
-#-> proxy('http://localhost/mod_soap/WebworkWebservice');
+#-> uri('http://math.webwork.rochester.edu/WebworkXMLRPC')
+#-> proxy('https://math.webwork.rochester.edu/mod_soap/WebworkWebservice');
+-> uri('http://localhost/WebworkXMLRPC')
+-> proxy('http://localhost/mod_soap/WebworkWebservice');
#-> uri('https://devel.webwork.rochester.edu:8002/WebworkXMLRPC')
#-> proxy('https://devel.webwork.rochester.edu:8002/mod_soap/WebworkWebservice');
Index: README
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/README,v
retrieving revision 1.4
retrieving revision 1.5
diff -Lclients/README -Lclients/README -u -r1.4 -r1.5
--- clients/README
+++ clients/README
@@ -1,3 +1,26 @@
+2010.05.11
+
+At this point renderProblem.pl is the most up to date and works with BBedit to
+to send a local file to an xmlserver (mod_xmlrpc) to be rendered. In addition the returned'
+file's question form action url is pointed to the same server with the path ending in xml2html.
+This allows one to enter answers and test whether they work.
+
+There were changes to webwork2/lib/WebworkWebservice.pm to make it work with Apache2.
+There were also changes to webwork2/lib/WeBWorK/URLpath.pm and a new
+module webwork2/lib/WeBWorK/ContentGenerator/xmlViaHTTP.pm
+
+The webwork_xmplrp_client and webwork_soap_client.pl have not been updated, but may still work.
+
+to do:
+ add facilities for inspecting libraries via xmlrpc and html2xml links
+ figure out how to automate the configuration of these xmlrpc files
+ Apache2::ServerUtil should do this?? but I can't figure out how.
+
+ I'm pretty sure that there is no security checking to insure that only appropriate
+ people have access to the xmlrpc webservice.
+##############################################################################################
+
+
These test clients will process these two commands:
./webwork_xmlrpc_client.pl renderProblem input.txt >foo.txt
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-11 16:08:09
|
Log Message:
-----------
remove =53 error
Modified Files:
--------------
webwork2/clients:
input.txt
Revision Data
-------------
Index: input.txt
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/input.txt,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lclients/input.txt -Lclients/input.txt -u -r1.2 -r1.3
--- clients/input.txt
+++ clients/input.txt
@@ -25,7 +25,7 @@
This problem demonstrates how you enter numerical answers into WeBWorK. $PAR
Evaluate the expression \(3($a )($b -$c -2($d ))\):
- \{==53; ans_rule(10) \}
+ \{ ans_rule(10) \}
$BR
END_TEXT
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-11 16:07:34
|
Log Message:
-----------
updated to work with apache2 and the new html2xml
facility
Modified Files:
--------------
webwork2/clients:
renderProblem.pl
Revision Data
-------------
Index: renderProblem.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/renderProblem.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -Lclients/renderProblem.pl -Lclients/renderProblem.pl -u -r1.3 -r1.4
--- clients/renderProblem.pl
+++ clients/renderProblem.pl
@@ -1,108 +1,169 @@
#!/usr/bin/perl -w
-=pod
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# $CVSHeader$
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of either: (a) the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any later
+# version, or (b) the "Artistic License" which comes with this package.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
+# Artistic License for more details.
+################################################################################
+
+=head1 NAME
+
+webwork2/clients/renderProblem.pl
This script will take a file and send it to a WeBWorK daemon webservice
to have it rendered. The result is split into the basic HTML rendering
-and evaluation of answers and then passed to Safari for printing.
+and evaluation of answers and then passed to a browser for printing.
-The formatting allows the Safari presentation to be interactive with the
-daemon running on webhost.math.rochester.edu
+The formatting allows the browser presentation to be interactive with the
+daemon running the script webwork2/lib/renderViaXMLRPC.pm
=cut
+use strict;
+use warnings;
+
+package WeBWorK::ContentGenerator::renderViaXMLRPC_client;
+use Crypt::SSLeay; # needed for https
use XMLRPC::Lite;
use MIME::Base64 qw( encode_base64 decode_base64);
-#require "webwork_xmlrpc_inc.pl";
-# configuration section
-use constant PROTOCOL => 'https'; # or 'http';
-use constant HOSTURL => 'webwork.rochester.edu';
-use constant HOSTPORT => 443;
+##################################################
+# configuration section for client
+##################################################
+# use constant PROTOCOL => 'http';
+# use constant HOSTNAME => 'localhost';
+# use constant HOSTPORT => 80;
+# our $FORM_ACTION_URL ='http://localhost/webwork2/html2xml';
+
+
+use constant PROTOCOL => 'https'; # or 'http';
+use constant HOSTNAME => 'hosted2.webwork.rochester.edu'; # 'localhost';
+use constant HOSTPORT => 443; #( for secure https) # 80;
+our $FULL_URL = PROTOCOL."://".HOSTNAME; # .":".HOSTPORT;
+our $FORM_ACTION_URL = "$FULL_URL/webwork2/html2xml"; # server parameter
+
use constant TRANSPORT_METHOD => 'XMLRPC::Lite';
use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!!
use constant REQUEST_URI => 'mod_xmlrpc';
-use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html';
-use constant DISPLAY_COMMAND => 'open -a safari ';
-use constant COURSE => 'daemon2_course';
+use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html'; # client only
+use constant DISPLAY_COMMAND => 'open -a firefox '; # client only
+
+use constant XML_PASSWORD => 'xmlwebwork';
+use constant XML_COURSE => 'daemon_course';
+
-# $pg{displayModes} = [
-# "plainText", # display raw TeX for math expressions
-# "formattedText", # format math expressions using TtH
-# "images", # display math expressions as images generated by dvipng
-# "jsMath", # render TeX math expressions on the client side using jsMath
-# "asciimath", # render TeX math expressions on the client side using ASCIIMathML
-# ];
use constant DISPLAYMODE => 'images'; # tex and jsMath are other possibilities.
-my @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf
+our @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf
+
+##################################################
# end configuration section
+##################################################
+sub new {
+ my $self = {
+ output => '',
+ encodedSource => '',
+ self => '',
+ inputs_ref => { AnSwEr0001 => '',
+ AnSwEr0002 => '',
+ AnSwEr0003 => '',
+ },,
+ };
+
+ bless $self;
+}
+our $xmlrpc_client = new WeBWorK::ContentGenerator::renderViaXMLRPC_client;
+
+##################################################
+# input/output section
+##################################################
-#print STDERR "inputs are ", join (" | ", @ARGV), "\n";
our $source;
-our $encodedSource;
our $rh_result;
# filter mode main code
undef $/;
$source = <>; #slurp input
-$encodedSource = encodeSource($source);
+$xmlrpc_client->{encodedSource} = encodeSource($source);
$/ =1;
-xmlrpcCall('renderProblem');
+#xmlrpcCall('renderProblem');
+$xmlrpc_client->xmlrpcCall('renderProblem');
+
+
+local(*FH);
+open(FH, '>'.TEMPOUTPUTFILE) or die "Can't open file ".TEMPOUTPUTFILE()." for writing";
+print FH $xmlrpc_client->{output} ;
+close(FH);
+
+system(DISPLAY_COMMAND().TEMPOUTPUTFILE());
+
+##################################################
+# end input/output section
+##################################################
+
+
+our $result;
-# end filter main code
+##################################################
+# Utilities --
+# this code is identical between renderProblem.pl and renderViaXMLRPC.pm
+##################################################
sub xmlrpcCall {
- my $command = shift;
- $command = 'listLibraries' unless $command;
+ my $self = shift;
+ my $command = shift;
+ $command = 'listLibraries' unless $command;
my $requestResult = TRANSPORT_METHOD
- #->uri('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_CLASS)
- -> proxy(PROTOCOL.'://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_URI);
-
- my $test = [3,4,5,6];
- my $input = setInputTable();
- #print "displayMode=",$input->{envir}->{displayMode},"\n";
+ #->uri('http://'.HOSTNAME.':'.HOSTPORT.'/'.REQUEST_CLASS)
+ -> proxy($FULL_URL.'/'.REQUEST_URI);
+
+ my $input = $self->setInputTable();
local( $result);
# use eval to catch errors
eval { $result = $requestResult->call(REQUEST_CLASS.'.'.$command,$input) };
print STDERR "There were a lot of errors\n" if $@;
- print "Errors: \n $@\n End Errors\n" if $@;
-
- #print "result is|", ref($result),"|";
-
- unless (ref($result) and $result->fault) {
+ print STDERR "Errors: \n $@\n End Errors\n" if $@;
- $rh_result = $result->result();
-
- # look at output
-
- local(*FH);
- open(FH, '>'.TEMPOUTPUTFILE) or die "Can't open file ".TEMPOUTPUTFILE()." for writing";
- print FH formatRenderedProblem($rh_result);
- close(FH);
-
- system(DISPLAY_COMMAND().TEMPOUTPUTFILE());
- #print pretty_print_rh($result->result()),"\n"; #$result->result()
+
+
+ unless (ref($result) and $result->fault) {
+ my $rh_result = $result->result();
+ #print STDERR pretty_print_rh($rh_result);
+ $self->{output} = $self->formatRenderedProblem($rh_result);
+
} else {
- print 'oops ', join ', ',
+ $self->{output} = 'Error from server: ', join( ",\n ",
$result->faultcode,
- $result->faultstring;
+ $result->faultstring);
}
}
sub encodeSource {
+ my $source = shift;
encode_base64($source);
}
+
+
sub pretty_print_rh {
shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
my $rh = shift;
@@ -145,30 +206,29 @@
}
sub setInputTable_for_listLib {
- $out = {
- #password => 'geometry',
- pw => 'geometry',
+ my $self = shift;
+ my $out = {
+ pw => XML_PASSWORD(),
set => 'set0',
- library_name => 'rochesterLibrary',
+ library_name => 'Library',
command => 'all',
};
$out;
}
sub setInputTable {
- $out = {
- #password => 'geometry',
- pw => 'geometry',
- set => 'set0',
- library_name => 'rochesterLibrary',
- command => 'all',
+ my $self = shift;
+ my $out = {
+ pw => XML_PASSWORD(),
+ library_name => 'Library',
+ command => 'renderProblem',
answer_form_submitted => 1,
- course => COURSE(),
+ course => XML_COURSE(),
extra_packages_to_load => [qw( AlgParserWithImplicitExpand Expr
ExprWithImplicitExpand AnswerEvaluator
AnswerEvaluatorMaker
)],
- mode => DISPLAMODE(),
+ mode => DISPLAYMODE(),
modules_to_evaluate => [ qw(
Exporter
DynaLoader
@@ -195,14 +255,14 @@
Regression
)],
- envir => environment(),
+ envir => $self->environment(),
problem_state => {
num_of_correct_ans => 2,
num_of_incorrect_ans => 4,
recorded_score => 1.0,
},
- source => $encodedSource, #base64 encoded
+ source => $self->{encodedSource}, #base64 encoded
@@ -212,17 +272,18 @@
}
sub environment {
+ my $self = shift;
my $envir = {
answerDate => '4014438528',
- CAPA_Graphics_URL=>'http://webwork-db.math.rochester.edu/capa_graphics/',
- CAPA_GraphicsDirectory =>'/ww/webwork/CAPA/CAPA_Graphics/',
- CAPA_MCTools=>'/ww/webwork/CAPA/CAPA_MCTools/',
- CAPA_Tools=>'/ww/webwork/CAPA/CAPA_Tools/',
+ CAPA_Graphics_URL=>"not defined",
+ CAPA_GraphicsDirectory =>"not defined",
+ CAPA_MCTools=>"not defined",
+ CAPA_Tools=>'not defined',
cgiDirectory=>'Not defined',
cgiURL => 'Not defined',
classDirectory=> 'Not defined',
courseName=>'Not defined',
- courseScriptsDirectory=>'/ww/webwork/system/courseScripts/',
+ courseScriptsDirectory=>'not defined',
displayMode=>DISPLAYMODE,
dueDate=> '4014438528',
externalGif2EpsPath=>'not defined',
@@ -241,14 +302,10 @@
functVarDefault=> 'x',
functZeroLevelDefault=> 0.000001,
functZeroLevelTolDefault=>0.000001,
- htmlDirectory =>'/ww/webwork/courses/gage_course/html/',
- htmlURL =>'http://webwork-db.math.rochester.edu/gage_course/',
- inputs_ref => {
- AnSwEr1 => '',
- AnSwEr2 => '',
- AnSwEr3 => '',
- },
- macroDirectory=>'/ww/webwork/courses/gage_course/templates/macros/',
+ htmlDirectory =>'not defined',
+ htmlURL =>'not defined',
+ inputs_ref => $self->{inputs_ref},
+ macroDirectory=>'not defined',
numAbsTolDefault=>0.0000001,
numFormatDefault=>'%0.13g',
numOfAttempts=> 0,
@@ -268,27 +325,29 @@
sectionName => 'Gage',
sectionNumber => 1,
sessionKey=> 'Not defined',
- setNumber =>'MAAtutorial',
+ setNumber =>'not defined',
studentLogin =>'gage',
studentName => 'Mike Gage',
- tempDirectory => '/ww/htdocs/tmp/gage_course/',
- templateDirectory=>'/ww/webwork/courses/gage_course/templates/',
- tempURL=>'http://webwork-db.math.rochester.edu/tmp/gage_course/',
- webworkDocsURL => 'http://webwork.math.rochester.edu/webwork_gage_system_html',
+ tempDirectory => 'not defined',
+ templateDirectory=>'not defined',
+ tempURL=>'not defined',
+ webworkDocsURL => 'not defined',
};
$envir;
};
sub formatAnswerRow {
+ my $self = shift;
my $rh_answer = shift;
my $problemNumber = shift;
my $answerString = $rh_answer->{original_student_ans}||' ';
- my $correctAnswer = $rh_answer->{correct_ans};
+ my $correctAnswer = $rh_answer->{correct_ans}||'';
+ my $ans_message = $rh_answer->{ans_message};
my $score = ($rh_answer->{score}) ? 'Correct' : 'Incorrect';
my $row = qq{
<tr>
<td>
- $problemNumber
+ Prob: $problemNumber
</td>
<td>
$answerString
@@ -300,7 +359,7 @@
Correct answer is $correctAnswer
</td>
<td>
- <i></i>
+ <i>$ans_message</i>
</td>
</tr>\n
};
@@ -308,10 +367,11 @@
}
sub formatRenderedProblem {
+ my $self = shift;
my $rh_result = shift; # wrap problem in formats
my $problemText = decode_base64($rh_result->{text});
my $rh_answers = $rh_result->{answers};
-
+ my $encodedSource = $self->{encodedSource}||'foobar';
my $warnings = '';
if ( defined ($rh_result->{WARNINGS}) and $rh_result->{WARNINGS} ){
$warnings = "<div style=\"background-color:pink\">
@@ -323,17 +383,21 @@
my $answerTemplate = q{<hr>ANSWERS <table border="3" align="center">};
my $problemNumber = 1;
foreach my $key (sort keys %{$rh_answers}) {
- $answerTemplate .= formatAnswerRow($rh_answers->{$key}, $problemNumber++);
+ $answerTemplate .= $self->formatAnswerRow($rh_answers->{$key}, $problemNumber++);
}
$answerTemplate .= q{</table> <hr>};
my $problemTemplate = <<ENDPROBLEMTEMPLATE;
-
+<html>
+<head>
+<title>WeBWorK Editor</title>
+</head>
+<body>
$answerTemplate
$warnings
- <form action="http://webhost.math.rochester.edu/webworkdocs/ww/render" method="post">
+ <form action="$FORM_ACTION_URL" method="post">
$problemText
<input type="hidden" name="answersSubmitted" value="1">
<input type="hidden" name="problemAddress" value="probSource">
@@ -342,7 +406,8 @@
<input type="hidden" name="pathToProblemFile" value="foobar">
<p><input type="submit" name="submit" value="submit answers"></p>
</form>
-
+</body>
+</html>
ENDPROBLEMTEMPLATE
@@ -350,3 +415,6 @@
$problemTemplate;
}
+
+
+1;
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-11 15:53:36
|
Log Message:
-----------
update to work with Apache2
Modified Files:
--------------
webwork2/lib/WebworkWebservice:
LibraryActions.pm
MathTranslators.pm
RenderProblem.pm
Revision Data
-------------
Index: RenderProblem.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WebworkWebservice/RenderProblem.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/WebworkWebservice/RenderProblem.pm -Llib/WebworkWebservice/RenderProblem.pm -u -r1.8 -r1.9
--- lib/WebworkWebservice/RenderProblem.pm
+++ lib/WebworkWebservice/RenderProblem.pm
@@ -21,7 +21,7 @@
use sigtrap;
use Carp;
use Safe;
-use Apache;
+#use Apache;
use WeBWorK::CourseEnvironment;
use WeBWorK::PG::Translator;
use WeBWorK::PG::Local;
@@ -358,10 +358,7 @@
WARNINGS => encode_base64($pg->{warnings} ),
problem_result => $pg->{result},
problem_state => $pg->{state},
- #PG_flag => $pg->{flags},
-
-
-
+ PG_flag => $pg->{flags},
};
# Filter out bad reference types
###################
@@ -374,8 +371,8 @@
open (DEBUGCODE, ">>$xmlDebugLog") || die "Can't open $xmlDebugLog";
print DEBUGCODE "\n\nStart xml encoding\n";
}
- xml_filter($out2->{answers});
+ $out2->{answers} = xml_filter($out2->{answers}); # check this -- it might not be working correctly
##################
close(DEBUGCODE) if $debugXmlCode;
###################
@@ -389,13 +386,13 @@
}
-
+# insures proper conversion to xml structure.
sub xml_filter {
my $input = shift;
my $level = shift || 0;
my $space=" ";
# Hack to filter out CODE references
- my $type = ref($input);
+ my $type = ref($input);
if (!defined($type) or !$type ) {
print DEBUGCODE $space x $level." : scalar -- not converted\n" if $debugXmlCode;
} elsif( $type =~/HASH/i or "$input"=~/HASH/i) {
@@ -410,11 +407,14 @@
} elsif( $type=~/ARRAY/i or "$input"=~/ARRAY/i) {
print DEBUGCODE " "x$level."ARRAY reference with ".@{$input}." elements will be investigated\n" if $debugXmlCode;
$level++;
+ my $tmp = [];
foreach my $item (@{$input}) {
$item = xml_filter($item,$level);
+ push @$tmp, $item;
}
+ $input = $tmp;
$level--;
- print DEBUGCODE " "x$level."ARRAY reference completed \n" if $debugXmlCode;
+ print DEBUGCODE " "x$level."ARRAY reference completed",join(" ",@$input),"\n" if $debugXmlCode;
} elsif($type =~ /CODE/i or "$input" =~/CODE/i) {
$input = "CODE reference";
print DEBUGCODE " "x$level."CODE reference, converted $input\n" if $debugXmlCode;
Index: MathTranslators.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WebworkWebservice/MathTranslators.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/WebworkWebservice/MathTranslators.pm -Llib/WebworkWebservice/MathTranslators.pm -u -r1.2 -r1.3
--- lib/WebworkWebservice/MathTranslators.pm
+++ lib/WebworkWebservice/MathTranslators.pm
@@ -17,7 +17,7 @@
use sigtrap;
use Carp;
use Safe;
-use Apache;
+#use Apache;
use WeBWorK::PG::Translator;
use WeBWorK::PG::IO;
use Benchmark;
Index: LibraryActions.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WebworkWebservice/LibraryActions.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WebworkWebservice/LibraryActions.pm -Llib/WebworkWebservice/LibraryActions.pm -u -r1.4 -r1.5
--- lib/WebworkWebservice/LibraryActions.pm
+++ lib/WebworkWebservice/LibraryActions.pm
@@ -18,7 +18,7 @@
use sigtrap;
use Carp;
use Safe;
-use Apache;
+#use Apache;
use WeBWorK::Utils;
use WeBWorK::CourseEnvironment;
use WeBWorK::PG::Translator;
@@ -110,7 +110,7 @@
$out->{error} = "Could not find library:".$rh->{library_name}.":";
return($out);
}
- #warn "library directory path is $dirPath";
+ warn "library directory path is $dirPath";
my @outListLib;
my $wanted = sub {
my $name = $File::Find::name;
@@ -125,7 +125,7 @@
my $command = $rh->{command};
$command = 'all' unless defined($command);
$command eq 'all' && do {
- find({wanted=>$wanted,follow=>1 }, $dirPath);
+ find({wanted=>$wanted,follow_fast=>1 }, $dirPath);
@outListLib = sort @outListLib;
$out->{ra_out} = \@outListLib;
$out->{text} = join("\n", @outListLib);
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-11 15:52:58
|
Log Message:
-----------
update WebworkWebservice to handle bin/renderProblem.pl
Modified Files:
--------------
webwork2/lib:
WebworkWebservice.pm
Revision Data
-------------
Index: WebworkWebservice.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WebworkWebservice.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WebworkWebservice.pm -Llib/WebworkWebservice.pm -u -r1.4 -r1.5
--- lib/WebworkWebservice.pm
+++ lib/WebworkWebservice.pm
@@ -4,49 +4,38 @@
BEGIN {
$main::VERSION = "2.1";
- my $webwork_directory = $ENV{WEBWORK_ROOT};
-
+ #use Apache;
+ use Cwd;
+ use WeBWorK::PG::Local;
+# warn "my first webwork $webwork_directory";
+#
+# my $webwork_directory = $ENV{WEBWORK_ROOT};
+# warn "my first webwork $webwork_directory";
+# $webwork_directory2 =Cwd::cwd();
+# chomp $webwork_directory2;
+# $webwork_directory2 =~ s|/lib/?$||; # this will usually get the right webwork home directory
+# warn "Assuming webwork directory is |$webwork_directory| and |$webwork_directory2|", $webwork_directory eq $webwork_directory2;
+# #WTF??? why don't these two methods give me the same directory name?
+
+ my $webwork_directory = '/opt/webwork/webwork2';
+
eval "use lib '$webwork_directory/lib'"; die $@ if $@;
eval "use WeBWorK::CourseEnvironment"; die $@ if $@;
my $ce = new WeBWorK::CourseEnvironment({ webwork_dir => $webwork_directory });
my $webwork_url = $ce->{webwork_url};
my $pg_dir = $ce->{pg_dir};
-# my $webwork_htdocs_url = $ce->{webwork_htdocs_url};
-# my $webwork_htdocs_dir = $ce->{webwork_htdocs_dir};
-# my $webwork_courses_url = $ce->{webwork_courses_url};
-# my $webwork_courses_dir = $ce->{webwork_courses_dir};
eval "use lib '$pg_dir/lib'"; die $@ if $@;
$WebworkWebservice::WW_DIRECTORY = $webwork_directory;
$WebworkWebservice::PG_DIRECTORY = $pg_dir;
$WebworkWebservice::SeedCE = $ce;
- $WebworkWebservice::HOST_NAME = Apache->server->server_hostname;
- $WebworkWebservice::HOST_PORT = Apache->server->port;
- $WebworkWebservice::PASSWORD = 'geometry';
+ $WebworkWebservice::HOST_NAME = 'localhost'; #Apache->server->server_hostname;
+ $WebworkWebservice::HOST_PORT = '80'; #Apache->server->port;
+ $WebworkWebservice::PASSWORD = 'xmluser';
$WebworkWebservice::COURSENAME = 'daemon2_course'; # default course
}
-use Apache;
-use WeBWorK::PG::Local;
-
-#use lib '/home/gage/webwork/webwork-modperl/lib';
-#use lib '/home/gage/webwork/pg/lib';
-
-#$Webservice::HOST_PATH = "http://$Webservice::HOST_NAME";
-#$Webservice::HOST_PATH .= ":$Webservice::HOST_PORT"
-# unless ($Webservice::HOST_PORT == 80 );
-
-# warn "webwork_directory = $WebworkWebservice::WW_DIRECTORY\n\t";
-# warn "pg_directory = $WebworkWebservice::PG_DIRECTORY\n\t";
-# warn "seedCE = $WebworkWebservice::SeedCE\n\t";
-# warn "host name = $WebworkWebservice::HOST_NAME\n\t";
-
-#FIXME port is not being set!
-# warn "host port = $Webservice::HOST_PORT\n\t";
-
-# #warn "host path = $Webservice::HOST_PATH\n\t";
-# warn " password $WebworkWebservice::PASSWORD\n\t";
use strict;
###############################################################################
@@ -57,7 +46,9 @@
shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
my $rh = shift;
my $indent = shift || 0;
+
my $out = "";
+ return $out if $indent>10;
my $type = ref($rh);
if (defined($type) and $type) {
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-11 15:50:37
|
Log Message:
-----------
add support for the xml2html features
Added Files:
-----------
webwork2/lib/WeBWorK/ContentGenerator:
renderViaXMLRPC.pm
Revision Data
-------------
--- /dev/null
+++ lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm
@@ -0,0 +1,399 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
+# $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/renderViaXMLRPC.pm,v 1.1 2010/05/11 15:27:08 gage Exp $
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of either: (a) the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any later
+# version, or (b) the "Artistic License" which comes with this package.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the
+# Artistic License for more details.
+################################################################################
+
+=head1 NAME
+
+WeBWorK::ContentGenerator::ProblemRenderer - renderViaXMLRPC is an HTML
+front end for calls to the xmlrpc webservice
+
+=cut
+
+use strict;
+use warnings;
+
+package WeBWorK::ContentGenerator::renderViaXMLRPC;
+use base qw(WeBWorK::ContentGenerator);
+
+
+
+#use Crypt::SSLeay;
+use XMLRPC::Lite;
+use MIME::Base64 qw( encode_base64 decode_base64);
+
+##################################################
+# configuration section -- point back to the current server to process answers
+##################################################
+use constant PROTOCOL => 'http';
+use constant HOSTURL => 'localhost';
+use constant HOSTPORT => 80;
+our $FULL_URL = PROTOCOL."://".HOSTURL; # .":".HOSTPORT;
+our $FORM_ACTION_URL = "/webwork2/html2xml"; # points back to current server
+
+
+# use constant PROTOCOL => 'https'; # or 'http';
+# use constant HOSTURL => 'hosted2.webwork.rochester.edu'; # 'localhost';
+# use constant HOSTPORT => 443; #( for secure https) # 80;
+# our $FULL_URL = PROTOCOL."://".HOSTURL; # .":".HOSTPORT;
+# our $FORM_ACTION_URL = "$FULL_URL/webwork2/html2xml"; # points back to current server
+
+use constant TRANSPORT_METHOD => 'XMLRPC::Lite';
+use constant REQUEST_CLASS => 'WebworkXMLRPC'; # WebworkXMLRPC is used for soap also!!
+use constant REQUEST_URI => 'mod_xmlrpc';
+use constant TEMPOUTPUTFILE => '/Users/gage/Desktop/renderProblemOutput.html'; # client only
+use constant DISPLAY_COMMAND => 'open -a firefox '; # client only
+
+use constant XML_PASSWORD => 'xmlwebwork';
+use constant XML_COURSE => 'daemon_course';
+
+
+use constant DISPLAYMODE => 'images'; # tex and jsMath are other possibilities.
+
+
+our @COMMANDS = qw( listLibraries renderProblem ); #listLib readFile tex2pdf
+
+
+##################################################
+# end configuration section
+##################################################
+
+##################################################
+# input/output section
+##################################################
+
+
+sub pre_header_initialize {
+ my ($self) = @_;
+ my $r = $self->r;
+ my $db = new WeBWorK::DB($r->ce->{dbLayout});
+ $self->{encodedSource} = $r->param('problemSource');
+ my %inputs_ref;
+ foreach my $key ( keys %{ $r->{paramcache} } ) {
+ $inputs_ref{$key} = $r->param("$key");
+ }
+ $self->{inputs_ref} = \%inputs_ref;
+ print STDERR pretty_print_rh($r->{paramcache});
+ $self->xmlrpcCall('renderProblem'); # takes from {encodedSource}; result in {output}
+
+ }
+
+sub content {
+ my ($self) = @_;
+ print $self->{output};
+}
+
+##################################################
+# end input/output section
+##################################################
+
+
+our $result;
+
+##################################################
+# Utilities --
+# this code is identical between renderProblem.pl and renderViaXMLRPC.pm
+##################################################
+
+sub xmlrpcCall {
+ my $self = shift;
+ my $command = shift;
+ $command = 'listLibraries' unless $command;
+
+ my $requestResult = TRANSPORT_METHOD
+ #->uri('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_CLASS)
+ -> proxy($FULL_URL.'/'.REQUEST_URI);
+
+ my $input = $self->setInputTable();
+ local( $result);
+ # use eval to catch errors
+ eval { $result = $requestResult->call(REQUEST_CLASS.'.'.$command,$input) };
+ print STDERR "There were a lot of errors\n" if $@;
+ print STDERR "Errors: \n $@\n End Errors\n" if $@;
+
+
+
+
+ unless (ref($result) and $result->fault) {
+ my $rh_result = $result->result();
+ #print STDERR pretty_print_rh($rh_result);
+ $self->{output} = $self->formatRenderedProblem($rh_result);
+
+ } else {
+ $self->{output} = 'Error from server: ', join( ",\n ",
+ $result->faultcode,
+ $result->faultstring);
+ }
+}
+
+sub encodeSource {
+ my $source = shift;
+ encode_base64($source);
+}
+
+
+sub pretty_print_rh {
+ shift if UNIVERSAL::isa($_[0] => __PACKAGE__);
+ my $rh = shift;
+ my $indent = shift || 0;
+ my $out = "";
+ my $type = ref($rh);
+
+ if (defined($type) and $type) {
+ $out .= " type = $type; ";
+ } elsif (! defined($rh )) {
+ $out .= " type = UNDEFINED; ";
+ }
+ return $out." " unless defined($rh);
+
+ if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) {
+ $out .= "{\n";
+ $indent++;
+ foreach my $key (sort keys %{$rh}) {
+ $out .= " "x$indent."$key => " . pretty_print_rh( $rh->{$key}, $indent ) . "\n";
+ }
+ $indent--;
+ $out .= "\n"." "x$indent."}\n";
+
+ } elsif (ref($rh) =~ /ARRAY/ or "$rh" =~/ARRAY/) {
+ $out .= " ( ";
+ foreach my $elem ( @{$rh} ) {
+ $out .= pretty_print_rh($elem, $indent);
+
+ }
+ $out .= " ) \n";
+ } elsif ( ref($rh) =~ /SCALAR/ ) {
+ $out .= "scalar reference ". ${$rh};
+ } elsif ( ref($rh) =~/Base64/ ) {
+ $out .= "base64 reference " .$$rh;
+ } else {
+ $out .= $rh;
+ }
+
+ return $out." ";
+}
+
+sub setInputTable_for_listLib {
+ my $self = shift;
+ my $out = {
+ pw => XML_PASSWORD,
+ set => 'set0',
+ library_name => 'Library',
+ command => 'all',
+ };
+
+ $out;
+}
+sub setInputTable {
+ my $self = shift;
+ my $out = {
+ pw => XML_PASSWORD,
+ library_name => 'Library',
+ command => 'renderProblem',
+ answer_form_submitted => 1,
+ course => XML_COURSE(),
+ extra_packages_to_load => [qw( AlgParserWithImplicitExpand Expr
+ ExprWithImplicitExpand AnswerEvaluator
+ AnswerEvaluatorMaker
+ )],
+ mode => DISPLAYMODE(),
+ modules_to_evaluate => [ qw(
+Exporter
+DynaLoader
+GD
+WWPlot
+Fun
+Circle
+Label
+PGrandom
+Units
+Hermite
+List
+Match
+Multiple
+Select
+AlgParser
+AnswerHash
+Fraction
+VectorField
+Complex1
+Complex
+MatrixReal1 Matrix
+Distributions
+Regression
+
+ )],
+ envir => $self->environment(),
+ problem_state => {
+
+ num_of_correct_ans => 2,
+ num_of_incorrect_ans => 4,
+ recorded_score => 1.0,
+ },
+ source => $self->{encodedSource}, #base64 encoded
+
+
+
+ };
+
+ $out;
+}
+
+sub environment {
+ my $self = shift;
+ my $envir = {
+ answerDate => '4014438528',
+ CAPA_Graphics_URL=>"not defined",
+ CAPA_GraphicsDirectory =>"not defined",
+ CAPA_MCTools=>"not defined",
+ CAPA_Tools=>'not defined',
+ cgiDirectory=>'Not defined',
+ cgiURL => 'Not defined',
+ classDirectory=> 'Not defined',
+ courseName=>'Not defined',
+ courseScriptsDirectory=>'not defined',
+ displayMode=>DISPLAYMODE,
+ dueDate=> '4014438528',
+ externalGif2EpsPath=>'not defined',
+ externalPng2EpsPath=>'not defined',
+ externalTTHPath=>'/usr/local/bin/tth',
+ fileName=>'set0/prob1a.pg',
+ formattedAnswerDate=>'6/19/00',
+ formattedDueDate=>'6/19/00',
+ formattedOpenDate=>'6/19/00',
+ functAbsTolDefault=> 0.0000001,
+ functLLimitDefault=>0,
+ functMaxConstantOfIntegration=> 1000000000000.0,
+ functNumOfPoints=> 5,
+ functRelPercentTolDefault=> 0.000001,
+ functULimitDefault=>1,
+ functVarDefault=> 'x',
+ functZeroLevelDefault=> 0.000001,
+ functZeroLevelTolDefault=>0.000001,
+ htmlDirectory =>'not defined',
+ htmlURL =>'not defined',
+ inputs_ref => $self->{inputs_ref},
+ macroDirectory=>'not defined',
+ numAbsTolDefault=>0.0000001,
+ numFormatDefault=>'%0.13g',
+ numOfAttempts=> 0,
+ numRelPercentTolDefault => 0.0001,
+ numZeroLevelDefault =>0.000001,
+ numZeroLevelTolDefault =>0.000001,
+ openDate=> '3014438528',
+ PRINT_FILE_NAMES_FOR => [ 'gage'],
+ probFileName => 'set0/prob1a.pg',
+ problemSeed => 1234,
+ problemValue =>1,
+ probNum => 13,
+ psvn => 54321,
+ psvnNumber=> 54321,
+ questionNumber => 1,
+ scriptDirectory => 'Not defined',
+ sectionName => 'Gage',
+ sectionNumber => 1,
+ sessionKey=> 'Not defined',
+ setNumber =>'not defined',
+ studentLogin =>'gage',
+ studentName => 'Mike Gage',
+ tempDirectory => 'not defined',
+ templateDirectory=>'not defined',
+ tempURL=>'not defined',
+ webworkDocsURL => 'not defined',
+ };
+ $envir;
+};
+
+sub formatAnswerRow {
+ my $self = shift;
+ my $rh_answer = shift;
+ my $problemNumber = shift;
+ my $answerString = $rh_answer->{original_student_ans}||' ';
+ my $correctAnswer = $rh_answer->{correct_ans}||'';
+ my $ans_message = $rh_answer->{ans_message};
+ my $score = ($rh_answer->{score}) ? 'Correct' : 'Incorrect';
+ my $row = qq{
+ <tr>
+ <td>
+ Prob: $problemNumber
+ </td>
+ <td>
+ $answerString
+ </td>
+ <td>
+ $score
+ </td>
+ <td>
+ Correct answer is $correctAnswer
+ </td>
+ <td>
+ <i>$ans_message</i>
+ </td>
+ </tr>\n
+ };
+ $row;
+}
+
+sub formatRenderedProblem {
+ my $self = shift;
+ my $rh_result = shift; # wrap problem in formats
+ my $problemText = decode_base64($rh_result->{text});
+ my $rh_answers = $rh_result->{answers};
+ my $encodedSource = $self->{encodedSource}||'foobar';
+ my $warnings = '';
+ if ( defined ($rh_result->{WARNINGS}) and $rh_result->{WARNINGS} ){
+ $warnings = "<div style=\"background-color:pink\">
+ <p >WARNINGS</p><p>".decode_base64($rh_result->{WARNINGS})."</p></div>";
+ }
+
+ ;
+ # collect answers
+ my $answerTemplate = q{<hr>ANSWERS <table border="3" align="center">};
+ my $problemNumber = 1;
+ foreach my $key (sort keys %{$rh_answers}) {
+ $answerTemplate .= $self->formatAnswerRow($rh_answers->{$key}, $problemNumber++);
+ }
+ $answerTemplate .= q{</table> <hr>};
+
+
+
+ my $problemTemplate = <<ENDPROBLEMTEMPLATE;
+<html>
+<head>
+<title>WeBWorK Editor</title>
+</head>
+<body>
+ $answerTemplate
+ $warnings
+ <form action="$FORM_ACTION_URL" method="post">
+ $problemText
+ <input type="hidden" name="answersSubmitted" value="1">
+ <input type="hidden" name="problemAddress" value="probSource">
+ <input type="hidden" name="problemSource" value="$encodedSource">
+ <input type="hidden" name="problemSeed" value="1234">
+ <input type="hidden" name="pathToProblemFile" value="foobar">
+ <p><input type="submit" name="submit" value="submit answers"></p>
+ </form>
+</body>
+</html>
+
+ENDPROBLEMTEMPLATE
+
+
+
+ $problemTemplate;
+}
+
+
+1;
|
|
From: Mike G. v. a. <we...@ma...> - 2010-05-11 15:48:56
|
Log Message:
-----------
add xml2html feature
Modified Files:
--------------
webwork2/lib/WeBWorK:
URLPath.pm
Revision Data
-------------
Index: URLPath.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/URLPath.pm,v
retrieving revision 1.36
retrieving revision 1.37
diff -Llib/WeBWorK/URLPath.pm -Llib/WeBWorK/URLPath.pm -u -r1.36 -r1.37
--- lib/WeBWorK/URLPath.pm
+++ lib/WeBWorK/URLPath.pm
@@ -45,6 +45,7 @@
root /
course_admin /admin/ -> logout, options, instructor_tools
+ html2xml /html2xml/
set_list /$courseID/
equation_display /$courseID/equation/
@@ -110,7 +111,7 @@
root => {
name => 'WeBWorK',
parent => '',
- kids => [ qw/course_admin set_list/ ],
+ kids => [ qw/course_admin html2xml set_list / ],
match => qr|^/|,
capture => [ qw// ],
produce => '/',
@@ -127,7 +128,16 @@
},
################################################################################
-
+ html2xml => {
+ name => 'html2xml',
+ parent => 'root', # 'set_list',
+ kids => [ qw// ],
+ match => qr|^html2xml/|,
+ capture => [ qw// ],
+ produce => 'html2xml/',
+ display => 'WeBWorK::ContentGenerator::renderViaXMLRPC',
+ },
+
set_list => {
name => '$courseID',
parent => 'root',
|
2 messages has been excluded from this view by a project administrator.
