[system] / trunk / pg / lib / Parser / Variable.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/Parser/Variable.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5509 - (download) (as text) (annotate)
Sat Sep 15 00:56:51 2007 UTC (12 years, 2 months ago) by dpvc
File size: 3558 byte(s)
Formula objects and Context objects contain reference loops, which
prevent them from being freed properly by perl when they are no longer
needed.  This is a source of an important memory leak in WeBWorK.  The
problem has been fixed by using Scalar::Util::weaken for these
recursive references, so these objects can be freed properly when they
go out of scope.  This should cause an improvement in the memory usage
of the httpd child processes.

    1 #########################################################################
    2 #
    3 #  Implements named variables
    4 #
    5 package Parser::Variable;
    6 use strict;
    7 our @ISA = qw(Parser::Item);
    8 
    9 $Parser::class->{Variable} = 'Parser::Variable';
   10 
   11 #
   12 #  Error if the variable is not declared in the current context.
   13 #  Record the variable in the equation's list of variables.
   14 #
   15 sub new {
   16   my $self = shift; my $class = ref($self) || $self;
   17   my $equation = shift; my $variables = $equation->{context}{variables};
   18   my ($name,$ref) = @_;
   19   unless ($variables->{$name}) {
   20     my $string = substr($equation->{string},$ref->[2]);
   21     if ($string =~ m/^([a-z][a-z]+)/i) {
   22       $ref->[3] = $ref->[2]+length($1);
   23       $equation->Error(["'%s' is not defined in this context",$1],$ref);
   24     }
   25     $equation->Error(["Variable '%s' is not defined in this context",$name],$ref);
   26   }
   27   $equation->Error(["Variable '%s' is not defined in this context",$name],$ref)
   28     if $variables-> {$name}{parameter} && $equation->{context}{flags}{no_parameters};
   29   $equation->{variables}{$name} = 1;
   30   my $def = $variables->{$name};
   31   my $v = bless {
   32     name => $name, def => $def, type => $def->{type},
   33     ref => $ref, equation => $equation
   34   }, $class;
   35   $v->weaken;
   36   return $v;
   37 }
   38 
   39 #
   40 #  Replace the variable with its value, if one was given
   41 #
   42 sub reduce {
   43   my $self = shift; my $equation = $self->{equation};
   44   my $value = $equation->{values}{$self->{name}};
   45   $self = $self->Item("Value")->new($equation,[$value]) if defined($value);
   46   return $self;
   47 }
   48 
   49 #
   50 #  Substitute a variable's value, if there is one
   51 #
   52 sub substitute {
   53   my $self = shift; my $equation = $self->{equation};
   54   my $value = $equation->{values}{$self->{name}};
   55   $self = $self->Item("Value")->new($equation,[$value]) if defined($value);
   56   return $self;
   57 }
   58 
   59 #
   60 #  Replace the variable with its value, if one was given
   61 #
   62 sub eval {
   63   my $self = shift;
   64   my $value = $self->{equation}{values}{$self->{name}};
   65   return $value if defined($value);
   66   $self->Error("No value given for variable '%s'",$self->{name});
   67 }
   68 
   69 #
   70 #  Add the variable name to the equation's list of variables
   71 #    unless the variable has been assigned a value
   72 #
   73 sub getVariables {
   74   my $self = shift; my $variables = $self->{equation}{variables};
   75   return {} if defined($self->{equation}{values}{$self->{name}});
   76   return {$self->{name} => 1};
   77 }
   78 
   79 #
   80 #  Copy the variable, and add the name to the new equation's list
   81 #
   82 sub copy {
   83   my $self = shift;
   84   $self = $self->SUPER::copy(@_);
   85   my $variables = $self->{equation}{variables};
   86   $variables->{$self->{name}} = 1
   87     unless defined($self->{equation}{values}{$self->{name}});
   88   return $self;
   89 }
   90 
   91 #
   92 #  Return the variable's name or value
   93 #
   94 sub string {
   95   my $self = shift;
   96   my $value = $self->{equation}{values}{$self->{name}};
   97   return $value if defined($value);
   98   return $self->{name};
   99 }
  100 #
  101 #  Make a subscripted variable name if it ends in numbers
  102 #
  103 sub TeX {
  104   my $self = shift; my $name = $self->{name};
  105   my $value = $self->{equation}{values}{$name};
  106   return $value if defined($value);
  107   return $self->{def}{TeX} if defined $self->{def}{TeX};
  108   $name = $1.'_{'.$2.'}' if ($name =~ m/^([^_]+)_?(\d+)$/);
  109   $name = '\boldsymbol '.$name if $self->{type}{name} eq 'Vector';
  110   return $name;
  111 }
  112 #
  113 #  Make a variable reference
  114 #
  115 sub perl {
  116   my $self = shift;
  117   my $value = $self->{equation}{values}{$self->{name}};
  118   return $value if defined($value);
  119   return $self->{def}{perl} if defined $self->{def}{perl};
  120   return '$'.$self->{name};
  121 }
  122 
  123 #########################################################################
  124 
  125 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9