[system] / trunk / webwork-modperl / lib / WebworkWebservice / RenderProblem.pm Repository:
ViewVC logotype

Diff of /trunk/webwork-modperl/lib/WebworkWebservice/RenderProblem.pm

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

Revision 3072 Revision 3073
1#!/usr/local/bin/perl -w 1#!/usr/local/bin/perl -w
2 2
3# Copyright (C) 2001 Michael Gage 3# Copyright (C) 2001 Michael Gage
4 4
5###############################################################################
6# The initial code simply initializes variables, defines addresses
7# for directories, defines some simple subroutines responders used in debugging
8# and makes sure that the appropriate CPAN library modules
9# are available. The main code begins below that with the initialization
10# of the PGtranslator5 module.
11###############################################################################
12 5
13# use lib '/home/gage/webwork/pg/lib';
14# use lib '/home/gage/webwork/webwork-modperl/lib';
15 6
16package WebworkWebservice::RenderProblem; 7package WebworkWebservice::RenderProblem;
17use WebworkWebservice; 8use WebworkWebservice;
18use base qw(WebworkWebservice); 9use base qw(WebworkWebservice);
19 10
… …
29use Carp; 20use Carp;
30use Safe; 21use Safe;
31use Apache; 22use Apache;
32use WeBWorK::CourseEnvironment; 23use WeBWorK::CourseEnvironment;
33use WeBWorK::PG::Translator; 24use WeBWorK::PG::Translator;
25use WeBWorK::PG::Local;
34use WeBWorK::DB; 26use WeBWorK::DB;
27use WeBWorK::DB::Record;
28use WeBWorK::DB::Record::UserProblem;
35use WeBWorK::Constants; 29use WeBWorK::Constants;
36use WeBWorK::Utils; 30use WeBWorK::Utils qw(runtime_use formatDateTime makeTempDirectory);
31use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
32use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
37use WeBWorK::PG::IO; 33use WeBWorK::PG::IO;
38use WeBWorK::PG::ImageGenerator; 34use WeBWorK::PG::ImageGenerator;
39use Benchmark; 35use Benchmark;
40use MIME::Base64 qw( encode_base64 decode_base64); 36use MIME::Base64 qw( encode_base64 decode_base64);
41 37
42print "rereading Webwork\n"; 38#print "rereading Webwork\n";
43 39
44 40
45our $WW_DIRECTORY = $WebworkWebservice::WW_DIRECTORY; 41our $WW_DIRECTORY = $WebworkWebservice::WW_DIRECTORY;
46our $PG_DIRECTORY = $WebworkWebservice::PG_DIRECTORY; 42our $PG_DIRECTORY = $WebworkWebservice::PG_DIRECTORY;
47our $COURSENAME = $WebworkWebservice::COURSENAME; 43our $COURSENAME = $WebworkWebservice::COURSENAME;
48our $HOST_NAME = $WebworkWebservice::HOST_NAME; 44our $HOST_NAME = $WebworkWebservice::HOST_NAME;
49our $HOSTURL ="http://$HOST_NAME:11002"; #FIXME 45our $HOSTURL ="http://$HOST_NAME:11002"; #FIXME
50our $ce =$WebworkWebservice::SeedCE; 46our $ce =$WebworkWebservice::SeedCE;
51 47# create a local course environment for some course
48 $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
52#print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce); 49#print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
53 50
54print "webwork is realy ready\n\n"; 51print "webwork is really ready\n\n";
55#other services 52#other services
56# File variables 53# File variables
57my $WARNINGS=''; 54#our $WARNINGS='';
58 55
59 56
60# imported constants 57# imported constants
61 58
62my $COURSE_TEMP_DIRECTORY = $ce->{courseDirs}->{html_tmp}; 59my $COURSE_TEMP_DIRECTORY = $ce->{courseDirs}->{html_tmp};
… …
94}; 91};
95 92
96 93
97 94
98 95
96
97
98
99sub renderProblem {
100
101 my $rh = shift;
102
103###########################################
104# Grab the course name, if this request is going to depend on
105# some course other than the default course
106###########################################
107 my $courseName;
108 my $ce;
109 my $db;
110 my $user;
111 my $beginTime = new Benchmark;
112 if (defined($rh->{course}) and $rh->{course}=~/\S/ ) {
113 $courseName = $rh->{course};
114 } else {
115 $courseName = $COURSENAME;
116 # use the default $ce
117 }
118 #FIXME put in check to make sure the course exists.
119 eval {
120 $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $courseName);
121 # Create database object for this course
122 $db = WeBWorK::DB->new($ce->{dbLayout});
123 };
124 $ce->{pg}->{options}->{catchWarnings};
125 #^FIXME need better way of determining whether the course actually exists.
126 if ($@) {
127 $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
128 $db = WeBWorK::DB->new($ce->{dbLayout});
129 }
130 my $user = $rh->{user};
131 $user = 'gage' unless defined $user and $user =~/\S/;
132
133###########################################
134# Authenticate this request
135###########################################
136
137
138
139###########################################
140# Determine the authorization level (permissions)
141###########################################
142
143
144
145
146###########################################
147# Determine the method for accessing data
148###########################################
149 my $problem_source_access = $rh->{problem_source_access};
150 # One of
151 # source_from_course_set_problem
152 # source_from_source_file_path
153 # source_from_request
154
155 my $data_access = $rh->{data_access};
156 # One of
157 # data_from_course
158 # data_from_request
159
160###########################################
161# Determine an effective user for this interaction
162# or create one if it is not given
163# In order: use effectiveUserName, studentLogin, or user or 'foobar'
164###########################################
165 my $effectiveUserName;
166 if (defined($rh->{effectiveUser}) and $rh->{effectiveUser}=~/\S/ ) {
167 $effectiveUserName = $rh->{effectiveUser};
168 } elsif (defined($rh->{envir}->{studentLogin}) and $rh->{envir}->{studentLogin}=~/\S/ ) {
169 $effectiveUserName = $rh->{envir}->{studentLogin};
170 } elsif (defined($user) and $user =~ /\S/ ) {
171 $effectiveUserName = $user;
172 } else {
173 $effectiveUserName = 'foobar';
174 }
175 ##################################################
176 my $effectiveUser = $db->getUser($effectiveUserName); # checked
177 my $effectiveUserPermissionLevel;
178 my $effectiveUserPassword;
179 unless (defined $effectiveUser ) {
180 $effectiveUser = $db->newUser;
181 $effectiveUserPermissionLevel = $db->newPermissionLevel;
182 $effectiveUserPassword = $db->newPassword;
183 $effectiveUser->user_id($effectiveUserName);
184 $effectiveUserPermissionLevel->user_id($effectiveUserName);
185 $effectiveUserPassword->user_id($effectiveUserName);
186 $effectiveUserPassword->password('');
187 $effectiveUser->last_name($rh->{envir}->{studentName}|| 'foobar');
188 $effectiveUser->first_name('');
189 $effectiveUser->student_id($rh->{envir}->{studentID}|| 'foobar');
190 $effectiveUser->email_address($rh->{envir}->{email}|| '');
191 $effectiveUser->section($rh->{envir}->{section} ||'');
192 $effectiveUser->recitation($rh->{envir}->{recitation} ||'');
193 $effectiveUser->comment('');
194 $effectiveUser->status('C');
195 $effectiveUser->password($rh->{envir}->{studentID}|| 'foobar');
196 $effectiveUserPermissionLevel->permission(0);
197 }
198 #FIXME these will fail if the keys are not defined within the environment.
199###########################################
200# Insure that set and problem are defined
201# Define the set and problem information from
202# data in the environment if necessary
203###########################################
204 # determine the set name and the set problem number
205 my $setName = (defined($rh->{envir}->{setNumber}) ) ? $rh->{envir}->{setNumber} : '';
206 my $problemNumber = (defined($rh->{envir}->{probNum}) ) ? $rh->{envir}->{probNum} : 1 ;
207 my $problemSeed = (defined($rh->{envir}->{problemSeed})) ? $rh->{envir}->{problemSeed} : 1 ;
208 my $psvn = (defined($rh->{envir}->{psvn}) ) ? $rh->{envir}->{psvn} : 1234 ;
209 my $problemStatus = $rh->{problem_state}->{recorded_score}|| 0 ;
210 my $problemValue = (defined($rh->{envir}->{problemValue})) ? $rh->{envir}->{problemValue} : 1 ;
211 my $num_correct = $rh->{problem_state}->{num_correct} || 0 ;
212 my $num_incorrect = $rh->{problem_state}->{num_incorrect} || 0 ;
213 my $problemAttempted = ($num_correct && $num_incorrect);
214 my $lastAnswer = '';
215
216 my $setRecord = $db->getMergedSet($effectiveUserName, $setName);
217 unless (defined($setRecord) and ref($setRecord) ) {
218 # if a User Set does not exist for this user and this set
219 # then we check the Global Set
220 # if that does not exist we create a fake set
221 # if it does, we add fake user data
222 my $userSetClass = $db->{set_user}->{record};
223 my $globalSet = $db->getGlobalSet($setName); # checked
224
225 if (not defined $globalSet) {
226 $setRecord = fake_set($db);
227 } else {
228 $setRecord = global2user($userSetClass, $globalSet);
229 }
230 # initializations
231 $setRecord->set_id($setName);
232 $setRecord->set_header("");
233 $setRecord->hardcopy_header("");
234 $setRecord->open_date(time()-60*60*24*7); # one week ago
235 $setRecord->due_date(time()+60*60*24*7*2); # in two weeks
236 $setRecord->answer_date(time()+60*60*24*7*3); # in three weeks
237 $setRecord->psvn($rh->{envir}->{psvn}||0);
238 }
239 #warn "set Record is $setRecord";
240 # obtain the merged problem for $effectiveUser
241 my $problemRecord = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber);
242
243 # if that is not yet defined obtain the global problem,
244 # convert it to a user problem, and add fake user data
245 unless (defined $problemRecord) {
246 my $userProblemClass = $db->{problem_user}->{record};
247 my $globalProblem = $db->getGlobalProblem($setName, $problemNumber); # checked
248 # if the global problem doesn't exist either, bail!
249 if(not defined $globalProblem) {
250 $problemRecord = fake_problem($db);
251 } else {
252 $problemRecord = global2user($userProblemClass, $globalProblem);
253 }
254 # initializations
255 $problemRecord->user_id($effectiveUserName);
256 $problemRecord->problem_id($problemNumber);
257 $problemRecord->set_id($setName);
258 $problemRecord->problem_seed($problemSeed);
259 $problemRecord->status($problemStatus);
260 $problemRecord->value($problemValue);
261 $problemRecord->attempted($problemAttempted);
262 $problemRecord->last_answer($lastAnswer);
263 $problemRecord->num_correct($num_correct);
264 $problemRecord->num_incorrect($num_incorrect);
265 }
266 # initialize problem source
267 my $problem_source;
268 my $r_problem_source =undef;
269 if (defined($rh->{source})) {
270 $problem_source = decode_base64($rh->{source});
271 $problem_source =~ tr /\r/\n/;
272 $r_problem_source =\$problem_source;
273 } elsif (defined($rh->{sourceFilePath}) and $rh->{sourceFilePath} =/\S/) {
274 $problemRecord->source_file($rh->{sourceFilePath});
275 }
276 $problemRecord->source_file('foobar') unless defined($problemRecord->source_file);
277
278 #warn "problem Record is $problemRecord";
279 # now we're sure we have valid UserSet and UserProblem objects
280 # yay!
281
99############################################################################### 282##################################################
100# Initialize renderProblem 283# Other initializations
101############################################################################### 284##################################################
102 285 my $translationOptions = {
103 286 displayMode => $rh->{envir}->{displayMode},
104 287 showHints => $rh->{envir}->{showHints},
105 288 showSolutions => $rh->{envir}->{showSolutions},
106my $displayMode = 'HTML_dpng'; 289 refreshMath2img => $rh->{envir}->{showHints} || $rh->{envir}->{showSolutions},
107 290 processAnswers => 1,
108my $PG_PL = "${pgMacrosDirectory}/PG.pl"; 291 # methods for supplying the source,
109my $DANGEROUS_MACROS_PL = "${pgMacrosDirectory}/dangerousMacros.pl"; 292 r_source => $r_problem_source, # reference to a source file string.
110my $IO_PL = "${pgMacrosDirectory}/IO.pl"; 293 # if reference is not defined then the path is obtained
111my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 294 # from the problem object.
112 "Circle", "Label", "PGrandom", "Units", "Hermite", 295 r_envirOverrides => $rh,
113 "List", "Match","Multiple", "Select", "AlgParser", 296 };
114 "AnswerHash", "Fraction", "VectorField", "Complex1",
115 "Complex", "MatrixReal1", "Matrix","Distributions",
116 "Regression"
117 );
118my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr",
119 "ExprWithImplicitExpand", "AnswerEvaluator",
120# "AnswerEvaluatorMaker"
121 );
122my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT;
123 DOCUMENT();
124 loadMacros(
125 "PGbasicmacros.pl",
126 "PGchoicemacros.pl",
127 "PGanswermacros.pl",
128 "PGnumericalmacros.pl",
129 "PGgraphmacros.pl",
130 "PGauxiliaryFunctions.pl",
131 "PGmatrixmacros.pl",
132 "PGstatisticsmacros.pl",
133 "PGcomplexmacros.pl",
134 );
135 297
136 ENDDOCUMENT(); 298 my $formFields = $rh->{envir}->{inputs_ref};
137 299 my $key = $rh->{envir}->{key} || '';
138END_OF_TEXT 300
139 301
302 #check definitions
303 #warn "setRecord is ", WebworkWebservice::pretty_print_rh($setRecord);
304 #warn "problemRecord is",WebworkWebservice::pretty_print_rh($problemRecord);
305# warn "envir is\n ",WebworkWebservice::pretty_print_rh(__PACKAGE__->defineProblemEnvir(
306# $ce,
307# $effectiveUser,
308# $key,
309# $setRecord,
310# $problemRecord,
311# $psvn,
312# $formFields,
313# $translationOptions,
314# ));
140############################################################################### 315#################################################
141#
142###############################################################################
143 316
144############################################################################### 317# Other options can be over ridden by modifying
145############################################################################### 318# $ce->{pg}
146 319
147#print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n";
148 320
321
322# We'll try to use this code instead so that Local does all of the work.
323# Most of the configuration will take place in the fake course associated
324# with XMLRPC responses
325# problem needs to be loaded with the following:
326# source_file
327# status
328# num_correct
329# num_incorrect
330# it doesn't seem that $effectiveUser, $set or $key is used in the subroutine
331# except that it is passed on to defineProblemEnvironment
332
333 my $pg;
334 $pg = WebworkWebservice::RenderProblem->new(
335 $ce,
336 $effectiveUser,
337 $key,
338 $setRecord,
339 $problemRecord,
340 $setRecord->psvn, # FIXME: this field should be removed
341 $formFields,
342 # translation options
343 $translationOptions,
149 344
150
151###############################################################################
152# The following code initializes an instantiation of the translator in the
153# parent process. This initialized object is then shared with each of the
154# children forked from this parent process by the daemon.
155#
156# As far as I can tell, the child processes don't share any variable values even
157# though their namespaces are the same.
158###############################################################################
159
160
161my $dummy_envir = { courseScriptsDirectory => $pgMacrosDirectory,
162 displayMode => $displayMode,
163 macroDirectory => $macroDirectory,
164 displayModeFailover => DISPLAY_MODE_FAILOVER(),
165 externalTTHPath => $ce->{externalPrograms}->{tth},
166};
167my $pt = new WeBWorK::PG::Translator; #pt stands for problem translator;
168$pt ->rh_directories( { courseScriptsDirectory => $pgMacrosDirectory,
169 macroDirectory => $macroDirectory,
170 scriptDirectory => '' ,
171 templateDirectory => $templateDirectory,
172 tempDirectory => $COURSE_TEMP_DIRECTORY,
173 }
174); 345 );
175$pt -> evaluate_modules( @MODULE_LIST);
176#print STDERR "Completed loading of modules, now loading extra packages\n";
177$pt -> load_extra_packages( @EXTRA_PACKAGES );
178#print STDERR "Completed loading of packages, now loading environment\n";
179$pt -> environment($dummy_envir);
180#print STDERR "Completed loading environment, next initialize\n";
181$pt->initialize();
182#print STDERR "Initialized. \n";
183$pt -> unrestricted_load($PG_PL );
184$pt -> unrestricted_load($DANGEROUS_MACROS_PL);
185$pt -> unrestricted_load($IO_PL);
186$pt-> set_mask();
187#
188#print STDERR "Unrestricted loads completed.\n";
189
190$INITIAL_MACRO_PACKAGES =~ tr /\r/\n/;
191$pt->source_string( $INITIAL_MACRO_PACKAGES );
192#print STDERR "source strings read in\n";
193$pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
194$pt ->translate();
195
196print STDERR "New PGtranslator object inititialization completed.\n";
197################################################################################
198## This ends the initialization of the PGtranslator object
199################################################################################
200
201
202
203###############################################################################
204# This subroutine is called by the child process. It reinitializes its copy of the
205# PGtranslator5 object. The unrestricted_load and loadMacros subroutines of PGtranslator5
206# have been modified so that if &_PG_init is already defined then nothing
207# is read in but the initialization subroutine is run instead.
208###############################################################################
209
210sub renderProblem {
211 my $rh = shift;
212# warn WebworkWebservice::pretty_print_rh($rh);
213 warn "Starting render Problem";
214 my $beginTime = new Benchmark;
215 $WARNINGS = "";
216 my $saveWARN = $SIG{__WARN__};
217 local $SIG{__WARN__} =\&PG_warnings_handler;
218
219 my $envir = $rh->{envir};
220 foreach my $item (keys %PG_environment) {
221 $envir->{$item} = $PG_environment{$item};
222 }
223 my $basename = 'equation-'.$envir->{psvn}. '.' .$envir->{probNum};
224 $basename .= '.' . $envir->{problemSeed} if $envir->{problemSeed};
225
226 #FIXME debug line
227 #print STDERR "basename is $basename and psvn is ", $envir->{psvn};
228 my $imagesModeOptions = $ce->{pg}->{displayModeOptions}->{images};
229
230 # Object for generating equation images
231 if ( $envir->{displayMode} eq 'HTML_dpng' ) {
232 $envir->{imagegen} = WeBWorK::PG::ImageGenerator->new(
233 tempDir => $ce->{webworkDirs}->{tmp}, # $Global::globalTmpDirectory, # global temp dir
234 latex => $ce->{externalPrograms}->{latex}, #$envir->{externalLaTeXPath},
235 dvipng => $ce->{externalPrograms}->{dvipng}, # $envir ->{externalDvipngPath},
236 useCache => 1,
237 cacheDir => $ce->{webworkDirs}->{equationCache},
238 cacheURL => $HOSTURL.$ce->{webworkURLs}->{equationCache},
239 cacheDB => $ce->{webworkFiles}->{equationCacheDB},
240 useMarkers => ($imagesModeOptions->{dvipng_align} && $imagesModeOptions->{dvipng_align} eq 'mysql'),
241 dvipng_align => $imagesModeOptions->{dvipng_align},
242 dvipng_depth_db => $imagesModeOptions->{dvipng_depth_db},
243 );
244 }
245 346
246 $pt->environment($envir); 347
247 #$pt->{safe_cache} = $safe_cmpt_cache; 348
248 $pt->initialize(); 349 # new version of output:
249 $pt -> unrestricted_load($PG_PL); 350 my $out2 = {
250 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 351 text => encode_base64( $pg->{body_text} ),
251 $pt -> unrestricted_load($IO_PL); 352 header_text => encode_base64( $pg->{head_text} ),
252 $pt-> set_mask(); 353 answers => $pg->{answers},
253 354 errors => $pg->{errors},
254 my $string = decode_base64( $rh ->{source} ); 355 WARNINGS => encode_base64($pg->{warnings} ),
255 $string =~ tr /\r/\n/; 356 problem_result => $pg->{result},
256 357 problem_state => $pg->{state},
257 $pt->source_string( $string ); 358 #PG_flag => $pg->{flags},
258 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
259 $pt ->translate();
260
261 # HTML_dpng, on the other hand, uses an ImageGenerator. We have to
262 # render the queued equations.
263 if ($envir->{imagegen}) {
264 my $sourceFile = ''; #$ce->{courseDirs}->{templates} . "/" . $problem->source_file;
265 my %mtimeOption = -e $sourceFile
266 ? (mtime => (stat $sourceFile)[9])
267 : ();
268 359
269 $envir->{imagegen}->render( 360
270 refresh => 1, 361
271 %mtimeOption,
272 );
273 }
274
275 # Determine which problem grader to use
276 #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default
277 my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE};
278
279 if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty
280 if ($problem_grader_to_use eq 'std_problem_grader') {
281 # Reset problem grader to standard problem grader.
282 $pt->rf_problem_grader($pt->rf_std_problem_grader);
283 } elsif ($problem_grader_to_use eq 'avg_problem_grader') {
284 # Reset problem grader to average problem grader.
285 $pt->rf_problem_grader($pt->rf_avg_problem_grader);
286 } elsif (ref($problem_grader_to_use) eq 'CODE') {
287 # Set problem grader to instructor defined problem grader -- use cautiously.
288 $pt->rf_problem_grader($problem_grader_to_use)
289 } else {
290 warn "Error: Could not understand problem grader flag $problem_grader_to_use";
291 #this is the default set by the translator and used if the flag is not understood
292 #$pt->rf_problem_grader($pt->rf_std_problem_grader);
293 }
294
295 } else {#this is the default set by the translator and used if no flag is set.
296 $pt->rf_problem_grader($pt->rf_std_problem_grader);
297 }
298
299 # creates and stores a hash of answer results: $rh_answer_results
300 $pt -> process_answers($rh->{envir}->{inputs_ref});
301
302
303 $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score},
304 num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} ,
305 num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans}
306 } );
307 my %PG_FLAGS = $pt->h_flags;
308 my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ?
309 $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
310 my $answers_submitted = 0;
311 $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted};
312
313 my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
314 ANSWER_ENTRY_ORDER => $ra_answer_entry_order
315 ); # grades the problem.
316 # protect image data for delivery via XML-RPC.
317 # Don't send code data.
318 my %PG_flag=();
319
320# if($rh->{envir}->{displayMode} eq 'HTML_dpng') {
321# my $forceRefresh=1;
322# if ( (defined($inputs{'refreshCachedImages'}) and $inputs{'refreshCachedImages'}) || $main::refreshCachedImages
323# || $displaySolutionsQ || $displayHintsQ) {
324# $forceRefresh=1;
325# }
326# $imgen->render('refresh'=>$forceRefresh); # Can force new images
327# }
328
329 my $out = {
330 text => encode_base64( ${$pt ->r_text()} ),
331 header_text => encode_base64( ${ $pt->r_header } ),
332 answers => $pt->rh_evaluated_answers,
333 errors => $pt-> errors(),
334 WARNINGS => encode_base64($WARNINGS ),
335 problem_result => $rh_problem_result,
336 problem_state => $rh_problem_state,
337 PG_flag => \%PG_flag
338 }; 362 };
339 local $SIG{__WARN__} = $saveWARN;
340 my $endTime = new Benchmark;
341 $out->{compute_time} = logTimingInfo($beginTime, $endTime);
342
343 # Hack to filter out CODE references 363 # Hack to filter out CODE references
344 foreach my $ans (keys %{$out->{answers}}) { 364 foreach my $ans (keys %{$out2->{answers}}) {
345 foreach my $item (keys %{$out->{answers}->{$ans}}) { 365 foreach my $item (keys %{$out2->{answers}->{$ans}}) {
346 my $contents = $out->{answers}->{$ans}->{$item}; 366 my $contents = $out2->{answers}->{$ans}->{$item};
347 if (ref($contents) =~ /CODE/ ) { 367 if (ref($contents) =~ /CODE/ ) {
348 #warn "removing code at $ans $item "; 368 #warn "removing code at $ans $item ";
349 $out->{answers}->{$ans}->{$item} = undef; 369 $out2->{answers}->{$ans}->{$item} = undef;
350 } 370 }
351 } 371 }
352 372
353 } 373 }
354 #warn WebworkWebservice::pretty_print_rh($pt->rh_evaluated_answers); 374 $out2->{PG_flag}->{PROBLEM_GRADER_TO_USE} = undef;
375 my $endTime = new Benchmark;
376 $out2->{compute_time} = logTimingInfo($beginTime, $endTime);
377 # warn "flags are" , WebworkWebservice::pretty_print_rh($pg->{flags});
355 $out; 378 $out2;
356 379
357} 380}
358 381
359###############################################################################
360# This ends the main subroutine executed by the child process in responding to
361# a request. The other subroutines are auxiliary.
362###############################################################################
363 382
364 383
365sub safetyFilter {
366 my $answer = shift; # accepts one answer and checks it
367 my $submittedAnswer = $answer;
368 $answer = '' unless defined $answer;
369 my ($errorno, $answerIsCorrectQ);
370 $answer =~ tr/\000-\037/ /;
371 #### Return if answer field is empty ########
372 unless ($answer =~ /\S/) {
373# $errorno = "<BR>No answer was submitted.";
374 $errorno = 0; ## don't report blank answer as error
375
376 return ($answer,$errorno);
377 }
378
379 ######### Return if forbidden characters are found
380 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\[\]\(\)\,\|]+$/ ) {
381 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c;
382 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>";
383
384 return ($answer,$errorno);
385 }
386
387 $errorno = 0;
388 return($answer, $errorno);
389}
390 384
391 385
392sub logTimingInfo{ 386sub logTimingInfo{
393 my ($beginTime,$endTime,) = @_; 387 my ($beginTime,$endTime,) = @_;
394 my $out = ""; 388 my $out = "";
395 $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) ); 389 $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) );
396 $out; 390 $out;
397} 391}
392
393
398###################################################################### 394######################################################################
399sub PG_warnings_handler { 395sub new {
400 my @input = @_; 396 shift; # throw away invocant -- we don't need it
401 my $msg_string = longmess(@_); 397 my ($ce, $user, $key, $set, $problem, $psvn, $formFields,
402 my @msg_array = split("\n",$msg_string); 398 $translationOptions) = @_;
403 my $out_string = '';
404
405 # Extra stack information is provided in this next block
406 # If the warning message does NOT end in \n then a line
407 # number is appended (see Perl manual about warn function)
408 # The presence of the line number is detected below and extra
409 # stack information is added.
410 # To suppress the line number and the extra stack information
411 # add \n to the end of a warn message (in .pl files. In .pg
412 # files add ~~n instead
413
414 399
415 if (@msg_array) { # if there are more details 400 my $renderer = 'WeBWorK::PG::Local';
416 $out_string .= "##More details. The calling sequence is: <BR>\n"; 401
417 foreach my $line (@msg_array) { 402 runtime_use $renderer;
418 chomp($line); 403 # the idea is to have Local call back to the defineProblemEnvir below.
419 next unless $line =~/\w+\:\:/; 404 return WeBWorK::PG::Local::new($renderer,@_);
420 $out_string .= "----" .$line . "<BR>\n";
421 }
422 }
423
424 $WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string .
425 "<BR>\n--------------------------------------<BR>\n<BR>\n";
426} 405}
427 406
428my $CarpLevel = 0; # How many extra package levels to skip on carp.
429my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
430sub longmess {
431 my $error = shift;
432 my $mess = "";
433 my $i = 1 + $CarpLevel;
434 my ($pack,$file,$line,$sub,$eval,$require);
435 407
436 while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { 408#FIXME
437 if ($error =~ m/\n$/) { 409# Save these subroutines.
438 $mess .= $error; 410# I'd like to use this version of defineProblemEnvir instead of the
439 } 411# the version in PG.pm That adds flexibility.
440 else {
441 if (defined $eval) {
442 if ($require) {
443 $sub = "require $eval";
444 }
445 else {
446 $eval =~ s/[\\\']/\\$&/g;
447 if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
448 substr($eval,$MaxEvalLen) = '...';
449 }
450 $sub = "eval '$eval'";
451 }
452 }
453 elsif ($sub eq '(eval)') {
454 $sub = 'eval {...}';
455 }
456 412
457 $mess .= "\t$sub " if $error eq "called";
458 $mess .= "$error at $file line $line\n";
459 }
460 413
461 $error = "called"; 414# sub translateDisplayModeNames($) {
462 }
463
464 $mess || $error;
465}
466
467######################################################################
468
469
470sub pretty_print_rh {
471 my $rh = shift; 415# my $name = shift;
472 my $out = ""; 416# return DISPLAY_MODES()->{$name};
473 my $type = ref($rh); 417# }
474 if ( ref($rh) =~/HASH/ ) {
475 foreach my $key (sort keys %{$rh}) {
476 $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
477 }
478 } elsif ( ref($rh) =~ /SCALAR/ ) {
479 $out = "scalar reference ". ${$rh};
480 } elsif ( ref($rh) =~/Base64/ ) {
481 $out .= "base64 reference " .$$rh;
482 } else {
483 $out = $rh;
484 }
485 if (defined($type) ) {
486 $out .= "type = $type \n";
487 }
488 return $out;
489}
490
491######################################################################
492
493sub defineProblemEnvir { 418# sub defineProblemEnvir {
494 my ( 419# my (
495 $self, 420# $self,
496 $ce, 421# $ce,
497 $user, 422# $user,
498 $key, 423# $key,
499 $set, 424# $set,
500 $problem, 425# $problem,
501 $psvn, 426# $psvn,
502 $formFields, 427# $formFields,
503 $options, 428# $options,
504 ) = @_; 429# ) = @_;
505 430#
506 my %envir; 431# my %envir;
507 432#
508 # ---------------------------------------------------------------------- 433# # ----------------------------------------------------------------------
509 434#
510 # PG environment variables 435# # PG environment variables
511 # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002 436# # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002
512 # any changes are noted by "ADDED:" or "REMOVED:" 437# # any changes are noted by "ADDED:" or "REMOVED:"
513 438#
514 # Vital state information 439# # Vital state information
515 # ADDED: displayModeFailover, displayHintsQ, displaySolutionsQ, 440# # ADDED: displayModeFailover, displayHintsQ, displaySolutionsQ,
516 # refreshMath2img, texDisposition 441# # refreshMath2img, texDisposition
517 442#
518 $envir{psvn} = $set->psvn; 443# $envir{psvn} = $set->psvn;
519 $envir{psvnNumber} = $envir{psvn}; 444# $envir{psvnNumber} = $envir{psvn};
520 $envir{probNum} = $problem->problem_id; 445# $envir{probNum} = $problem->problem_id;
521 $envir{questionNumber} = $envir{probNum}; 446# $envir{questionNumber} = $envir{probNum};
522 $envir{fileName} = $problem->source_file; 447# $envir{fileName} = $problem->source_file;
523 $envir{probFileName} = $envir{fileName}; 448# $envir{probFileName} = $envir{fileName};
524 $envir{problemSeed} = $problem->problem_seed; 449# $envir{problemSeed} = $problem->problem_seed;
525 $envir{displayMode} = translateDisplayModeNames($options->{displayMode}); 450# $envir{displayMode} = translateDisplayModeNames($options->{displayMode});
526 $envir{languageMode} = $envir{displayMode}; 451# $envir{languageMode} = $envir{displayMode};
527 $envir{outputMode} = $envir{displayMode}; 452# $envir{outputMode} = $envir{displayMode};
528 $envir{displayHintsQ} = $options->{showHints}; 453# $envir{displayHintsQ} = $options->{showHints};
529 $envir{displaySolutionsQ} = $options->{showSolutions}; 454# $envir{displaySolutionsQ} = $options->{showSolutions};
530 $envir{texDisposition} = "pdf"; # in webwork2, we use pdflatex 455# $envir{texDisposition} = "pdf"; # in webwork2, we use pdflatex
531 456#
532 # Problem Information 457# # Problem Information
533 # ADDED: courseName, formatedDueDate 458# # ADDED: courseName, formatedDueDate
534 459#
535 $envir{openDate} = $set->open_date; 460# $envir{openDate} = $set->open_date;
536 $envir{formattedOpenDate} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone}); 461# $envir{formattedOpenDate} = formatDateTime($envir{openDate}, $ce->{siteDefaults}{timezone});
537 $envir{dueDate} = $set->due_date; 462# $envir{dueDate} = $set->due_date;
538 $envir{formattedDueDate} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone}); 463# $envir{formattedDueDate} = formatDateTime($envir{dueDate}, $ce->{siteDefaults}{timezone});
539 $envir{formatedDueDate} = $envir{formattedDueDate}; # typo in many header files 464# $envir{formatedDueDate} = $envir{formattedDueDate}; # typo in many header files
540 $envir{answerDate} = $set->answer_date; 465# $envir{answerDate} = $set->answer_date;
541 $envir{formattedAnswerDate} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone}); 466# $envir{formattedAnswerDate} = formatDateTime($envir{answerDate}, $ce->{siteDefaults}{timezone});
542 $envir{numOfAttempts} = ($problem->num_correct || 0) + ($problem->num_incorrect || 0); 467# $envir{numOfAttempts} = ($problem->num_correct || 0) + ($problem->num_incorrect || 0);
543 $envir{problemValue} = $problem->value; 468# $envir{problemValue} = $problem->value;
544 $envir{sessionKey} = $key; 469# $envir{sessionKey} = $key;
545 $envir{courseName} = $ce->{courseName}; 470# $envir{courseName} = $ce->{courseName};
546 471#
547 # Student Information 472# # Student Information
548 # ADDED: studentID 473# # ADDED: studentID
549 474#
550 $envir{sectionName} = $user->section; 475# $envir{sectionName} = $user->section;
551 $envir{sectionNumber} = $envir{sectionName}; 476# $envir{sectionNumber} = $envir{sectionName};
552 $envir{recitationName} = $user->recitation; 477# $envir{recitationName} = $user->recitation;
553 $envir{recitationNumber} = $envir{recitationName}; 478# $envir{recitationNumber} = $envir{recitationName};
554 $envir{setNumber} = $set->set_id; 479# $envir{setNumber} = $set->set_id;
555 $envir{studentLogin} = $user->user_id; 480# $envir{studentLogin} = $user->user_id;
556 $envir{studentName} = $user->first_name . " " . $user->last_name; 481# $envir{studentName} = $user->first_name . " " . $user->last_name;
557 $envir{studentID} = $user->student_id; 482# $envir{studentID} = $user->student_id;
558 483#
559 # Answer Information 484# # Answer Information
560 # REMOVED: refSubmittedAnswers 485# # REMOVED: refSubmittedAnswers
561 486#
562 $envir{inputs_ref} = $formFields; 487# $envir{inputs_ref} = $formFields;
563 488#
564 # External Programs 489# # External Programs
565 # ADDED: externalLaTeXPath, externalDvipngPath, 490# # ADDED: externalLaTeXPath, externalDvipngPath,
566 # externalGif2EpsPath, externalPng2EpsPath 491# # externalGif2EpsPath, externalPng2EpsPath
567 492#
568 $envir{externalTTHPath} = $ce->{externalPrograms}->{tth}; 493# $envir{externalTTHPath} = $ce->{externalPrograms}->{tth};
569 $envir{externalLaTeXPath} = $ce->{externalPrograms}->{latex}; 494# $envir{externalLaTeXPath} = $ce->{externalPrograms}->{latex};
570 $envir{externalDvipngPath} = $ce->{externalPrograms}->{dvipng}; 495# $envir{externalDvipngPath} = $ce->{externalPrograms}->{dvipng};
571 $envir{externalGif2EpsPath} = $ce->{externalPrograms}->{gif2eps}; 496# $envir{externalGif2EpsPath} = $ce->{externalPrograms}->{gif2eps};
572 $envir{externalPng2EpsPath} = $ce->{externalPrograms}->{png2eps}; 497# $envir{externalPng2EpsPath} = $ce->{externalPrograms}->{png2eps};
573 $envir{externalGif2PngPath} = $ce->{externalPrograms}->{gif2png}; 498# $envir{externalGif2PngPath} = $ce->{externalPrograms}->{gif2png};
574 499#
575 # Directories and URLs 500# # Directories and URLs
576 # REMOVED: courseName 501# # REMOVED: courseName
577 # ADDED: dvipngTempDir 502# # ADDED: dvipngTempDir
578 # ADDED: jsMathURL 503# # ADDED: jsMathURL
579 # ADDED: asciimathURL 504# # ADDED: asciimathURL
580 505#
581 $envir{cgiDirectory} = undef; 506# $envir{cgiDirectory} = undef;
582 $envir{cgiURL} = undef; 507# $envir{cgiURL} = undef;
583 $envir{classDirectory} = undef; 508# $envir{classDirectory} = undef;
584 $envir{courseScriptsDirectory} = $ce->{pg}->{directories}->{macros}."/"; 509# $envir{courseScriptsDirectory} = $ce->{pg}->{directories}->{macros}."/";
585 $envir{htmlDirectory} = $ce->{courseDirs}->{html}."/"; 510# $envir{htmlDirectory} = $ce->{courseDirs}->{html}."/";
586 $envir{htmlURL} = $ce->{courseURLs}->{html}."/"; 511# $envir{htmlURL} = $ce->{courseURLs}->{html}."/";
587 $envir{macroDirectory} = $ce->{courseDirs}->{macros}."/"; 512# $envir{macroDirectory} = $ce->{courseDirs}->{macros}."/";
588 $envir{templateDirectory} = $ce->{courseDirs}->{templates}."/"; 513# $envir{templateDirectory} = $ce->{courseDirs}->{templates}."/";
589 $envir{tempDirectory} = $ce->{courseDirs}->{html_temp}."/"; 514# $envir{tempDirectory} = $ce->{courseDirs}->{html_temp}."/";
590 $envir{tempURL} = $ce->{courseURLs}->{html_temp}."/"; 515# $envir{tempURL} = $ce->{courseURLs}->{html_temp}."/";
591 $envir{scriptDirectory} = undef; 516# $envir{scriptDirectory} = undef;
592 $envir{webworkDocsURL} = $ce->{webworkURLs}->{docs}."/"; 517# $envir{webworkDocsURL} = $ce->{webworkURLs}->{docs}."/";
593 $envir{localHelpURL} = $ce->{webworkURLs}->{local_help}."/"; 518# $envir{localHelpURL} = $ce->{webworkURLs}->{local_help}."/";
594 $envir{jsMathURL} = $ce->{webworkURLs}->{jsMath}; 519# $envir{jsMathURL} = $ce->{webworkURLs}->{jsMath};
595 $envir{asciimathURL} = $ce->{webworkURLs}->{asciimath}; 520# $envir{asciimathURL} = $ce->{webworkURLs}->{asciimath};
596 521#
597 # Information for sending mail 522# # Information for sending mail
598 523#
599 $envir{mailSmtpServer} = $ce->{mail}->{smtpServer}; 524# $envir{mailSmtpServer} = $ce->{mail}->{smtpServer};
600 $envir{mailSmtpSender} = $ce->{mail}->{smtpSender}; 525# $envir{mailSmtpSender} = $ce->{mail}->{smtpSender};
601 $envir{ALLOW_MAIL_TO} = $ce->{mail}->{allowedRecipients}; 526# $envir{ALLOW_MAIL_TO} = $ce->{mail}->{allowedRecipients};
602 527#
603 # Default values for evaluating answers 528# # Default values for evaluating answers
604 529#
605 my $ansEvalDefaults = $ce->{pg}->{ansEvalDefaults}; 530# my $ansEvalDefaults = $ce->{pg}->{ansEvalDefaults};
606 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults); 531# $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults);
607 532#
608 # ---------------------------------------------------------------------- 533# # ----------------------------------------------------------------------
609 534#
610 my $basename = "equation-$envir{psvn}.$envir{probNum}"; 535# my $basename = "equation-$envir{psvn}.$envir{probNum}";
611 $basename .= ".$envir{problemSeed}" if $envir{problemSeed}; 536# $basename .= ".$envir{problemSeed}" if $envir{problemSeed};
612 537#
613 # to make grabbing these options easier, we'll pull them out now... 538# # to make grabbing these options easier, we'll pull them out now...
614 my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}}; 539# my %imagesModeOptions = %{$ce->{pg}->{displayModeOptions}->{images}};
615 540#
616 # Object for generating equation images 541# # Object for generating equation images
617 $envir{imagegen} = WeBWorK::PG::ImageGenerator->new( 542# $envir{imagegen} = WeBWorK::PG::ImageGenerator->new(
618 tempDir => $ce->{webworkDirs}->{tmp}, # global temp dir 543# tempDir => $ce->{webworkDirs}->{tmp}, # global temp dir
619 latex => $envir{externalLaTeXPath}, 544# latex => $envir{externalLaTeXPath},
620 dvipng => $envir{externalDvipngPath}, 545# dvipng => $envir{externalDvipngPath},
621 useCache => 1, 546# useCache => 1,
622 cacheDir => $ce->{webworkDirs}->{equationCache}, 547# cacheDir => $ce->{webworkDirs}->{equationCache},
623 cacheURL => $ce->{webworkURLs}->{equationCache}, 548# cacheURL => $ce->{webworkURLs}->{equationCache},
624 cacheDB => $ce->{webworkFiles}->{equationCacheDB}, 549# cacheDB => $ce->{webworkFiles}->{equationCacheDB},
625 useMarkers => ($imagesModeOptions{dvipng_align} && $imagesModeOptions{dvipng_align} eq 'mysql'), 550# useMarkers => ($imagesModeOptions{dvipng_align} && $imagesModeOptions{dvipng_align} eq 'mysql'),
626 dvipng_align => $imagesModeOptions{dvipng_align}, 551# dvipng_align => $imagesModeOptions{dvipng_align},
627 dvipng_depth_db => $imagesModeOptions{dvipng_depth_db}, 552# dvipng_depth_db => $imagesModeOptions{dvipng_depth_db},
628 ); 553# );
629 554#
630 # ADDED: jsMath options 555# # ADDED: jsMath options
631 $envir{jsMath} = {%{$ce->{pg}{displayModeOptions}{jsMath}}}; 556# $envir{jsMath} = {%{$ce->{pg}{displayModeOptions}{jsMath}}};
632 557#
633 # Other things... 558# # Other things...
634 $envir{QUIZ_PREFIX} = $options->{QUIZ_PREFIX}; # used by quizzes 559# $envir{QUIZ_PREFIX} = $options->{QUIZ_PREFIX}; # used by quizzes
635 $envir{PROBLEM_GRADER_TO_USE} = $ce->{pg}->{options}->{grader}; 560# $envir{PROBLEM_GRADER_TO_USE} = $ce->{pg}->{options}->{grader};
636 $envir{PRINT_FILE_NAMES_FOR} = $ce->{pg}->{specialPGEnvironmentVars}->{PRINT_FILE_NAMES_FOR}; 561# $envir{PRINT_FILE_NAMES_FOR} = $ce->{pg}->{specialPGEnvironmentVars}->{PRINT_FILE_NAMES_FOR};
637 562#
638 # ADDED: __files__ 563# # ADDED: __files__
639 # an array for mapping (eval nnn) to filenames in error messages 564# # an array for mapping (eval nnn) to filenames in error messages
640 $envir{__files__} = { 565# $envir{__files__} = {
641 root => $ce->{webworkDirs}{root}, # used to shorten filenames 566# root => $ce->{webworkDirs}{root}, # used to shorten filenames
642 pg => $ce->{pg}{directories}{root}, # ditto 567# pg => $ce->{pg}{directories}{root}, # ditto
643 tmpl => $ce->{courseDirs}{templates}, # ditto 568# tmpl => $ce->{courseDirs}{templates}, # ditto
644 }; 569# };
645 570#
646 # variables for interpreting capa problems and other things to be 571# # variables for interpreting capa problems and other things to be
647 # seen in a pg file 572# # seen in a pg file
648 my $specialPGEnvironmentVarHash = $ce->{pg}->{specialPGEnvironmentVars}; 573# my $specialPGEnvironmentVarHash = $ce->{pg}->{specialPGEnvironmentVars};
649 for my $SPGEV (keys %{$specialPGEnvironmentVarHash}) { 574# for my $SPGEV (keys %{$specialPGEnvironmentVarHash}) {
650 $envir{$SPGEV} = $specialPGEnvironmentVarHash->{$SPGEV}; 575# $envir{$SPGEV} = $specialPGEnvironmentVarHash->{$SPGEV};
651 } 576# }
652 577#
653 return \%envir; 578# return \%envir;
654} 579# }
655
656 580
657 581
658 582
659 583
6601; 5841;
Legend:
Removed from v.3072  
changed lines
  Added in v.3073
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9