[system] / trunk / xmlrpc / daemon / Webwork.pm Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/daemon/Webwork.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2989 - (view) (download) (as text)

1 : gage 279 #!/usr/local/bin/perl -w
2 : gage 593
3 : gage 279 # Copyright (C) 2001 Michael Gage
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 : gage 2989 BEGIN {
13 : gage 497
14 : gage 2989 use lib "$ENV{WEBWORK_ROOT}/lib";
15 :    
16 :    
17 :     }
18 : gage 279 package Webwork;
19 :    
20 : gage 2989 BEGIN { $main::VERSION = "2.1"; }
21 :    
22 :     #FIXME
23 :     $SIG{__WARN__} = sub {};
24 :     $SIG{__DIE__} = sub {};
25 :    
26 : gage 279 use strict;
27 :     use sigtrap;
28 :     use Carp;
29 : gage 593 use Safe;
30 : gage 2989
31 :     use WeBWorK::CourseEnvironment;
32 : gage 497 use WeBWorK::PG::Translator;
33 : gage 2989 use WeBWorK::DB;
34 :     use WeBWorK::Constants;
35 :     use WeBWorK::Utils;
36 : gage 593 use WeBWorK::PG::IO;
37 : gage 2353 use WeBWorK::PG::ImageGenerator;
38 : gage 593 use Benchmark;
39 : gage 279 use MIME::Base64 qw( encode_base64 decode_base64);
40 :    
41 : gage 2989 print "rereading Webwork\n";
42 :     BEGIN {
43 :     my $WW_DIRECTORY = $ENV{WEBWORK_ROOT};
44 :     our $COURSENAME = 'daemon_course';
45 :     our $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
46 :    
47 :     print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
48 :    
49 :    
50 :     print "webwork is starting\n\n";
51 :     }
52 : gage 279
53 : gage 2989 my $WW_DIRECTORY = $ENV{WEBWORK_ROOT};
54 : gage 279
55 : gage 2989 our $COURSENAME = 'daemon_course';
56 :     our $HOSTURL = 'http://devel.webwork.rochester.edu:11002';
57 : gage 687
58 :    
59 : gage 2989 our $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
60 : gage 687
61 : gage 2989 print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
62 : gage 687
63 :    
64 : gage 2989 print "webwork is realy ready\n\n";
65 :     #other services
66 :     # File variables
67 :     my $WARNINGS='';
68 : gage 687
69 :    
70 : gage 2989 # imported constants
71 : gage 687
72 : gage 2989 my $COURSE_TEMP_DIRECTORY = $ce->{courseDirs}->{html_tmp};
73 :     my $COURSE_TEMP_URL = $HOSTURL.$ce->{courseURLs}->{html_tmp};
74 : gage 386
75 : gage 2989 my $pgMacrosDirectory = $ce->{pg_dir}.'/macros/';
76 :     my $macroDirectory = $ce->{courseDirs}->{macros}.'/';
77 :     my $templateDirectory = $ce->{courseDirs}->{templates};
78 : gage 279
79 : gage 2989 my %PG_environment = $ce->{pg}->{specialPGEnvironmentVars};
80 :     print STDERR "using the perl version of MIME::Base64\n";
81 : gage 375
82 : gage 593
83 : gage 2989 use constant DISPLAY_MODES => {
84 :     # display name # mode name
85 :     tex => "TeX",
86 :     plainText => "HTML",
87 :     formattedText => "HTML_tth",
88 :     images => "HTML_dpng",
89 :     jsMath => "HTML_jsMath",
90 :     asciimath => "HTML_asciimath",
91 :     };
92 : gage 593
93 : gage 2989 use constant DISPLAY_MODE_FAILOVER => {
94 :     TeX => [],
95 :     HTML => [],
96 :     HTML_tth => [ "HTML", ],
97 :     HTML_dpng => [ "HTML_tth", "HTML", ],
98 :     HTML_jsMath => [ "HTML_dpng", "HTML_tth", "HTML", ],
99 :     HTML_asciimath => [ "HTML_dpng", "HTML_tth", "HTML", ],
100 :     # legacy modes -- these are not supported, but some problems might try to
101 :     # set the display mode to one of these values manually and some macros may
102 :     # provide rendered versions for these modes but not the one we want.
103 :     Latex2HTML => [ "TeX", "HTML", ],
104 :     HTML_img => [ "HTML_dpng", "HTML_tth", "HTML", ],
105 :     };
106 :    
107 : gage 593
108 : gage 279 ###############################################################################
109 : gage 497 # List and address of available problemlibraries
110 : gage 279 ###############################################################################
111 :    
112 :    
113 : gage 2353 #my $libraryPath = '/Users/gage/rochester_problib/';
114 : gage 279
115 :    
116 : gage 593
117 : gage 279 ###############################################################################
118 : gage 593 # Initialize renderProblem
119 : gage 279 ###############################################################################
120 :    
121 :    
122 :    
123 : gage 786
124 : gage 320 my $displayMode = 'HTML_tth';
125 : gage 279
126 : gage 2989 my $PG_PL = "${pgMacrosDirectory}/PG.pl";
127 :     my $DANGEROUS_MACROS_PL = "${pgMacrosDirectory}/dangerousMacros.pl";
128 :     my $IO_PL = "${pgMacrosDirectory}/IO.pl";
129 : gage 497 my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun",
130 : gage 279 "Circle", "Label", "PGrandom", "Units", "Hermite",
131 :     "List", "Match","Multiple", "Select", "AlgParser",
132 :     "AnswerHash", "Fraction", "VectorField", "Complex1",
133 :     "Complex", "MatrixReal1", "Matrix","Distributions",
134 :     "Regression"
135 : gage 497 );
136 : gage 386 my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr",
137 : gage 279 "ExprWithImplicitExpand", "AnswerEvaluator",
138 : gage 497 # "AnswerEvaluatorMaker"
139 :     );
140 :     my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT;
141 :     DOCUMENT();
142 :     loadMacros(
143 :     "PGbasicmacros.pl",
144 :     "PGchoicemacros.pl",
145 :     "PGanswermacros.pl",
146 :     "PGnumericalmacros.pl",
147 :     "PGgraphmacros.pl",
148 :     "PGauxiliaryFunctions.pl",
149 :     "PGmatrixmacros.pl",
150 :     "PGstatisticsmacros.pl",
151 :     "PGcomplexmacros.pl",
152 : gage 328 );
153 : gage 497
154 :     ENDDOCUMENT();
155 : gage 386
156 : gage 279 END_OF_TEXT
157 :    
158 :     ###############################################################################
159 :     #
160 :     ###############################################################################
161 :    
162 :     ###############################################################################
163 :     ###############################################################################
164 :    
165 : gage 497 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n";
166 : gage 279
167 :    
168 :    
169 :     ###############################################################################
170 :     # The following code initializes an instantiation of PGtranslator5 in the
171 :     # parent process. This initialized object is then share with each of the
172 :     # children forked from this parent process by the daemon.
173 :     #
174 :     # As far as I can tell, the child processes don't share any variable values even
175 :     # though their namespaces are the same.
176 :     ###############################################################################
177 :    
178 : gage 497
179 : gage 2989 my $dummy_envir = { courseScriptsDirectory => $pgMacrosDirectory,
180 : gage 279 displayMode => $displayMode,
181 : gage 593 macroDirectory => $macroDirectory,
182 : gage 2989 displayModeFailover => DISPLAY_MODE_FAILOVER(),
183 :     externalTTHPath => $ce->{externalPrograms}->{tth},
184 :     };
185 : gage 497 my $pt = new WeBWorK::PG::Translator; #pt stands for problem translator;
186 : gage 2989 $pt ->rh_directories( { courseScriptsDirectory => $pgMacrosDirectory,
187 : gage 279 macroDirectory => $macroDirectory,
188 : gage 2989 scriptDirectory => '' ,
189 : gage 279 templateDirectory => $templateDirectory,
190 : gage 687 tempDirectory => $COURSE_TEMP_DIRECTORY,
191 : gage 279 }
192 :     );
193 :     $pt -> evaluate_modules( @MODULE_LIST);
194 : gage 497 #print STDERR "Completed loading of modules, now loading extra packages\n";
195 : gage 279 $pt -> load_extra_packages( @EXTRA_PACKAGES );
196 : gage 497 #print STDERR "Completed loading of packages, now loading environment\n";
197 : gage 279 $pt -> environment($dummy_envir);
198 : gage 497 #print STDERR "Completed loading environment, next initialize\n";
199 : gage 279 $pt->initialize();
200 : gage 497 #print STDERR "Initialized. \n";
201 :     $pt -> unrestricted_load($PG_PL );
202 :     $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
203 : gage 2353 $pt -> unrestricted_load($IO_PL);
204 : gage 279 $pt-> set_mask();
205 :     #
206 : gage 497 #print STDERR "Unrestricted loads completed.\n";
207 : gage 279
208 : gage 497 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/;
209 : gage 279 $pt->source_string( $INITIAL_MACRO_PACKAGES );
210 : gage 497 #print STDERR "source strings read in\n";
211 : gage 279 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
212 :     $pt ->translate();
213 : gage 320
214 :     print STDERR "New PGtranslator object inititialization completed.\n";
215 : gage 279 ################################################################################
216 :     ## This ends the initialization of the PGtranslator object
217 :     ################################################################################
218 :    
219 : gage 593
220 :    
221 : gage 279 ###############################################################################
222 :     # This subroutine is called by the child process. It reinitializes its copy of the
223 :     # PGtranslator5 object. The unrestricted_load and loadMacros subroutines of PGtranslator5
224 :     # have been modified so that if &_PG_init is already defined then nothing
225 :     # is read in but the initialization subroutine is run instead.
226 :     ###############################################################################
227 :    
228 :     sub renderProblem {
229 :     my $rh = shift;
230 :     my $beginTime = new Benchmark;
231 : gage 687 $WARNINGS = "";
232 :     local $SIG{__WARN__} =\&PG_warnings_handler;
233 : gage 2353
234 :     my $envir = $rh->{envir};
235 : gage 2989 foreach my $item (keys %PG_environment) {
236 :     $envir->{$item} = $PG_environment{$item};
237 :     }
238 : gage 2353 my $basename = 'equation-'.$envir->{psvn}. '.' .$envir->{probNum};
239 :     $basename .= '.' . $envir->{problemSeed} if $envir->{problemSeed};
240 : gage 2989
241 :     #FIXME debug line
242 :     #print STDERR "basename is $basename and psvn is ", $envir->{psvn};
243 :     my $imagesModeOptions = $ce->{pg}->{displayModeOptions}->{images};
244 :    
245 : gage 2353 # Object for generating equation images
246 : gage 2989 if ( $envir->{displayMode} eq 'HTML_dpng' ) {
247 :     $envir->{imagegen} = WeBWorK::PG::ImageGenerator->new(
248 :     tempDir => $ce->{webworkDirs}->{tmp}, # $Global::globalTmpDirectory, # global temp dir
249 :     latex => $ce->{externalPrograms}->{latex}, #$envir->{externalLaTeXPath},
250 :     dvipng => $ce->{externalPrograms}->{dvipng}, # $envir ->{externalDvipngPath},
251 :     useCache => 1,
252 :     cacheDir => $ce->{webworkDirs}->{equationCache},
253 :     cacheURL => $HOSTURL.$ce->{webworkURLs}->{equationCache},
254 :     cacheDB => $ce->{webworkFiles}->{equationCacheDB},
255 :     useMarkers => ($imagesModeOptions->{dvipng_align} && $imagesModeOptions->{dvipng_align} eq 'mysql'),
256 :     dvipng_align => $imagesModeOptions->{dvipng_align},
257 :     dvipng_depth_db => $imagesModeOptions->{dvipng_depth_db},
258 :     );
259 : gage 2353 }
260 : gage 2989
261 : gage 2353 $pt->environment($envir);
262 : gage 497 #$pt->{safe_cache} = $safe_cmpt_cache;
263 : gage 279 $pt->initialize();
264 :     $pt -> unrestricted_load($PG_PL);
265 :     $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
266 : gage 2353 $pt -> unrestricted_load($IO_PL);
267 : gage 279 $pt-> set_mask();
268 :    
269 :     my $string = decode_base64( $rh ->{source} );
270 :     $string =~ tr /\r/\n/;
271 :    
272 :     $pt->source_string( $string );
273 :     $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
274 :     $pt ->translate();
275 :    
276 : gage 2353 # HTML_dpng, on the other hand, uses an ImageGenerator. We have to
277 :     # render the queued equations.
278 :     if ($envir->{imagegen}) {
279 :     my $sourceFile = 'foobar'; #$ce->{courseDirs}->{templates} . "/" . $problem->source_file;
280 :     my %mtimeOption = -e $sourceFile
281 :     ? (mtime => (stat $sourceFile)[9])
282 :     : ();
283 :    
284 :     $envir->{imagegen}->render(
285 :     refresh => 1,
286 :     %mtimeOption,
287 :     );
288 :     }
289 : gage 279 # Determine which problem grader to use
290 :     #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default
291 :     my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE};
292 :    
293 :     if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty
294 :     if ($problem_grader_to_use eq 'std_problem_grader') {
295 :     # Reset problem grader to standard problem grader.
296 :     $pt->rf_problem_grader($pt->rf_std_problem_grader);
297 :     } elsif ($problem_grader_to_use eq 'avg_problem_grader') {
298 :     # Reset problem grader to average problem grader.
299 :     $pt->rf_problem_grader($pt->rf_avg_problem_grader);
300 :     } elsif (ref($problem_grader_to_use) eq 'CODE') {
301 :     # Set problem grader to instructor defined problem grader -- use cautiously.
302 :     $pt->rf_problem_grader($problem_grader_to_use)
303 :     } else {
304 :     warn "Error: Could not understand problem grader flag $problem_grader_to_use";
305 :     #this is the default set by the translator and used if the flag is not understood
306 :     #$pt->rf_problem_grader($pt->rf_std_problem_grader);
307 :     }
308 :    
309 :     } else {#this is the default set by the translator and used if no flag is set.
310 :     $pt->rf_problem_grader($pt->rf_std_problem_grader);
311 :     }
312 :    
313 :     # creates and stores a hash of answer results: $rh_answer_results
314 :     $pt -> process_answers($rh->{envir}->{inputs_ref});
315 :    
316 :    
317 :     $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score},
318 :     num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} ,
319 :     num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans}
320 :     } );
321 :     my %PG_FLAGS = $pt->h_flags;
322 :     my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ?
323 :     $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
324 :     my $answers_submitted = 0;
325 :     $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted};
326 :    
327 :     my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
328 :     ANSWER_ENTRY_ORDER => $ra_answer_entry_order
329 :     ); # grades the problem.
330 :     # protect image data for delivery via XML-RPC.
331 :     # Don't send code data.
332 :     my %PG_flag=();
333 :     # foreach my $key (keys %PG_FLAGS) {
334 :     # if ($key eq 'dynamic_images' ) {
335 :     # foreach my $ikey (keys %{$PG_FLAGS{'dynamic_images'} }) {
336 :     # $PG_flag{'dynamic_images'}->{$ikey} =
337 :     # encode_base64($PG_FLAGS{'dynamic_images'}->{$ikey});
338 :     # }
339 :     # } elsif (ref($PG_FLAGS{$key}) eq '' or ref($PG_FLAGS{$key}) =~ /SCALAR|HASH/) {
340 :     # $PG_flag{$key} = $PG_FLAGS{$key} ;
341 :     # }
342 :     # }
343 :    
344 : gage 593 if($rh->{envir}->{displayMode} eq 'HTML_dpng') {
345 :     my $forceRefresh=1;
346 :     # if($inputs{'refreshCachedImages'} || $main::refreshCachedImages
347 :     # || $displaySolutionsQ || $displayHintsQ) {
348 :     # $forceRefresh=1;
349 :     # }
350 : gage 2353 # $imgen->render('refresh'=>$forceRefresh); # Can force new images
351 : gage 593 }
352 : gage 279 my $out = {
353 :     text => encode_base64( ${$pt ->r_text()} ),
354 :     header_text => encode_base64( ${ $pt->r_header } ),
355 :     answers => $pt->rh_evaluated_answers,
356 :     errors => $pt-> errors(),
357 : gage 687 WARNINGS => encode_base64($WARNINGS ),
358 : gage 279 problem_result => $rh_problem_result,
359 :     problem_state => $rh_problem_state,
360 :     PG_flag => \%PG_flag
361 :     };
362 : gage 687
363 : gage 279 my $endTime = new Benchmark;
364 :     $out->{compute_time} = logTimingInfo($beginTime, $endTime);
365 :     $out;
366 :    
367 :     }
368 :    
369 :     ###############################################################################
370 :     # This ends the main subroutine executed by the child process in responding to
371 :     # a request. The other subroutines are auxiliary.
372 :     ###############################################################################
373 :    
374 :    
375 :     sub safetyFilter {
376 :     my $answer = shift; # accepts one answer and checks it
377 :     my $submittedAnswer = $answer;
378 :     $answer = '' unless defined $answer;
379 :     my ($errorno, $answerIsCorrectQ);
380 :     $answer =~ tr/\000-\037/ /;
381 :     #### Return if answer field is empty ########
382 :     unless ($answer =~ /\S/) {
383 :     # $errorno = "<BR>No answer was submitted.";
384 :     $errorno = 0; ## don't report blank answer as error
385 :    
386 :     return ($answer,$errorno);
387 :     }
388 : gage 961
389 : gage 279 ######### Return if forbidden characters are found
390 : gage 961 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\[\]\(\)\,\|]+$/ ) {
391 : gage 279 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c;
392 :     $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>";
393 :    
394 :     return ($answer,$errorno);
395 :     }
396 :    
397 :     $errorno = 0;
398 :     return($answer, $errorno);
399 :     }
400 :    
401 :    
402 :     sub logTimingInfo{
403 :     my ($beginTime,$endTime,) = @_;
404 :     my $out = "";
405 :     $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) );
406 :     $out;
407 :     }
408 : gage 687 ######################################################################
409 :     sub PG_warnings_handler {
410 :     my @input = @_;
411 :     my $msg_string = longmess(@_);
412 :     my @msg_array = split("\n",$msg_string);
413 :     my $out_string = '';
414 : gage 279
415 : gage 687 # Extra stack information is provided in this next block
416 :     # If the warning message does NOT end in \n then a line
417 :     # number is appended (see Perl manual about warn function)
418 :     # The presence of the line number is detected below and extra
419 :     # stack information is added.
420 :     # To suppress the line number and the extra stack information
421 :     # add \n to the end of a warn message (in .pl files. In .pg
422 :     # files add ~~n instead
423 : gage 279
424 : gage 687
425 :     if (@msg_array) { # if there are more details
426 :     $out_string .= "##More details. The calling sequence is: <BR>\n";
427 :     foreach my $line (@msg_array) {
428 :     chomp($line);
429 :     next unless $line =~/\w+\:\:/;
430 :     $out_string .= "----" .$line . "<BR>\n";
431 :     }
432 :     }
433 :    
434 :     $WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string .
435 :     "<BR>\n--------------------------------------<BR>\n<BR>\n";
436 :     }
437 :    
438 :     my $CarpLevel = 0; # How many extra package levels to skip on carp.
439 :     my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
440 :     sub longmess {
441 :     my $error = shift;
442 :     my $mess = "";
443 :     my $i = 1 + $CarpLevel;
444 :     my ($pack,$file,$line,$sub,$eval,$require);
445 :    
446 :     while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
447 :     if ($error =~ m/\n$/) {
448 :     $mess .= $error;
449 :     }
450 :     else {
451 :     if (defined $eval) {
452 :     if ($require) {
453 :     $sub = "require $eval";
454 :     }
455 :     else {
456 :     $eval =~ s/[\\\']/\\$&/g;
457 :     if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
458 :     substr($eval,$MaxEvalLen) = '...';
459 :     }
460 :     $sub = "eval '$eval'";
461 :     }
462 :     }
463 :     elsif ($sub eq '(eval)') {
464 :     $sub = 'eval {...}';
465 :     }
466 :    
467 :     $mess .= "\t$sub " if $error eq "called";
468 :     $mess .= "$error at $file line $line\n";
469 :     }
470 :    
471 :     $error = "called";
472 :     }
473 :    
474 :     $mess || $error;
475 :     }
476 :    
477 :     ######################################################################
478 :    
479 : gage 279 sub echo {
480 :     my $in= shift;
481 :     return(ref($in));
482 :     }
483 :     sub hello {
484 :     print "Receiving request for hello world\n";
485 :     return "Hello world";
486 :     }
487 :     sub pretty_print_rh {
488 :     my $rh = shift;
489 :     my $out = "";
490 :     my $type = ref($rh);
491 :     if ( ref($rh) =~/HASH/ ) {
492 :     foreach my $key (sort keys %{$rh}) {
493 :     $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n";
494 :     }
495 :     } elsif ( ref($rh) =~ /SCALAR/ ) {
496 :     $out = "scalar reference ". ${$rh};
497 :     } elsif ( ref($rh) =~/Base64/ ) {
498 :     $out .= "base64 reference " .$$rh;
499 :     } else {
500 :     $out = $rh;
501 :     }
502 :     if (defined($type) ) {
503 : gage 497 $out .= "type = $type \n";
504 : gage 279 }
505 :     return $out;
506 :     }
507 :    
508 :    
509 :    
510 :    
511 :    
512 :    
513 :    
514 :    
515 :    
516 : gage 497
517 :    
518 :    
519 :    
520 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9