Parent Directory
| 
Revision Log
Made changes which remove duplication between the code in Webwork.pm and code in WW2.1 -- This should make it easier to maintain the webwork daemons when changes are made in the core webwork code. More changes are on the way so that the daemon can run behind apache.
1 #!/usr/local/bin/perl -w 2 3 # 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 BEGIN { 13 14 use lib "$ENV{WEBWORK_ROOT}/lib"; 15 16 17 } 18 package Webwork; 19 20 BEGIN { $main::VERSION = "2.1"; } 21 22 #FIXME 23 $SIG{__WARN__} = sub {}; 24 $SIG{__DIE__} = sub {}; 25 26 use strict; 27 use sigtrap; 28 use Carp; 29 use Safe; 30 31 use WeBWorK::CourseEnvironment; 32 use WeBWorK::PG::Translator; 33 use WeBWorK::DB; 34 use WeBWorK::Constants; 35 use WeBWorK::Utils; 36 use WeBWorK::PG::IO; 37 use WeBWorK::PG::ImageGenerator; 38 use Benchmark; 39 use MIME::Base64 qw( encode_base64 decode_base64); 40 41 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 53 my $WW_DIRECTORY = $ENV{WEBWORK_ROOT}; 54 55 our $COURSENAME = 'daemon_course'; 56 our $HOSTURL = 'http://devel.webwork.rochester.edu:11002'; 57 58 59 our $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME); 60 61 print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce); 62 63 64 print "webwork is realy ready\n\n"; 65 #other services 66 # File variables 67 my $WARNINGS=''; 68 69 70 # imported constants 71 72 my $COURSE_TEMP_DIRECTORY = $ce->{courseDirs}->{html_tmp}; 73 my $COURSE_TEMP_URL = $HOSTURL.$ce->{courseURLs}->{html_tmp}; 74 75 my $pgMacrosDirectory = $ce->{pg_dir}.'/macros/'; 76 my $macroDirectory = $ce->{courseDirs}->{macros}.'/'; 77 my $templateDirectory = $ce->{courseDirs}->{templates}; 78 79 my %PG_environment = $ce->{pg}->{specialPGEnvironmentVars}; 80 print STDERR "using the perl version of MIME::Base64\n"; 81 82 83 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 93 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 108 ############################################################################### 109 # List and address of available problemlibraries 110 ############################################################################### 111 112 113 #my $libraryPath = '/Users/gage/rochester_problib/'; 114 115 116 117 ############################################################################### 118 # Initialize renderProblem 119 ############################################################################### 120 121 122 123 124 my $displayMode = 'HTML_tth'; 125 126 my $PG_PL = "${pgMacrosDirectory}/PG.pl"; 127 my $DANGEROUS_MACROS_PL = "${pgMacrosDirectory}/dangerousMacros.pl"; 128 my $IO_PL = "${pgMacrosDirectory}/IO.pl"; 129 my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 130 "Circle", "Label", "PGrandom", "Units", "Hermite", 131 "List", "Match","Multiple", "Select", "AlgParser", 132 "AnswerHash", "Fraction", "VectorField", "Complex1", 133 "Complex", "MatrixReal1", "Matrix","Distributions", 134 "Regression" 135 ); 136 my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", 137 "ExprWithImplicitExpand", "AnswerEvaluator", 138 # "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 ); 153 154 ENDDOCUMENT(); 155 156 END_OF_TEXT 157 158 ############################################################################### 159 # 160 ############################################################################### 161 162 ############################################################################### 163 ############################################################################### 164 165 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n"; 166 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 179 my $dummy_envir = { courseScriptsDirectory => $pgMacrosDirectory, 180 displayMode => $displayMode, 181 macroDirectory => $macroDirectory, 182 displayModeFailover => DISPLAY_MODE_FAILOVER(), 183 externalTTHPath => $ce->{externalPrograms}->{tth}, 184 }; 185 my $pt = new WeBWorK::PG::Translator; #pt stands for problem translator; 186 $pt ->rh_directories( { courseScriptsDirectory => $pgMacrosDirectory, 187 macroDirectory => $macroDirectory, 188 scriptDirectory => '' , 189 templateDirectory => $templateDirectory, 190 tempDirectory => $COURSE_TEMP_DIRECTORY, 191 } 192 ); 193 $pt -> evaluate_modules( @MODULE_LIST); 194 #print STDERR "Completed loading of modules, now loading extra packages\n"; 195 $pt -> load_extra_packages( @EXTRA_PACKAGES ); 196 #print STDERR "Completed loading of packages, now loading environment\n"; 197 $pt -> environment($dummy_envir); 198 #print STDERR "Completed loading environment, next initialize\n"; 199 $pt->initialize(); 200 #print STDERR "Initialized. \n"; 201 $pt -> unrestricted_load($PG_PL ); 202 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 203 $pt -> unrestricted_load($IO_PL); 204 $pt-> set_mask(); 205 # 206 #print STDERR "Unrestricted loads completed.\n"; 207 208 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; 209 $pt->source_string( $INITIAL_MACRO_PACKAGES ); 210 #print STDERR "source strings read in\n"; 211 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 212 $pt ->translate(); 213 214 print STDERR "New PGtranslator object inititialization completed.\n"; 215 ################################################################################ 216 ## This ends the initialization of the PGtranslator object 217 ################################################################################ 218 219 220 221 ############################################################################### 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 $WARNINGS = ""; 232 local $SIG{__WARN__} =\&PG_warnings_handler; 233 234 my $envir = $rh->{envir}; 235 foreach my $item (keys %PG_environment) { 236 $envir->{$item} = $PG_environment{$item}; 237 } 238 my $basename = 'equation-'.$envir->{psvn}. '.' .$envir->{probNum}; 239 $basename .= '.' . $envir->{problemSeed} if $envir->{problemSeed}; 240 241 #FIXME debug line 242 #print STDERR "basename is $basename and psvn is ", $envir->{psvn}; 243 my $imagesModeOptions = $ce->{pg}->{displayModeOptions}->{images}; 244 245 # Object for generating equation images 246 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 } 260 261 $pt->environment($envir); 262 #$pt->{safe_cache} = $safe_cmpt_cache; 263 $pt->initialize(); 264 $pt -> unrestricted_load($PG_PL); 265 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 266 $pt -> unrestricted_load($IO_PL); 267 $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 # 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 # 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 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 # $imgen->render('refresh'=>$forceRefresh); # Can force new images 351 } 352 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 WARNINGS => encode_base64($WARNINGS ), 358 problem_result => $rh_problem_result, 359 problem_state => $rh_problem_state, 360 PG_flag => \%PG_flag 361 }; 362 363 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 389 ######### Return if forbidden characters are found 390 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\[\]\(\)\,\|]+$/ ) { 391 $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 ###################################################################### 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 415 # 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 424 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 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 $out .= "type = $type \n"; 504 } 505 return $out; 506 } 507 508 509 510 511 512 513 514 515 516 517 518 519 520 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |