Parent Directory
| 
Revision Log
Copied in a version of safety_filter subroutine from PGtranslator5.pm in order to quite an "undefined" message. -- Mike
1 package WeBWorK::ContentGenerator::Problem; 2 our @ISA = qw(WeBWorK::ContentGenerator); 3 4 use strict; 5 use warnings; 6 use lib '/home/malsyned/xmlrpc/daemon'; 7 use lib '/Users/gage/webwork-modperl/lib'; 8 use PGtranslator5; 9 use WeBWorK::ContentGenerator; 10 use Apache::Constants qw(:common); 11 12 ############################################################################### 13 # Configuration 14 ############################################################################### 15 my $USER_DIRECTORY = '/Users/gage'; 16 my $COURSE_SCRIPTS_DIRECTORY = "$USER_DIRECTORY/webwork/system/courseScripts/"; 17 my $MACRO_DIRECTORY = "$USER_DIRECTORY/webwork-modperl/courses/demoCourse/templates/macros/"; 18 my $TEMPLATE_DIRECTORY = "$USER_DIRECTORY/rochester_problib/"; 19 my $TEMP_URL = "http://127.0.0.1/~gage/rochester_problibtmp/"; 20 ##my $HTML_DIRECTORY = "/Users/gage/Sites/rochester_problib/" #already obtained from courseEnvironment 21 my $HTML_URL = "http://127.0.0.1/~gage/rochester_problib/"; 22 my $TEMP_DIRECTORY = ""; # has to be here... for now 23 24 ############################################################################### 25 # End configuration 26 ############################################################################### 27 28 sub title { 29 my ($self, $problem_set, $problem) = @_; 30 my $r = $self->{r}; 31 my $user = $r->param('user'); 32 return "Problem $problem of problem set $problem_set for $user"; 33 } 34 35 ############################################################################### 36 # 37 # INITIALIZATION 38 # 39 # The following code initializes an instantiation of PGtranslator5 in the 40 # parent process. This initialized object is then share with each of the 41 # children forked from this parent process by the daemon. 42 # 43 # As far as I can tell, the child processes don't share any variable values even 44 # though their namespaces are the same. 45 ############################################################################### 46 # First some dummy values to use for testing. 47 # These should be available from the problemEnvironment(it might be ok to assume that PG and dangerousMacros 48 # live in the courseScripts (system level macros) directory. 49 50 #print STDERR "Begin intitalization\n"; 51 my $dummy_envir = { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY, 52 displayMode => 'HTML_tth', 53 macroDirectory => $MACRO_DIRECTORY, 54 cgiURL => 'foo_cgiURL'}; 55 56 57 my $PG_PL = "${COURSE_SCRIPTS_DIRECTORY}PG.pl"; 58 my $DANGEROUS_MACROS_PL = "${COURSE_SCRIPTS_DIRECTORY}dangerousMacros.pl"; 59 my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 60 "Circle", "Label", "PGrandom", "Units", "Hermite", 61 "List", "Match","Multiple", "Select", "AlgParser", 62 "AnswerHash", "Fraction", "VectorField", "Complex1", 63 "Complex", "MatrixReal1", "Matrix","Distributions", 64 "Regression" 65 ); 66 my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", 67 "ExprWithImplicitExpand", "AnswerEvaluator", 68 69 ); 70 my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT; 71 DOCUMENT(); 72 loadMacros( 73 "PGbasicmacros.pl", 74 "PGchoicemacros.pl", 75 "PGanswermacros.pl", 76 "PGnumericalmacros.pl", 77 "PGgraphmacros.pl", 78 "PGauxiliaryFunctions.pl", 79 "PGmatrixmacros.pl", 80 "PGcomplexmacros.pl", 81 "PGstatisticsmacros.pl" 82 83 ); 84 85 TEXT("Hello world"); 86 87 ENDDOCUMENT(); 88 89 END_OF_TEXT 90 91 #These here documents have their drawbacks. KEEP END_OF_TEXT left justified!!!!!! 92 93 ############################################################################### 94 # Now to define the body subroutine which does the hard work. 95 ############################################################################### 96 97 98 #my $SOURCE1 = $INITIAL_MACRO_PACKAGES; 99 100 sub body { 101 my ($self, $problem_set, $problem) = @_; 102 my $r = $self->{r}; 103 my $courseEnvironment = $self->{courseEnvironment}; 104 my $user = $r->param('user'); 105 106 my $rh = {}; # this needs to be set to a hash containing CGI params 107 108 109 my $SOURCE1 = readFile("$problem_set/$problem.pg"); 110 print STDERR "SOURCEFILE: \n$SOURCE1\n\n"; 111 112 ########################################################################### 113 # The pg problem class should have a method for installing it's problemEnvironment 114 ########################################################################### 115 116 my $problemEnvir_rh = defineProblemEnvir($self); 117 118 119 ################################################################################## 120 # Prime the PGtranslator object and set it loose 121 ################################################################################## 122 123 124 ############################################################################### 125 126 ############################################################################### 127 #Create the PG translator. 128 ############################################################################### 129 130 my $pt = new PGtranslator5; #pt stands for problem translator; 131 132 133 # All of these hard coded directories need to be drawn from courseEnvironment. 134 # In addition I don't think that PGtranslator uses this stack internally yet. 135 # Passing these directories through the problemEnvironment variable is what 136 # is currently being done, but I don't think it is quite right, at least for most 137 # of them. 138 139 140 $pt ->rh_directories( { courseScriptsDirectory => $COURSE_SCRIPTS_DIRECTORY, 141 macroDirectory => $MACRO_DIRECTORY, 142 , 143 templateDirectory => $TEMPLATE_DIRECTORY, 144 tempDirectory => $TEMP_DIRECTORY, 145 } 146 ); 147 148 ############################################################################### 149 # First we load the modules from courseScripts directory. 150 # These do the "heavy lifting" in terms of formatting, creating graphs, and 151 # performing other heavy duty algorithms. 152 # 153 ############################################################################### 154 155 $pt -> evaluate_modules( @MODULE_LIST); 156 $pt -> load_extra_packages( @EXTRA_PACKAGES ); 157 158 ############################################################################### 159 # Load the environment constants. Some are used by the PGtranslator object but 160 # most of them are installed inside the Safe compartment where the problem 161 # runs. 162 ############################################################################### 163 #$pt -> environment($dummy_envir); 164 $pt -> environment($problemEnvir_rh); 165 166 167 # I've forgotten what this does exactly :-) 168 $pt->initialize(); 169 170 ############################################################################### 171 # PG.pl contains the basic code which defines the problem interface, input and output. 172 # dangerousMacros.pl contains subroutines which have access to the hard drive and 173 # and the directory structure. All use of external resources by the problem is supposed 174 # to go through these subroutines. The idea is to put the potentially dangerous 175 # algorithms in on place so they can be watched closely. 176 # These two files are evaluated in the Safe compartment without any restrictions. 177 # They have full use of the perl commands. 178 ############################################################################### 179 my $loadErrors = $pt -> unrestricted_load($PG_PL ); 180 print STDERR "$loadErrors\n" if ($loadErrors); 181 $loadErrors = $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 182 print STDERR "$loadErrors\n" if ($loadErrors); 183 184 ############################################################################### 185 # Now set the mask to restrict the operations which can be performed within 186 # a problem or a macro file. 187 ############################################################################### 188 $pt-> set_mask(); 189 190 # print "\nPG.pl: $PG_PL<br>\n"; 191 # print "DANGEROUS_MACROS_PL: $DANGEROUS_MACROS_PL<br>\n"; 192 # print "Print dummy environment<br>\n"; 193 # print pretty_print_rh($dummy_envir), "<p>\n\n"; 194 195 # Read in the source code for the problem 196 197 #$INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; # change everything to unix line endings. 198 $SOURCE1 =~ tr /\r/\n/; 199 #print STDERR "Source again \n $SOURCE1"; 200 $pt->source_string( $SOURCE1 ); 201 202 ############################################################################### 203 # Install a safety filter for screening student answers. The default is now the blank 204 # filter since the answer evaluators do a pretty good job of recompiling and screening 205 # student's answers. Still, you could prohibit back ticks, or something of the kind. 206 ############################################################################### 207 208 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 209 210 211 print STDERR "New PGtranslator object inititialization completed.<br>\n"; 212 ################################################################################ 213 ## This ends the initialization of the PGtranslator object 214 ################################################################################ 215 216 217 ################################################################################ 218 # Run the problem (output the html text) but also store it within the object. 219 # The correct answers are also calculated and stored within the object 220 ################################################################################ 221 $pt ->translate(); 222 223 #print problem output 224 print "Problem goes here<p>\n"; 225 print "Problem output <br>\n"; 226 print "################################################################################<br><br>"; 227 print ${$pt->r_text()}; 228 print "<br><br>################################################################################<br>"; 229 print "<p>End of problem output<br>"; 230 231 232 #print source code 233 print "Source code<pre>\n"; 234 print $SOURCE1; 235 print "</pre>End source code<p>"; 236 ################################################################################ 237 # The format for the output is described here. We'll need a local variable 238 # to handle the warnings. From within the problem the warning command 239 # has been slaved to the __WARNINGS__ routine which is defined in Global. 240 # We'll need to provide an alternate mechanism. 241 # The base64 encoding is only needed for xml transmission. 242 ################################################################################ 243 print "################################################################################<br>"; 244 print "Warnings output<br>"; 245 my $WARNINGS = "Let this be a warning:"; 246 247 print $WARNINGS; 248 249 ################################################################################ 250 # Install the standard problem grader. See gage/xmlrpc/daemon.pm or processProblem8 for detailed 251 # code on how to choose which problem grader to install, depending on courseEnvironment and problem data. 252 # See also PG.pl which provides for problem by problem overrides. 253 ################################################################################ 254 255 $pt->rf_problem_grader($pt->rf_std_problem_grader); 256 257 ################################################################################ 258 # creates and stores a hash of answer results inside the object: $rh_answer_results 259 ################################################################################ 260 $pt -> process_answers($rh->{envir}->{inputs_ref}); 261 262 263 # THE UPDATE AND GRADING LOGIC COULD USE AN OVERHAUL. IT WAS SOMEWHAT CONSTRAINED 264 # BY LEGACY CONDITIONS IN THE ORIGINAL PROCESSPROBLEM8. IT'S NOT BAD 265 # BUT IT COULD PROBABLY BE MADE A LITTLE MORE STRAIGHT FORWARD. 266 ################################################################################ 267 # updates the problem state stored by the translator object from the problemEnvironment data 268 ################################################################################ 269 270 # $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score}, 271 # num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} , 272 # num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans} 273 # } ); 274 ################################################################################ 275 # grade the problem (and update the problem state again.) 276 ################################################################################ 277 278 # Define an entry order -- the default is the order they are received from the browser. 279 # (Which as I understand it is NOT guaranteed to be the Left->Right Up-> Down order we're 280 # used to in the West. 281 282 my %PG_FLAGS = $pt->h_flags; 283 my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ? 284 $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; 285 # Decide whether any answers were submitted. 286 my $answers_submitted = 0; 287 $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted}; 288 # If there are answers, grade them 289 my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted, 290 ANSWER_ENTRY_ORDER => $ra_answer_entry_order 291 ); # grades the problem. 292 293 # Output format expected by Webwork.pm (and I believe processProblem8, but check.) 294 my $out = { 295 text => ${$pt ->r_text()}, # encode_base64( ${$pt ->r_text()} ), 296 header_text => $pt->r_header, # encode_base64( ${ $pt->r_header } ), 297 answers => $pt->rh_evaluated_answers, 298 errors => $pt-> errors(), 299 WARNINGS => $WARNINGS, #encode_base64($WARNINGS ), 300 problem_result => $rh_problem_result, 301 problem_state => $rh_problem_state, 302 PG_flag => \%PG_FLAGS 303 }; 304 ########################################################################################## 305 # Debugging printout of environment tables 306 ########################################################################################## 307 308 print "<P>Request item<P>\n\n"; 309 print "<TABLE border=\"3\">"; 310 print $self->print_form_data('<tr><td>','</td><td>','</td></tr>'); 311 print "</table>\n"; 312 print "path info <br>\n"; 313 print $r->path_info(); 314 print "<P>\n\ncourseEnvironment<P>\n\n"; 315 print pretty_print_rh($courseEnvironment); 316 print "<P>\n\nproblemEnvironment<P>\n\n"; 317 print pretty_print_rh($problemEnvir_rh); 318 319 ########################################################################################## 320 # End 321 ########################################################################################## 322 ""; 323 } 324 # End the"body" routine for the Problem object. 325 326 327 sub safetyFilter { 328 my $answer = shift; # accepts one answer and checks it 329 my $submittedAnswer = $answer; 330 $answer = '' unless defined $answer; 331 my ($errorno); 332 $answer =~ tr/\000-\037/ /; 333 #### Return if answer field is empty ######## 334 unless ($answer =~ /\S/) { 335 # $errorno = "<BR>No answer was submitted."; 336 $errorno = 0; ## don't report blank answer as error 337 338 return ($answer,$errorno); 339 } 340 ######### replace ^ with ** (for exponentiation) 341 # $answer =~ s/\^/**/g; 342 ######### Return if forbidden characters are found 343 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 344 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 345 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 346 347 return ($answer,$errorno); 348 } 349 350 $errorno = 0; 351 return($answer, $errorno); 352 } 353 354 355 356 357 ######################################################################################## 358 # This is the problemEnvironment structure that needs to be filled out in order to provide 359 # information to PGtranslator which in turn supports the problem environment 360 ######################################################################################## 361 362 sub defineProblemEnvir { 363 my $self = shift; 364 my $r = $self->{r}; 365 my $courseEnvironment = $self->{courseEnvironment}; 366 my %envir=(); 367 # $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers); 368 $envir{'psvnNumber'} = 123456789; 369 $envir{'psvn'} = 123456789; 370 $envir{'studentName'} = 'Jane Doe'; 371 $envir{'studentLogin'} = 'jd001m'; 372 $envir{'studentID'} = 'xxx-xx-4321'; 373 $envir{'sectionName'} = 'gage'; 374 $envir{'sectionNumber'} = '111foobar'; 375 $envir{'recitationName'} = 'gage_recitation'; 376 $envir{'recitationNumber'} = '11_foobar recitation'; 377 $envir{'setNumber'} = 'setAlgebraicGeometry'; 378 $envir{'questionNumber'} = 43; 379 $envir{'probNum'} = 43; 380 $envir{'openDate'} = 3014438528; 381 $envir{'formattedOpenDate'} = '3/4/02'; 382 $envir{'dueDate'} = 4014438528; 383 $envir{'formattedDueDate'} = '10/4/04'; 384 $envir{'answerDate'} = 4014438528; 385 $envir{'formattedAnswerDate'} = '10/4/04'; 386 $envir{'problemValue'} = 1; 387 $envir{'fileName'} = 'problem1'; 388 $envir{'probFileName'} = 'problem1'; 389 $envir{'languageMode'} = 'HTML_tth'; 390 $envir{'displayMode'} = 'HTML_tth'; 391 $envir{'outputMode'} = 'HTML_tth'; 392 $envir{'courseName'} = $courseEnvironment ->{courseName}; 393 $envir{'sessionKey'} = 'asdf'; 394 395 # initialize constants for PGanswermacros.pl 396 $envir{'numRelPercentTolDefault'} = .1; 397 $envir{'numZeroLevelDefault'} = 1E-14; 398 $envir{'numZeroLevelTolDefault'} = 1E-12; 399 $envir{'numAbsTolDefault'} = .001; 400 $envir{'numFormatDefault'} = ''; 401 $envir{'functRelPercentTolDefault'} = .1; 402 $envir{'functZeroLevelDefault'} = 1E-14; 403 $envir{'functZeroLevelTolDefault'} = 1E-12; 404 $envir{'functAbsTolDefault'} = .001; 405 $envir{'functNumOfPoints'} = 3; 406 $envir{'functVarDefault'} = 'x'; 407 $envir{'functLLimitDefault'} = .0000001; 408 $envir{'functULimitDefault'} = .9999999; 409 $envir{'functMaxConstantOfIntegration'} = 1E8; 410 # kludge check definition of number of attempts again. The +1 is because this is used before the current answer is evaluated. 411 $envir{'numOfAttempts'} = 2; #&getProblemNumOfCorrectAns($probNum,$psvn) 412 # &getProblemNumOfIncorrectAns($probNum,$psvn)+1; 413 414 # 415 # 416 # defining directorys and URLs 417 $envir{'templateDirectory'} = $courseEnvironment ->{courseDirs}->{templates}; 418 ############ $envir{'classDirectory'} = $Global::classDirectory; 419 # $envir{'cgiDirectory'} = $Global::cgiDirectory; 420 # $envir{'cgiURL'} = getWebworkCgiURL(); 421 422 # $envir{'scriptDirectory'} = $Global::scriptDirectory;##omit 423 $envir{'webworkDocsURL'} = 'http://webwork.math.rochester.edu'; 424 $envir{'externalTTHPath'} = '/usr/local/bin/tth'; 425 426 427 # 428 $envir{'inputs_ref'} = $r->param; 429 $envir{'problemSeed'} = 3245; 430 $envir{'displaySolutionsQ'} = 1; 431 $envir{'displayHintsQ'} = 1; 432 433 # Directory values -- do we really need them here? 434 $envir{courseScriptsDirectory} = $COURSE_SCRIPTS_DIRECTORY; 435 $envir{macroDirectory} = $MACRO_DIRECTORY; 436 $envir{templateDirectory} = $TEMPLATE_DIRECTORY; 437 $envir{tempDirectory} = $TEMP_DIRECTORY; 438 $envir{tempURL} = $TEMP_URL; 439 $envir{htmlURL} = $HTML_URL; 440 $envir{'htmlDirectory'} = $courseEnvironment ->{courseDirectory}->{html}; 441 # here is a way to pass environment variables defined in webworkCourse.ph 442 # my $k; 443 # foreach $k (keys %Global::PG_environment ) { 444 # $envir{$k} = $Global::PG_environment{$k}; 445 # } 446 \%envir; 447 } 448 449 ######################################################################################## 450 # This recursive pretty_print function will print a hash and its sub hashes. 451 ######################################################################################## 452 sub pretty_print_rh { 453 my $r_input = shift; 454 my $out = ''; 455 if ( not ref($r_input) ) { 456 $out = $r_input; # not a reference 457 } elsif (is_hash_ref($r_input)) { 458 local($^W) = 0; 459 $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; 460 foreach my $key (sort keys %$r_input ) { 461 $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print_rh($r_input->{$key}) . "</td></tr>"; 462 } 463 $out .="</table>"; 464 } elsif (is_array_ref($r_input) ) { 465 my @array = @$r_input; 466 $out .= "( " ; 467 while (@array) { 468 $out .= pretty_print_rh(shift @array) . " , "; 469 } 470 $out .= " )"; 471 } elsif (ref($r_input) eq 'CODE') { 472 $out = "$r_input"; 473 } else { 474 $out = $r_input; 475 } 476 $out; 477 } 478 479 sub is_hash_ref { 480 my $in =shift; 481 my $save_SIG_die_trap = $SIG{__DIE__}; 482 $SIG{__DIE__} = sub {CORE::die(@_) }; 483 my $out = eval{ %{ $in } }; 484 $out = ($@ eq '') ? 1 : 0; 485 $@=''; 486 $SIG{__DIE__} = $save_SIG_die_trap; 487 $out; 488 } 489 sub is_array_ref { 490 my $in =shift; 491 my $save_SIG_die_trap = $SIG{__DIE__}; 492 $SIG{__DIE__} = sub {CORE::die(@_) }; 493 my $out = eval{ @{ $in } }; 494 $out = ($@ eq '') ? 1 : 0; 495 $@=''; 496 $SIG{__DIE__} = $save_SIG_die_trap; 497 $out; 498 } 499 500 ###### 501 # Utility for slurping souce files 502 ####### 503 504 sub readFile { 505 my $input = shift; # The set and problem: 'set0/prob1.pg' 506 my $filePath =$TEMPLATE_DIRECTORY .$input; 507 print STDERR "Reading problem from file $filePath \n"; 508 print STDERR "<br>Reading problem from file $filePath <br>\n"; 509 my $out; 510 print "The file is readable = ", -r $filePath, "\n"; 511 if (-r $filePath) { 512 open IN, "<$filePath" or print STDERR "Hey, this file was supposed to be readable\n"; 513 local($/)=undef; 514 $out = <IN>; 515 close(IN); 516 } else { 517 print "Could not read file at |$filePath|"; 518 print STDERR "Could not read file at |$filePath|"; 519 } 520 return($out); 521 } 522 523 my $foo =0; 524 525 # The warning mechanism. This needs to be turned into an object of its own 526 ############### 527 ## Error message routines cribbed from CGI 528 ############### 529 530 BEGIN { #error message routines cribbed from CGI 531 532 my $CarpLevel = 0; # How many extra package levels to skip on carp. 533 my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. 534 535 sub longmess { 536 my $error = shift; 537 my $mess = ""; 538 my $i = 1 + $CarpLevel; 539 my ($pack,$file,$line,$sub,$eval,$require); 540 541 while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { 542 if ($error =~ m/\n$/) { 543 $mess .= $error; 544 } 545 else { 546 if (defined $eval) { 547 if ($require) { 548 $sub = "require $eval"; 549 } 550 else { 551 $eval =~ s/[\\\']/\\$&/g; 552 if ($MaxEvalLen && length($eval) > $MaxEvalLen) { 553 substr($eval,$MaxEvalLen) = '...'; 554 } 555 $sub = "eval '$eval'"; 556 } 557 } 558 elsif ($sub eq '(eval)') { 559 $sub = 'eval {...}'; 560 } 561 562 $mess .= "\t$sub " if $error eq "called"; 563 $mess .= "$error at $file line $line\n"; 564 } 565 566 $error = "called"; 567 } 568 569 $mess || $error; 570 } 571 } 572 ############### 573 ### Our error messages for giving maximum feedback to the user for errors within problems. 574 ############### 575 BEGIN { 576 sub PG_floating_point_exception_handler { # 1st argument is signal name 577 my($sig) = @_; 578 print "Content-type: text/html\n\n<H4>There was a floating point arithmetic error (exception SIG$sig )</H4>--perhaps 579 you divided by zero or took the square root of a negative number? 580 <BR>\n Use the back button to return to the previous page and recheck your entries.<BR>\n"; 581 exit(0); 582 } 583 584 $SIG{'FPE'} = \&PG_floating_point_exception_handler; 585 #!/usr/bin/perl -w 586 sub PG_warnings_handler { 587 my @input = @_; 588 my $msg_string = longmess(@_); 589 my @msg_array = split("\n",$msg_string); 590 my $out_string = ''; 591 592 # Extra stack information is provided in this next block 593 # If the warning message does NOT end in \n then a line 594 # number is appended (see Perl manual about warn function) 595 # The presence of the line number is detected below and extra 596 # stack information is added. 597 # To suppress the line number and the extra stack information 598 # add \n to the end of a warn message (in .pl files. In .pg 599 # files add ~~n instead 600 601 if ($input[$#input]=~/line \d*\.\s*$/) { 602 $out_string .= "##More details: <BR>\n----"; 603 foreach my $line (@msg_array) { 604 chomp($line); 605 next unless $line =~/\w+\:\:/; 606 $out_string .= "----" .$line . "<BR>\n"; 607 } 608 } 609 610 $Global::WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string . 611 "<BR>\n--------------------------------------<BR>\n<BR>\n"; 612 $Global::background_plain_url = $Global::background_warn_url; 613 $Global::bg_color = '#FF99CC'; #for warnings -- this change may come too late 614 } 615 616 $SIG{__WARN__}=\&PG_warnings_handler; 617 618 $SIG{__DIE__} = sub { 619 my $message = longmess(@_); 620 $message =~ s/\n/<BR>\n/; 621 my ($package, $filename, $line) = caller(); 622 # use standard die for errors eminating from XML::Parser::Expat 623 # it uses a trapped eval which sometimes fails -- apparently on purpose 624 # and the error is handled by Expat itself. We don't want 625 # to interfer with that. 626 627 if ($package eq 'XML::Parser::Expat') { 628 die @_; 629 } 630 #print "$package $filename $line \n"; 631 print 632 "Content-type: text/html\r\n\r\n <h4>Software error</h4> <p>\n\n$message\n<p>\n 633 Please inform the webwork meister.<p>\n 634 In addition to the error message above the following warnings were detected: 635 <HR> 636 $Global::WARNINGS; 637 <HR> 638 It's sometimes hard to tell exactly what has gone wrong since the 639 full error message may have been sent to 640 standard error instead of to standard out. 641 <p> To debug you can 642 <ul> 643 <li> guess what went wrong and try to fix it. 644 <li> call the offending script directly from the command line 645 of unix 646 <li> enable the debugging features by redefining 647 \$cgiURL in Global.pm and checking the redirection scripts in 648 system/cgi. This will force the standard error to be placed 649 in the standard out pipe as well. 650 <li> Run tail -f error_log <br> 651 from the unix command line to see error messages from the webserver. 652 The standard error output is being placed in the error_log file for the apache 653 web server. To run this command you have to be in the directory containing the 654 error_log or enter the full path name of the error_log. <p> 655 In a standard apache installation, this file is at /usr/local/apache/logs/error_log<p> 656 In a RedHat Linux installation, this file is at /var/log/httpd/error_log<p> 657 At Rochester this file is at /ww/logs/error_log. 658 </ul> 659 Good luck.<p>\n" ; 660 }; 661 662 663 664 } 665 666 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |