[system] / trunk / webwork-modperl / lib / WeBWorK / ContentGenerator / Problem.pm Repository:
ViewVC logotype

View of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Problem.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 398 - (download) (as text) (annotate)
Thu Jun 20 21:22:31 2002 UTC (11 years, 9 months ago) by gage
File size: 25121 byte(s)
*** empty log message ***

    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 
  328 
  329 
  330 
  331 ########################################################################################
  332 # This is the problemEnvironment structure that needs to be filled out in order to  provide
  333 # information to PGtranslator which in turn supports the problem environment
  334 ########################################################################################
  335 
  336 sub defineProblemEnvir {
  337   my $self = shift;
  338   my $r = $self->{r};
  339   my $courseEnvironment = $self->{courseEnvironment};
  340     my %envir=();
  341 #    $envir{'refSubmittedAnswers'}  =   $refSubmittedAnswers if defined($refSubmittedAnswers);
  342      $envir{'psvnNumber'}       =   123456789;
  343     $envir{'psvn'}            = 123456789;
  344    $envir{'studentName'}        =   'Jane Doe';
  345   $envir{'studentLogin'}        = 'jd001m';
  346   $envir{'studentID'}         = 'xxx-xx-4321';
  347   $envir{'sectionName'}       = 'gage';
  348   $envir{'sectionNumber'}       = '111foobar';
  349   $envir{'recitationName'}      = 'gage_recitation';
  350   $envir{'recitationNumber'}      = '11_foobar recitation';
  351   $envir{'setNumber'}         = 'setAlgebraicGeometry';
  352   $envir{'questionNumber'}        = 43;
  353   $envir{'probNum'}           = 43;
  354   $envir{'openDate'}          = 3014438528;
  355   $envir{'formattedOpenDate'}     = '3/4/02';
  356   $envir{'dueDate'}           = 4014438528;
  357   $envir{'formattedDueDate'}      = '10/4/04';
  358   $envir{'answerDate'}        = 4014438528;
  359   $envir{'formattedAnswerDate'}   = '10/4/04';
  360   $envir{'problemValue'}        = 1;
  361   $envir{'fileName'}          = 'problem1';
  362   $envir{'probFileName'}        = 'problem1';
  363   $envir{'languageMode'}        = 'HTML_tth';
  364   $envir{'displayMode'}       = 'HTML_tth';
  365   $envir{'outputMode'}        = 'HTML_tth';
  366   $envir{'courseName'}        = $courseEnvironment ->{courseName};
  367   $envir{'sessionKey'}        = 'asdf';
  368 
  369 # initialize constants for PGanswermacros.pl
  370   $envir{'numRelPercentTolDefault'}   =     .1;
  371   $envir{'numZeroLevelDefault'}   =     1E-14;
  372   $envir{'numZeroLevelTolDefault'}  =     1E-12;
  373   $envir{'numAbsTolDefault'}      =     .001;
  374   $envir{'numFormatDefault'}      =     '';
  375   $envir{'functRelPercentTolDefault'} =     .1;
  376   $envir{'functZeroLevelDefault'}   =     1E-14;
  377   $envir{'functZeroLevelTolDefault'}  =     1E-12;
  378   $envir{'functAbsTolDefault'}    =     .001;
  379   $envir{'functNumOfPoints'}      =     3;
  380   $envir{'functVarDefault'}       =     'x';
  381   $envir{'functLLimitDefault'}    =     .0000001;
  382   $envir{'functULimitDefault'}    =     .9999999;
  383   $envir{'functMaxConstantOfIntegration'} = 1E8;
  384 # kludge check definition of number of attempts again. The +1 is because this is used before the current answer is evaluated.
  385   $envir{'numOfAttempts'}             =    2; #&getProblemNumOfCorrectAns($probNum,$psvn)
  386                                               # &getProblemNumOfIncorrectAns($probNum,$psvn)+1;
  387 
  388 #
  389 #
  390 #   defining directorys and URLs
  391   $envir{'templateDirectory'}       = $courseEnvironment ->{courseDirs}->{templates};
  392 ############  $envir{'classDirectory'}        = $Global::classDirectory;
  393 # $envir{'cgiDirectory'}        = $Global::cgiDirectory;
  394 # $envir{'cgiURL'}                    =   getWebworkCgiURL();
  395 
  396 #   $envir{'scriptDirectory'}       = $Global::scriptDirectory;##omit
  397   $envir{'webworkDocsURL'}        = 'http://webwork.math.rochester.edu';
  398   $envir{'externalTTHPath'}       = '/usr/local/bin/tth';
  399 
  400 
  401 #
  402   $envir{'inputs_ref'}                =   $r->param;
  403   $envir{'problemSeed'}         =   3245;
  404   $envir{'displaySolutionsQ'}     =   1;
  405   $envir{'displayHintsQ'}       =   1;
  406 
  407 # Directory values -- do we really need them here?
  408   $envir{courseScriptsDirectory}  = $COURSE_SCRIPTS_DIRECTORY;
  409   $envir{macroDirectory}      = $MACRO_DIRECTORY;
  410   $envir{templateDirectory}   = $TEMPLATE_DIRECTORY;
  411   $envir{tempDirectory}     = $TEMP_DIRECTORY;
  412   $envir{tempURL}         = $TEMP_URL;
  413   $envir{htmlURL}         = $HTML_URL;
  414   $envir{'htmlDirectory'}             =   $courseEnvironment ->{courseDirectory}->{html};
  415   # here is a way to pass environment variables defined in webworkCourse.ph
  416 # my $k;
  417 # foreach $k (keys %Global::PG_environment ) {
  418 #   $envir{$k} = $Global::PG_environment{$k};
  419 # }
  420   \%envir;
  421 }
  422 
  423 ########################################################################################
  424 # This recursive pretty_print function will print a hash and its sub hashes.
  425 ########################################################################################
  426 sub pretty_print_rh {
  427     my $r_input = shift;
  428     my $out = '';
  429     if ( not ref($r_input) ) {
  430       $out = $r_input;    # not a reference
  431     } elsif (is_hash_ref($r_input)) {
  432       local($^W) = 0;
  433     $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
  434     foreach my $key (sort keys %$r_input ) {
  435       $out .= "<tr><TD> $key</TD><TD>=&gt;</td><td>&nbsp;".pretty_print_rh($r_input->{$key}) . "</td></tr>";
  436     }
  437     $out .="</table>";
  438   } elsif (is_array_ref($r_input) ) {
  439     my @array = @$r_input;
  440     $out .= "( " ;
  441     while (@array) {
  442       $out .= pretty_print_rh(shift @array) . " , ";
  443     }
  444     $out .= " )";
  445   } elsif (ref($r_input) eq 'CODE') {
  446     $out = "$r_input";
  447   } else {
  448     $out = $r_input;
  449   }
  450     $out;
  451 }
  452 
  453 sub is_hash_ref {
  454   my $in =shift;
  455   my $save_SIG_die_trap = $SIG{__DIE__};
  456     $SIG{__DIE__} = sub {CORE::die(@_) };
  457   my $out = eval{  %{   $in  }  };
  458   $out = ($@ eq '') ? 1 : 0;
  459   $@='';
  460   $SIG{__DIE__} = $save_SIG_die_trap;
  461   $out;
  462 }
  463 sub is_array_ref {
  464   my $in =shift;
  465   my $save_SIG_die_trap = $SIG{__DIE__};
  466     $SIG{__DIE__} = sub {CORE::die(@_) };
  467   my $out = eval{  @{   $in  }  };
  468   $out = ($@ eq '') ? 1 : 0;
  469   $@='';
  470   $SIG{__DIE__} = $save_SIG_die_trap;
  471   $out;
  472 }
  473 
  474 ######
  475 # Utility for slurping souce files
  476 #######
  477 
  478 sub readFile {
  479   my $input = shift;    # The set and problem:  'set0/prob1.pg'
  480   my $filePath =$TEMPLATE_DIRECTORY .$input;
  481   print STDERR "Reading problem from file  $filePath \n";
  482   print STDERR "<br>Reading problem from file  $filePath <br>\n";
  483   my $out;
  484   print "The file is readable = ", -r $filePath, "\n";
  485   if (-r $filePath) {
  486     open IN, "<$filePath" or print STDERR "Hey, this file was supposed to be readable\n";
  487     local($/)=undef;
  488     $out = <IN>;
  489     close(IN);
  490   } else {
  491     print "Could not read file at |$filePath|";
  492     print STDERR "Could not read file at |$filePath|";
  493   }
  494   return($out);
  495 }
  496 
  497 my $foo =0;
  498 
  499 # The warning mechanism.  This needs to be turned into an object of its own
  500 ###############
  501 ## Error message routines cribbed from CGI
  502 ###############
  503 
  504 BEGIN {    #error message routines cribbed from CGI
  505 
  506   my $CarpLevel = 0;  # How many extra package levels to skip on carp.
  507   my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
  508 
  509   sub longmess {
  510     my $error = shift;
  511     my $mess = "";
  512     my $i = 1 + $CarpLevel;
  513     my ($pack,$file,$line,$sub,$eval,$require);
  514 
  515     while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
  516       if ($error =~ m/\n$/) {
  517         $mess .= $error;
  518       }
  519       else {
  520         if (defined $eval) {
  521           if ($require) {
  522             $sub = "require $eval";
  523           }
  524           else {
  525             $eval =~ s/[\\\']/\\$&/g;
  526             if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
  527               substr($eval,$MaxEvalLen) = '...';
  528             }
  529             $sub = "eval '$eval'";
  530           }
  531         }
  532         elsif ($sub eq '(eval)') {
  533           $sub = 'eval {...}';
  534         }
  535 
  536         $mess .= "\t$sub " if $error eq "called";
  537         $mess .= "$error at $file line $line\n";
  538       }
  539 
  540       $error = "called";
  541     }
  542 
  543     $mess || $error;
  544   }
  545 }
  546 ###############
  547 ### Our error messages for giving maximum feedback to the user for errors within problems.
  548 ###############
  549 BEGIN {
  550   sub PG_floating_point_exception_handler {       # 1st argument is signal name
  551     my($sig) = @_;
  552     print "Content-type: text/html\n\n<H4>There was a floating point arithmetic error (exception SIG$sig )</H4>--perhaps
  553     you divided by zero or took the square root of a negative number?
  554     <BR>\n Use the back button to return to the previous page and recheck your entries.<BR>\n";
  555     exit(0);
  556   }
  557 
  558   $SIG{'FPE'}  = \&PG_floating_point_exception_handler;
  559 #!/usr/bin/perl  -w
  560   sub PG_warnings_handler {
  561     my @input = @_;
  562     my $msg_string = longmess(@_);
  563     my @msg_array = split("\n",$msg_string);
  564     my $out_string = '';
  565 
  566     # Extra stack information is provided in this next block
  567     # If the warning message does NOT end in \n then a line
  568     # number is appended (see Perl manual about warn function)
  569     # The presence of the line number is detected below and extra
  570     # stack information is added.
  571     # To suppress the line number and the extra stack information
  572     # add \n to the end of a warn message (in .pl files.  In .pg
  573     # files add ~~n instead
  574 
  575     if ($input[$#input]=~/line \d*\.\s*$/) {
  576       $out_string .= "##More details: <BR>\n----";
  577       foreach my $line (@msg_array) {
  578         chomp($line);
  579         next unless $line =~/\w+\:\:/;
  580         $out_string .= "----" .$line . "<BR>\n";
  581       }
  582     }
  583 
  584     $Global::WARNINGS .="*  " . join("<BR>",@input) . "<BR>\n" . $out_string .
  585                         "<BR>\n--------------------------------------<BR>\n<BR>\n";
  586     $Global::background_plain_url = $Global::background_warn_url;
  587     $Global::bg_color = '#FF99CC';  #for warnings -- this change may come too late
  588   }
  589 
  590   $SIG{__WARN__}=\&PG_warnings_handler;
  591 
  592   $SIG{__DIE__} = sub {
  593       my $message = longmess(@_);
  594       $message =~ s/\n/<BR>\n/;
  595       my ($package, $filename, $line) = caller();
  596       # use standard die for errors eminating from XML::Parser::Expat
  597       # it uses a trapped eval which sometimes fails -- apparently on purpose
  598       # and the error is handled by Expat itself.  We don't want
  599       # to interfer with that.
  600 
  601       if ($package eq 'XML::Parser::Expat') {
  602         die @_;
  603       }
  604       #print  "$package $filename $line \n";
  605     print
  606     "Content-type: text/html\r\n\r\n <h4>Software error</h4> <p>\n\n$message\n<p>\n
  607     Please inform the webwork meister.<p>\n
  608     In addition to the error message above the following warnings were detected:
  609     <HR>
  610     $Global::WARNINGS;
  611     <HR>
  612     It's sometimes hard to tell exactly what has gone wrong since the
  613     full error message may have been sent to
  614     standard error instead of to standard out.
  615     <p> To debug  you can
  616     <ul>
  617     <li> guess what went wrong and try to fix it.
  618     <li> call the offending script directly from the command line
  619     of unix
  620     <li> enable the debugging features by redefining
  621     \$cgiURL in Global.pm and checking the redirection scripts in
  622     system/cgi. This will force the standard error to be placed
  623     in the standard out pipe as well.
  624     <li> Run tail -f error_log <br>
  625     from the unix command line to see error messages from the webserver.
  626     The standard error output is being placed in the error_log file for the apache
  627     web server.  To run this command you have to be in the directory containing the
  628     error_log or enter the full path name of the error_log. <p>
  629     In a standard apache installation, this file is at /usr/local/apache/logs/error_log<p>
  630     In a RedHat Linux installation, this file is at /var/log/httpd/error_log<p>
  631     At Rochester this file is at /ww/logs/error_log.
  632     </ul>
  633     Good luck.<p>\n" ;
  634   };
  635 
  636 
  637 
  638 }
  639 
  640 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9