Parent Directory
| 
Revision Log
Removed references to Global. Updated some of the warning mechanisms.
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 13 package Webwork; 14 15 use strict; 16 use sigtrap; 17 use Carp; 18 use Safe; 19 use WeBWorK::PG::Translator; 20 use WeBWorK::PG::IO; 21 use Benchmark; 22 use MIME::Base64 qw( encode_base64 decode_base64); 23 use ImageGenerator; 24 25 #other services 26 # File variables 27 my $WARNINGS=''; 28 29 30 # imported constants 31 32 my $COURSE_TEMP_DIRECTORY = '/Users/gage/webwork/courseData/demoCourse/html/tmp/'; 33 #my $COURSE_TEMP_URL = 'http://127.0.0.1/courses/demoCourse/tmp/'; 34 35 36 # $Global::groupID = "webwork"; 37 # $Global::numericalGroupID = 1005; 38 39 # A hack to get the directory permissions working. 40 #$Global::tmp_directory_permission ='0777'; 41 42 43 44 45 print STDERR "using the perl version of MIME::Base64\n"; 46 47 48 49 50 51 52 ############################################################################### 53 # List and address of available problemlibraries 54 ############################################################################### 55 56 57 my $libraryPath = '/Users/gage/rochester_problib/'; 58 59 60 61 ############################################################################### 62 # Initialize renderProblem 63 ############################################################################### 64 my $courseScriptsDirectory = '/Users/gage/webwork/system/courseScripts/'; 65 my $macroDirectory = 'Undefined'; 66 my $scriptDirectory = '/Users/gage/webwork/system/scripts/'; 67 my $templateDirectory = 'Undefined'; 68 69 70 71 my $displayMode = 'HTML_tth'; 72 73 my $PG_PL = "${courseScriptsDirectory}PG.pl"; 74 my $DANGEROUS_MACROS_PL = "${courseScriptsDirectory}dangerousMacros.pl"; 75 my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 76 "Circle", "Label", "PGrandom", "Units", "Hermite", 77 "List", "Match","Multiple", "Select", "AlgParser", 78 "AnswerHash", "Fraction", "VectorField", "Complex1", 79 "Complex", "MatrixReal1", "Matrix","Distributions", 80 "Regression" 81 ); 82 my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", 83 "ExprWithImplicitExpand", "AnswerEvaluator", 84 # "AnswerEvaluatorMaker" 85 ); 86 my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT; 87 DOCUMENT(); 88 loadMacros( 89 "PGbasicmacros.pl", 90 "PGchoicemacros.pl", 91 "PGanswermacros.pl", 92 "PGnumericalmacros.pl", 93 "PGgraphmacros.pl", 94 "PGauxiliaryFunctions.pl", 95 "PGmatrixmacros.pl", 96 "PGstatisticsmacros.pl", 97 "PGcomplexmacros.pl", 98 ); 99 100 ENDDOCUMENT(); 101 102 END_OF_TEXT 103 104 ############################################################################### 105 # 106 ############################################################################### 107 108 ############################################################################### 109 ############################################################################### 110 111 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n"; 112 113 114 115 ############################################################################### 116 # The following code initializes an instantiation of PGtranslator5 in the 117 # parent process. This initialized object is then share with each of the 118 # children forked from this parent process by the daemon. 119 # 120 # As far as I can tell, the child processes don't share any variable values even 121 # though their namespaces are the same. 122 ############################################################################### 123 124 125 my $dummy_envir = { courseScriptsDirectory => $courseScriptsDirectory, 126 displayMode => $displayMode, 127 macroDirectory => $macroDirectory, 128 externalTTHPath => '/usr/local/bin/tth'}; 129 my $pt = new WeBWorK::PG::Translator; #pt stands for problem translator; 130 $pt ->rh_directories( { courseScriptsDirectory => $courseScriptsDirectory, 131 macroDirectory => $macroDirectory, 132 scriptDirectory => $scriptDirectory , 133 templateDirectory => $templateDirectory, 134 tempDirectory => $COURSE_TEMP_DIRECTORY, 135 } 136 ); 137 $pt -> evaluate_modules( @MODULE_LIST); 138 #print STDERR "Completed loading of modules, now loading extra packages\n"; 139 $pt -> load_extra_packages( @EXTRA_PACKAGES ); 140 #print STDERR "Completed loading of packages, now loading environment\n"; 141 $pt -> environment($dummy_envir); 142 #print STDERR "Completed loading environment, next initialize\n"; 143 $pt->initialize(); 144 #print STDERR "Initialized. \n"; 145 $pt -> unrestricted_load($PG_PL ); 146 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 147 $pt-> set_mask(); 148 # 149 #print STDERR "Unrestricted loads completed.\n"; 150 151 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; 152 $pt->source_string( $INITIAL_MACRO_PACKAGES ); 153 #print STDERR "source strings read in\n"; 154 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 155 $pt ->translate(); 156 157 print STDERR "New PGtranslator object inititialization completed.\n"; 158 ################################################################################ 159 ## This ends the initialization of the PGtranslator object 160 ################################################################################ 161 162 163 164 ############################################################################### 165 # This subroutine is called by the child process. It reinitializes its copy of the 166 # PGtranslator5 object. The unrestricted_load and loadMacros subroutines of PGtranslator5 167 # have been modified so that if &_PG_init is already defined then nothing 168 # is read in but the initialization subroutine is run instead. 169 ############################################################################### 170 171 sub renderProblem { 172 my $rh = shift; 173 my $beginTime = new Benchmark; 174 $WARNINGS = ""; 175 local $SIG{__WARN__} =\&PG_warnings_handler; 176 my $imgen=""; 177 if($rh->{envir}->{displayMode} eq 'HTML_dpng') { 178 $imgen = new ImageGenerator; 179 $imgen->initialize($rh->{envir}); 180 } 181 $rh->{envir}->{imagegen} = $imgen; 182 $pt->environment($rh->{envir}); 183 #$pt->{safe_cache} = $safe_cmpt_cache; 184 $pt->initialize(); 185 $pt -> unrestricted_load($PG_PL); 186 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 187 $pt-> set_mask(); 188 189 my $string = decode_base64( $rh ->{source} ); 190 $string =~ tr /\r/\n/; 191 192 $pt->source_string( $string ); 193 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 194 $pt ->translate(); 195 196 197 # Determine which problem grader to use 198 #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default 199 my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE}; 200 201 if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty 202 if ($problem_grader_to_use eq 'std_problem_grader') { 203 # Reset problem grader to standard problem grader. 204 $pt->rf_problem_grader($pt->rf_std_problem_grader); 205 } elsif ($problem_grader_to_use eq 'avg_problem_grader') { 206 # Reset problem grader to average problem grader. 207 $pt->rf_problem_grader($pt->rf_avg_problem_grader); 208 } elsif (ref($problem_grader_to_use) eq 'CODE') { 209 # Set problem grader to instructor defined problem grader -- use cautiously. 210 $pt->rf_problem_grader($problem_grader_to_use) 211 } else { 212 warn "Error: Could not understand problem grader flag $problem_grader_to_use"; 213 #this is the default set by the translator and used if the flag is not understood 214 #$pt->rf_problem_grader($pt->rf_std_problem_grader); 215 } 216 217 } else {#this is the default set by the translator and used if no flag is set. 218 $pt->rf_problem_grader($pt->rf_std_problem_grader); 219 } 220 221 # creates and stores a hash of answer results: $rh_answer_results 222 $pt -> process_answers($rh->{envir}->{inputs_ref}); 223 224 225 $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score}, 226 num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} , 227 num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans} 228 } ); 229 my %PG_FLAGS = $pt->h_flags; 230 my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ? 231 $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; 232 my $answers_submitted = 0; 233 $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted}; 234 235 my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted, 236 ANSWER_ENTRY_ORDER => $ra_answer_entry_order 237 ); # grades the problem. 238 # protect image data for delivery via XML-RPC. 239 # Don't send code data. 240 my %PG_flag=(); 241 # foreach my $key (keys %PG_FLAGS) { 242 # if ($key eq 'dynamic_images' ) { 243 # foreach my $ikey (keys %{$PG_FLAGS{'dynamic_images'} }) { 244 # $PG_flag{'dynamic_images'}->{$ikey} = 245 # encode_base64($PG_FLAGS{'dynamic_images'}->{$ikey}); 246 # } 247 # } elsif (ref($PG_FLAGS{$key}) eq '' or ref($PG_FLAGS{$key}) =~ /SCALAR|HASH/) { 248 # $PG_flag{$key} = $PG_FLAGS{$key} ; 249 # } 250 # } 251 252 if($rh->{envir}->{displayMode} eq 'HTML_dpng') { 253 my $forceRefresh=1; 254 # if($inputs{'refreshCachedImages'} || $main::refreshCachedImages 255 # || $displaySolutionsQ || $displayHintsQ) { 256 # $forceRefresh=1; 257 # } 258 $imgen->render('refresh'=>$forceRefresh); # Can force new images 259 } 260 my $out = { 261 text => encode_base64( ${$pt ->r_text()} ), 262 header_text => encode_base64( ${ $pt->r_header } ), 263 answers => $pt->rh_evaluated_answers, 264 errors => $pt-> errors(), 265 WARNINGS => encode_base64($WARNINGS ), 266 problem_result => $rh_problem_result, 267 problem_state => $rh_problem_state, 268 PG_flag => \%PG_flag 269 }; 270 271 my $endTime = new Benchmark; 272 $out->{compute_time} = logTimingInfo($beginTime, $endTime); 273 $out; 274 275 } 276 277 ############################################################################### 278 # This ends the main subroutine executed by the child process in responding to 279 # a request. The other subroutines are auxiliary. 280 ############################################################################### 281 282 283 sub safetyFilter { 284 my $answer = shift; # accepts one answer and checks it 285 my $submittedAnswer = $answer; 286 $answer = '' unless defined $answer; 287 my ($errorno, $answerIsCorrectQ); 288 $answer =~ tr/\000-\037/ /; 289 #### Return if answer field is empty ######## 290 unless ($answer =~ /\S/) { 291 # $errorno = "<BR>No answer was submitted."; 292 $errorno = 0; ## don't report blank answer as error 293 294 return ($answer,$errorno); 295 } 296 ######### replace ^ with ** (for exponentiation) 297 # $answer =~ s/\^/**/g; 298 ######### Return if forbidden characters are found 299 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 300 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 301 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 302 303 return ($answer,$errorno); 304 } 305 306 $errorno = 0; 307 return($answer, $errorno); 308 } 309 310 311 sub logTimingInfo{ 312 my ($beginTime,$endTime,) = @_; 313 my $out = ""; 314 $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) ); 315 $out; 316 } 317 ###################################################################### 318 sub PG_warnings_handler { 319 my @input = @_; 320 my $msg_string = longmess(@_); 321 my @msg_array = split("\n",$msg_string); 322 my $out_string = ''; 323 324 # Extra stack information is provided in this next block 325 # If the warning message does NOT end in \n then a line 326 # number is appended (see Perl manual about warn function) 327 # The presence of the line number is detected below and extra 328 # stack information is added. 329 # To suppress the line number and the extra stack information 330 # add \n to the end of a warn message (in .pl files. In .pg 331 # files add ~~n instead 332 333 334 if (@msg_array) { # if there are more details 335 $out_string .= "##More details. The calling sequence is: <BR>\n"; 336 foreach my $line (@msg_array) { 337 chomp($line); 338 next unless $line =~/\w+\:\:/; 339 $out_string .= "----" .$line . "<BR>\n"; 340 } 341 } 342 343 $WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string . 344 "<BR>\n--------------------------------------<BR>\n<BR>\n"; 345 } 346 347 my $CarpLevel = 0; # How many extra package levels to skip on carp. 348 my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. 349 sub longmess { 350 my $error = shift; 351 my $mess = ""; 352 my $i = 1 + $CarpLevel; 353 my ($pack,$file,$line,$sub,$eval,$require); 354 355 while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { 356 if ($error =~ m/\n$/) { 357 $mess .= $error; 358 } 359 else { 360 if (defined $eval) { 361 if ($require) { 362 $sub = "require $eval"; 363 } 364 else { 365 $eval =~ s/[\\\']/\\$&/g; 366 if ($MaxEvalLen && length($eval) > $MaxEvalLen) { 367 substr($eval,$MaxEvalLen) = '...'; 368 } 369 $sub = "eval '$eval'"; 370 } 371 } 372 elsif ($sub eq '(eval)') { 373 $sub = 'eval {...}'; 374 } 375 376 $mess .= "\t$sub " if $error eq "called"; 377 $mess .= "$error at $file line $line\n"; 378 } 379 380 $error = "called"; 381 } 382 383 $mess || $error; 384 } 385 386 ###################################################################### 387 388 sub echo { 389 my $in= shift; 390 return(ref($in)); 391 } 392 sub hello { 393 print "Receiving request for hello world\n"; 394 return "Hello world"; 395 } 396 sub pretty_print_rh { 397 my $rh = shift; 398 my $out = ""; 399 my $type = ref($rh); 400 if ( ref($rh) =~/HASH/ ) { 401 foreach my $key (sort keys %{$rh}) { 402 $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n"; 403 } 404 } elsif ( ref($rh) =~ /SCALAR/ ) { 405 $out = "scalar reference ". ${$rh}; 406 } elsif ( ref($rh) =~/Base64/ ) { 407 $out .= "base64 reference " .$$rh; 408 } else { 409 $out = $rh; 410 } 411 if (defined($type) ) { 412 $out .= "type = $type \n"; 413 } 414 return $out; 415 } 416 417 418 419 420 421 422 423 424 425 426 427 428 429 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |