[system] / branches / rel-2-4-patches / webwork2 / lib / WeBWorK / PG.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-4-patches/webwork2/lib/WeBWorK/PG.pm

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

Revision 526 Revision 635
… …
11 11
12=cut 12=cut
13 13
14use strict; 14use strict;
15use warnings; 15use warnings;
16use File::Path qw(rmtree);
16use File::Temp qw(tempdir); 17use File::Temp qw(tempdir);
17use WeBWorK::DB::Classlist; 18use WeBWorK::DB::Classlist;
18use WeBWorK::DB::WW; 19use WeBWorK::DB::WW;
19use WeBWorK::PG::Translator; 20use WeBWorK::PG::Translator;
20use WeBWorK::Problem; 21use WeBWorK::Problem;
21use WeBWorK::Utils qw(readFile formatDateTime); 22use WeBWorK::Utils qw(readFile formatDateTime writeTimingLogEntry);
22 23
23sub new($$$$$$$$) { 24sub new($$$$$$$$) {
24 my $invocant = shift; 25 my $invocant = shift;
25 my $class = ref($invocant) || $invocant; 26 my $class = ref($invocant) || $invocant;
26 my ( 27 my (
… …
34 $translationOptions, # hashref containing options for the 35 $translationOptions, # hashref containing options for the
35 # translator, such as whether to show 36 # translator, such as whether to show
36 # hints and the display mode to use 37 # hints and the display mode to use
37 ) = @_; 38 ) = @_;
38 39
39# # get database information 40 # write timing log entry
40# my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 41 writeTimingLogEntry($courseEnv, "WeBWorK::PG::new",
41# my $wwdb = WeBWorK::DB::WW->new($courseEnv); 42 "user=".$user->id.",problem=".$courseEnv->{courseName}."/".$set->id."/".$problem->id.",mode=".$translationOptions->{displayMode},
42# my $user = $classlist->getUser($userName); 43 "begin");
43# my $set = $wwdb->getSet($userName, $setName); 44
44# my $psvn = $wwdb->getPSVN($userName, $setName); 45 # install a local warn handler to collect warnings
45# 46 my $warnings = "";
46# my $problem; 47 local $SIG{__WARN__} = sub { $warnings .= shift }
47# if ($problemNumber =~ /^\d+$/) { 48 if $courseEnv->{pg}->{options}->{catchWarnings};
48# $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
49# } else {
50# # This is the fun part: if $problemNumber is NON-NUMERIC, the
51# # user wants to specify a PG file directly. We manufacture a
52# # Problem object using fake data and the specified source file.
53# # This is potentially dangerous since an untrusted user is
54# # allowed to specifiy an arbitrary file to be evaluated as PG.
55# # A user of PG.pm MUST MAKE SURE that if $problemNumber is
56# # supplied by an untrusted source (i.e. the Apache request),
57# # it is numberic. A simple
58# #
59# # die unless $problemNumber =~ /^\d+$/;
60# #
61# # should suffice.
62# $problem = WeBWorK::Problem->new(
63# id => 0,
64# set_id => $set->id,
65# login_id => $user->id,
66# source_file => $problemNumber,
67# # the rest of Problem's fields are not needed
68# );
69# }
70 49
71 # create a Translator 50 # create a Translator
72 warn "PG: creating a Translator\n"; 51 #warn "PG: creating a Translator\n";
73 my $translator = WeBWorK::PG::Translator->new; 52 my $translator = WeBWorK::PG::Translator->new;
74 53
75 # set the directory hash 54 # set the directory hash
76 warn "PG: setting the directory hash\n"; 55 #warn "PG: setting the directory hash\n";
77 $translator->rh_directories({ 56 $translator->rh_directories({
78 courseScriptsDirectory => $courseEnv->{webworkDirs}->{macros}, 57 courseScriptsDirectory => $courseEnv->{webworkDirs}->{macros},
79 macroDirectory => $courseEnv->{courseDirs}->{macros}, 58 macroDirectory => $courseEnv->{courseDirs}->{macros},
80 templateDirectory => $courseEnv->{courseDirs}->{templates}, 59 templateDirectory => $courseEnv->{courseDirs}->{templates},
81 tempDirectory => $courseEnv->{courseDirs}->{html_temp}, 60 tempDirectory => $courseEnv->{courseDirs}->{html_temp},
82 }); 61 });
83 62
84 # evaluate modules and "extra packages" 63 # evaluate modules and "extra packages"
85 warn "PG: evaluating modules and \"extra packages\"\n"; 64 #warn "PG: evaluating modules and \"extra packages\"\n";
86 my @modules = @{ $courseEnv->{pg}->{modules} }; 65 my @modules = @{ $courseEnv->{pg}->{modules} };
87 foreach my $module_packages_ref (@modules) { 66 foreach my $module_packages_ref (@modules) {
88 my ($module, @extra_packages) = @$module_packages_ref; 67 my ($module, @extra_packages) = @$module_packages_ref;
89 # the first item is the main package 68 # the first item is the main package
90 $translator->evaluate_modules($module); 69 $translator->evaluate_modules($module);
91 # the remaining items are "extra" packages 70 # the remaining items are "extra" packages
92 $translator->load_extra_packages(@extra_packages); 71 $translator->load_extra_packages(@extra_packages);
93 } 72 }
94 73
95 # set the environment (from defineProblemEnvir) 74 # set the environment (from defineProblemEnvir)
96 warn "PG: setting the environment (from defineProblemEnvir)\n"; 75 #warn "PG: setting the environment (from defineProblemEnvir)\n";
97 $translator->environment(defineProblemEnvir( 76 my $envir = defineProblemEnvir(
98 $courseEnv, 77 $courseEnv,
99 $user, 78 $user,
100 $key, 79 $key,
101 $set, 80 $set,
102 $problem, 81 $problem,
103 $psvn, 82 $psvn,
104 $formFields, 83 $formFields,
105 $translationOptions, 84 $translationOptions,
106 )); 85 );
86 $translator->environment($envir);
107 87
108 # initialize the Translator 88 # initialize the Translator
109 warn "PG: initializing the Translator\n"; 89 #warn "PG: initializing the Translator\n";
110 $translator->initialize(); 90 $translator->initialize();
111 91
112 # load PG.pl and dangerousMacros.pl using unrestricted_load 92 # load IO.pl, PG.pl, and dangerousMacros.pl using unrestricted_load
113 # i'd like to change this at some point to have the same sort of interface to global.conf 93 # i'd like to change this at some point to have the same sort of interface to global.conf
114 # that the module loading does -- have a list of macros to load unrestrictedly. 94 # that the module loading does -- have a list of macros to load unrestrictedly.
115 warn "PG: loading PG.pl and dangerousMacros.pl using unrestricted_load\n"; 95 #warn "PG: loading IO.pl, PG.pl, and dangerousMacros.pl using unrestricted_load\n";
96 foreach (qw(IO.pl PG.pl dangerousMacros.pl)) {
97 my $macroPath = $courseEnv->{webworkDirs}->{macros} . "/$_";
98 my $err = $translator->unrestricted_load($macroPath);
99 warn "Error while loading $macroPath: $err" if $err;
100 }
116 my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl"; 101 #my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl";
117 my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl"; 102 #my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl";
103 #my $io_pl = $courseEnv->{webworkDirs}->{macros} . "/IO.pl";
118 my $err = $translator->unrestricted_load($pg_pl); 104 #my $err = $translator->unrestricted_load($pg_pl);
119 warn "Error while loading $pg_pl: $err" if $err; 105 #warn "Error while loading $pg_pl: $err" if $err;
120 $err = $translator->unrestricted_load($dangerousMacros_pl); 106 #$err = $translator->unrestricted_load($dangerousMacros_pl);
121 warn "Error while loading $dangerousMacros_pl: $err" if $err; 107 #warn "Error while loading $dangerousMacros_pl: $err" if $err;
108 #$err = $translator->unrestricted_load($io_pl);
109 #warn "Error while loading $io_pl: $err" if $err;
122 110
123 # set the opcode mask (using default values) 111 # set the opcode mask (using default values)
124 warn "PG: setting the opcode mask (using default values)\n"; 112 #warn "PG: setting the opcode mask (using default values)\n";
125 $translator->set_mask(); 113 $translator->set_mask();
126 114
127 # store the problem source 115 # store the problem source
128 warn "PG: storing the problem source\n"; 116 #warn "PG: storing the problem source\n";
129 my $sourceFile = $problem->source_file; 117 my $sourceFile = $problem->source_file;
130 $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$sourceFile 118 $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$sourceFile
131 unless ($sourceFile =~ /^\//); 119 unless ($sourceFile =~ /^\//);
132 eval { $translator->source_string(readFile($sourceFile)) }; 120 eval { $translator->source_string(readFile($sourceFile)) };
133 if ($@) { 121 if ($@) {
… …
141EOF 129EOF
142 answers => {}, 130 answers => {},
143 result => {}, 131 result => {},
144 state => {}, 132 state => {},
145 errors => "Failed to read the problem source file.", 133 errors => "Failed to read the problem source file.",
146 warnings => undef, 134 warnings => $warnings,
147 flags => {error_flag => 1}, 135 flags => {error_flag => 1},
148 }, $class; 136 }, $class;
149 } 137 }
150 138
151 # install a safety filter (&safetyFilter) 139 # install a safety filter (&safetyFilter)
152 warn "PG: installing a safety filter\n"; 140 #warn "PG: installing a safety filter\n";
153 $translator->rf_safety_filter(\&safetyFilter); 141 $translator->rf_safety_filter(\&safetyFilter);
154 142
155 # translate the PG source into text 143 # translate the PG source into text
156 warn "PG: translating the PG source into text\n"; 144 #warn "PG: translating the PG source into text\n";
157 $translator->translate(); 145 $translator->translate();
146
147 # after we're done translating, we may have to clean up after the translator.
148 # for example, 'images' mode uses a tempdir for dvipng's temp files. We have
149 # to remove it.
150 if ($translationOptions->{displayMode} eq 'images' && $envir->{dvipngTempDir}) {
151 rmtree($envir->{dvipngTempDir}, 0, 0);
152 }
158 153
159 my ($result, $state); # we'll need these on the other side of the if block! 154 my ($result, $state); # we'll need these on the other side of the if block!
160 if ($translationOptions->{processAnswers}) { 155 if ($translationOptions->{processAnswers}) {
161 156
162 # process student answers 157 # process student answers
163 warn "PG: processing student answers\n"; 158 #warn "PG: processing student answers\n";
164 $translator->process_answers($formFields); 159 $translator->process_answers($formFields);
165 160
166 # retrieve the problem state and give it to the translator 161 # retrieve the problem state and give it to the translator
167 warn "PG: retrieving the problem state and giving it to the translator\n"; 162 #warn "PG: retrieving the problem state and giving it to the translator\n";
168 $translator->rh_problem_state({ 163 $translator->rh_problem_state({
169 recorded_score => $problem->status, 164 recorded_score => $problem->status,
170 num_of_correct_ans => $problem->num_correct, 165 num_of_correct_ans => $problem->num_correct,
171 num_of_incorrect_ans => $problem->num_incorrect, 166 num_of_incorrect_ans => $problem->num_incorrect,
172 }); 167 });
173 168
174 # determine an entry order -- the ANSWER_ENTRY_ORDER flag is built by 169 # determine an entry order -- the ANSWER_ENTRY_ORDER flag is built by
175 # the PG macro package (PG.pl) 170 # the PG macro package (PG.pl)
176 warn "PG: determining an entry order\n"; 171 #warn "PG: determining an entry order\n";
177 my @answerOrder = 172 my @answerOrder =
178 $translator->rh_flags->{ANSWER_ENTRY_ORDER} 173 $translator->rh_flags->{ANSWER_ENTRY_ORDER}
179 ? @{ $translator->rh_flags->{ANSWER_ENTRY_ORDER} } 174 ? @{ $translator->rh_flags->{ANSWER_ENTRY_ORDER} }
180 : keys %{ $translator->rh_evaluated_answers }; 175 : keys %{ $translator->rh_evaluated_answers };
181 176
182 # install a grader -- use the one specified in the problem, 177 # install a grader -- use the one specified in the problem,
183 # or fall back on the default from the course environment. 178 # or fall back on the default from the course environment.
184 # (two magic strings are accepted, to avoid having to 179 # (two magic strings are accepted, to avoid having to
185 # reference code when it would be difficult.) 180 # reference code when it would be difficult.)
186 warn "PG: installing a grader\n"; 181 #warn "PG: installing a grader\n";
187 my $grader = $translator->rh_flags->{PROBLEM_GRADER_TO_USE} 182 my $grader = $translator->rh_flags->{PROBLEM_GRADER_TO_USE}
188 || $courseEnv->{pg}->{options}->{grader}; 183 || $courseEnv->{pg}->{options}->{grader};
189 $grader = $translator->rf_std_problem_grader 184 $grader = $translator->rf_std_problem_grader
190 if $grader eq "std_problem_grader"; 185 if $grader eq "std_problem_grader";
191 $grader = $translator->rf_avg_problem_grader 186 $grader = $translator->rf_avg_problem_grader
… …
193 die "Problem grader $grader is not a CODE reference." 188 die "Problem grader $grader is not a CODE reference."
194 unless ref $grader eq "CODE"; 189 unless ref $grader eq "CODE";
195 $translator->rf_problem_grader($grader); 190 $translator->rf_problem_grader($grader);
196 191
197 # grade the problem 192 # grade the problem
198 warn "PG: grading the problem\n"; 193 #warn "PG: grading the problem\n";
199 ($result, $state) = $translator->grade_problem( 194 ($result, $state) = $translator->grade_problem(
200 answers_submitted => $translationOptions->{processAnswers}, 195 answers_submitted => $translationOptions->{processAnswers},
201 ANSWER_ENTRY_ORDER => \@answerOrder, 196 ANSWER_ENTRY_ORDER => \@answerOrder,
202 ); 197 );
203 198
204 } 199 }
200
201 # write timing log entry
202 writeTimingLogEntry($courseEnv, "WeBWorK::PG::new", "", "end");
205 203
206 # return an object which contains the translator and the results of 204 # return an object which contains the translator and the results of
207 # the translation process. this is DIFFERENT from the "format expected 205 # the translation process. this is DIFFERENT from the "format expected
208 # by Webwork.pm (and I believe processProblem8, but check.)" 206 # by Webwork.pm (and I believe processProblem8, but check.)"
209 return bless { 207 return bless {
… …
211 head_text => ${ $translator->r_header }, 209 head_text => ${ $translator->r_header },
212 body_text => ${ $translator->r_text }, 210 body_text => ${ $translator->r_text },
213 answers => $translator->rh_evaluated_answers, 211 answers => $translator->rh_evaluated_answers,
214 result => $result, 212 result => $result,
215 state => $state, 213 state => $state,
216 errors => $translator->errors, # *** what is this doing? 214 errors => $translator->errors,
217 warnings => undef, # *** gotta catch warnings eventually... 215 warnings => $warnings,
218 flags => $translator->rh_flags, 216 flags => $translator->rh_flags,
219 }, $class; 217 }, $class;
220} 218}
221 219
222# ----- 220# -----
… …
238 # PG environment variables 236 # PG environment variables
239 # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002 237 # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002
240 # any changes are noted by "ADDED:" or "REMOVED:" 238 # any changes are noted by "ADDED:" or "REMOVED:"
241 239
242 # Vital state information 240 # Vital state information
243 # ADDED: displayHintsQ, displaySolutionsQ, refreshMath2img 241 # ADDED: displayHintsQ, displaySolutionsQ, refreshMath2img,
242 # texDisposition
244 243
245 $envir{psvn} = $psvn; 244 $envir{psvn} = $psvn;
246 $envir{psvnNumber} = $envir{psvn}; 245 $envir{psvnNumber} = $envir{psvn};
247 $envir{probNum} = $problem->id; 246 $envir{probNum} = $problem->id;
248 $envir{questionNumber} = $envir{probNum}; 247 $envir{questionNumber} = $envir{probNum};
… …
253 $envir{languageMode} = $envir{displayMode}; 252 $envir{languageMode} = $envir{displayMode};
254 $envir{outputMode} = $envir{displayMode}; 253 $envir{outputMode} = $envir{displayMode};
255 $envir{displayHintsQ} = $options->{hints}; 254 $envir{displayHintsQ} = $options->{hints};
256 $envir{displaySolutionsQ} = $options->{solutions}; 255 $envir{displaySolutionsQ} = $options->{solutions};
257 $envir{refreshMath2img} = $options->{refreshMath2img}; 256 $envir{refreshMath2img} = $options->{refreshMath2img};
257 $envir{texDisposition} = "pdf"; # in webwork-modperl, we use pdflatex
258 258
259 # Problem Information 259 # Problem Information
260 # ADDED: courseName 260 # ADDED: courseName
261 261
262 $envir{openDate} = $set->open_date; 262 $envir{openDate} = $set->open_date;
263 $envir{formattedOpenDate} = formatDateTime($envir{openDate}); 263 $envir{formattedOpenDate} = formatDateTime($envir{openDate});
264 $envir{dueDate} = $set->due_date; 264 $envir{dueDate} = $set->due_date;
265 $envir{formattedDueDate} = formatDateTime($envir{dueDate}); 265 $envir{formattedDueDate} = formatDateTime($envir{dueDate});
266 $envir{answerDate} = $set->answer_date; 266 $envir{answerDate} = $set->answer_date;
267 $envir{formattedAnswerDate} = formatDateTime($envir{answerDate}); 267 $envir{formattedAnswerDate} = formatDateTime($envir{answerDate});
268 $envir{numOfAttempts} = $problem->num_correct + $problem->num_incorrect; 268 $envir{numOfAttempts} = ($problem->num_correct || 0) + ($problem->num_incorrect || 0);
269 $envir{problemValue} = $problem->value; 269 $envir{problemValue} = $problem->value;
270 $envir{sessionKey} = $key; 270 $envir{sessionKey} = $key;
271 $envir{courseName} = $courseEnv->{courseName}; 271 $envir{courseName} = $courseEnv->{courseName};
272 272
273 # Student Information 273 # Student Information
… …
286 # REMOVED: refSubmittedAnswers 286 # REMOVED: refSubmittedAnswers
287 287
288 $envir{inputs_ref} = $formFields; 288 $envir{inputs_ref} = $formFields;
289 289
290 # External Programs 290 # External Programs
291 # ADDED: externalLaTeXPath, externalDvipngPath, externalMath2imgPath 291 # ADDED: externalLaTeXPath, externalDvipngPath,
292 # externalGif2EpsPath, externalPng2EpsPath
292 293
293 $envir{externalTTHPath} = $courseEnv->{externalPrograms}->{tth}; 294 $envir{externalTTHPath} = $courseEnv->{externalPrograms}->{tth};
294 $envir{externalLaTeXPath} = $courseEnv->{externalPrograms}->{latex}; 295 $envir{externalLaTeXPath} = $courseEnv->{externalPrograms}->{latex};
295 $envir{externalDvipngPath} = $courseEnv->{externalPrograms}->{dvipng}; 296 $envir{externalDvipngPath} = $courseEnv->{externalPrograms}->{dvipng};
297 $envir{externalGif2EpsPath} = $courseEnv->{externalPrograms}->{gif2eps};
298 $envir{externalPng2EpsPath} = $courseEnv->{externalPrograms}->{png2eps};
296 $envir{externalMath2imgPath} = $courseEnv->{externalPrograms}->{math2img}; 299 $envir{externalGif2PngPath} = $courseEnv->{externalPrograms}->{gif2png};
297 300
298 # Directories and URLs 301 # Directories and URLs
299 # REMOVED: courseName 302 # REMOVED: courseName
300 # ADDED: dvipngTempDir 303 # ADDED: dvipngTempDir
301
302 304
303 $envir{cgiDirectory} = undef; 305 $envir{cgiDirectory} = undef;
304 $envir{cgiURL} = undef; 306 $envir{cgiURL} = undef;
305 $envir{classDirectory} = undef; 307 $envir{classDirectory} = undef;
306 $envir{courseScriptsDirectory} = $courseEnv->{webworkDirs}->{macros}."/"; 308 $envir{courseScriptsDirectory} = $courseEnv->{webworkDirs}->{macros}."/";
307 $envir{htmlDirectory} = $courseEnv->{courseDirs}->{html}."/"; 309 $envir{htmlDirectory} = $courseEnv->{courseDirs}->{html}."/";
308 $envir{htmlURL} = $courseEnv->{courseURLs}->{html}; 310 $envir{htmlURL} = $courseEnv->{courseURLs}->{html}."/";
309 $envir{macroDirectory} = $courseEnv->{courseDirs}->{macros}."/"; 311 $envir{macroDirectory} = $courseEnv->{courseDirs}->{macros}."/";
310 $envir{templateDirectory} = $courseEnv->{courseDirs}->{templates}."/"; 312 $envir{templateDirectory} = $courseEnv->{courseDirs}->{templates}."/";
311 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}."/"; 313 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}."/";
312 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp}; 314 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp}."/";
313 $envir{scriptDirectory} = undef; 315 $envir{scriptDirectory} = undef;
314 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs}; 316 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs}."/";
315 $envir{dvipngTempDir} = tempdir("webwork-dvipng-XXXXXXXX", TMPDIR => 1); 317 $envir{dvipngTempDir} = $options->{displayMode} eq 'images'
318 ? tempdir("webwork-dvipng-XXXXXXXX", DIR => $envir{tempDirectory})
319 : undef;
320
321 # Information for sending mail
322
323 $envir{mailSmtpServer} = $courseEnv->{mail}->{smtpServer};
324 $envir{mailSmtpSender} = $courseEnv->{mail}->{smtpSender};
316 325
317 # Default values for evaluating answers 326 # Default values for evaluating answers
318 327
319 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults}; 328 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults};
320 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults); 329 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults);
… …
348 $errorno = 0; ## don't report blank answer as error 357 $errorno = 0; ## don't report blank answer as error
349 return ($answer,$errorno); 358 return ($answer,$errorno);
350 } 359 }
351 # replace ^ with ** (for exponentiation) 360 # replace ^ with ** (for exponentiation)
352 # $answer =~ s/\^/**/g; 361 # $answer =~ s/\^/**/g;
353 # Return if forbidden characters are found 362 # Return if forbidden characters are found
354 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 363 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) {
355 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 364 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c;
356 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 365 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>";
357 return ($answer,$errorno); 366 return ($answer,$errorno);
358 } 367 }
Legend:
Removed from v.526  
changed lines
  Added in v.635
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9