View of /trunk/pg/lib/Value/WeBWorK.pm

    1 #############################################################
    2 #
    3 #  Definitions specific to WeBWorK.
    4 #
    5 
    6 ##################################################
    7 #
    8 #  Convert a student answer to a formula, with error trapping.
    9 #  If the result is undef, there was an error (message is in Context()->{error} object)
   10 #
   11 
   12 package Parser;
   13 
   14 sub Formula {
   15   my $v = eval {Value->Package("Formula")->new(@_)};
   16   reportEvalError($@) unless defined($v) || Value->context->{error}{flag};
   17   return $v;
   18 }
   19 
   20 #
   21 #  Evaluate a formula, with error trapping.
   22 #  If the result is undef, there was an error (message is in Context()->{error} object)
   23 #  If the result was a real, make it a fuzzy one.
   24 #
   25 sub Evaluate {
   26   my $f = shift;
   27   return unless defined($f);
   28   my $v = eval {$f->eval(@_)};
   29   if (defined($v)) {$v = Value::makeValue($v)}
   30     else {reportEvalError($@) unless $f->{context}{error}{flag}}
   31   return $v;
   32 }
   33 
   34 #
   35 #  Call a subtroutine with error trapping.
   36 #  (We need to be able to do this from custom
   37 #   answer checkers and other MathObject code.
   38 #   PG_restricted_eval is not sufficient for this
   39 #   since that uses a string and so can't access
   40 #   local variables from the calling routine.)
   41 #
   42 sub Eval {
   43   my $f = shift;
   44   return unless defined($f);
   45   eval {&$f(@_)};
   46 }
   47 
   48 #
   49 #  Remove backtrace and line number, since these
   50 #  will be reported in the student message area.
   51 #
   52 sub reportEvalError {
   53   my $error = shift; my $fullerror = $error;
   54   $error =~ s/ at \S+\.\S+ line \d+(\n|.)*//;
   55   $error =~ s/ at line \d+ of (\n|.)*//;
   56   Value->context->setError($error);
   57   if (Value->context->{debug}) {
   58     $fullerror =~ s/\n/<BR>/g;
   59     warn $fullerror;
   60   }
   61 }
   62 
   63 package main;
   64 
   65 #####################################################
   66 #
   67 # Use PG random number generator rather than perl
   68 #
   69 sub Value::Formula::PGseedRandom {
   70   my $self = shift;
   71   return if $self->{PGrandom};
   72   $self->{PGrandom} = new PGrandom($self->{context}->flag('random_seed'));
   73 }
   74 sub Value::Formula::PGgetRandom {shift->{PGrandom}->random(@_)}
   75 
   76 #####################################################
   77 #
   78 #  Initialize contexts with WW default data
   79 #
   80 
   81 my @wwEvalFields = qw(
   82   functAbsTolDefault
   83   functNumOfPoints
   84   functRelPercentTolDefault
   85   functZeroLevelDefault
   86   functZeroLevelTolDefault
   87   functMaxConstantOfIntegration
   88   numAbsTolDefault
   89   numFormatDefault
   90   numRelPercentTolDefault
   91   numZeroLevelDefault
   92   numZeroLevelTolDefault
   93   useBaseTenLog
   94 );
   95 
   96 sub Parser::Context::copy {
   97   my $self = shift;
   98   my $context = Value::Context::copy($self,@_);
   99   return $context unless $Parser::installed;  # only do WW initialization after parser is fully loaded
  100   return $context if $context->{WW} && scalar(keys %{$context->{WW}}) > 0;
  101   my $envir = eval('\\%main::envir');
  102   return $context unless $envir && scalar(keys(%{$envir})) > 0;
  103   my $ww = $context->{WW} = {}; push @{$context->{data}{values}}, 'WW';
  104   return $context if $Value::_no_WeBWorK_; # hack for command-line debugging
  105   foreach my $x (@wwEvalFields) {$context->{WW}{$x} = $envir->{$x}}
  106   $context->flags->set(
  107      tolerance      => $ww->{numRelPercentTolDefault} / 100,
  108      zeroLevel      => $ww->{numZeroLevelDefault},
  109      zeroLevelTol   => $ww->{numZeroLevelTolDefault},
  110      num_points     => $ww->{functNumOfPoints} + 2,
  111      max_adapt      => $ww->{functMaxConstantOfIntegration},
  112      useBaseTenLog  => $ww->{useBaseTenLog},
  113   );
  114   $context->{format}{number} = $ww->{numFormatDefault} if $ww->{numFormatDefault} ne '';
  115   $context;
  116 }
  117 
  118 #############################################################
  119 
  120 use Value::AnswerChecker;
  121 
  122 #############################################################
  123 
  124 1;