[system] / trunk / pg / lib / Value / Context.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5026 - (download) (as text) (annotate)
Sat Jun 23 20:08:07 2007 UTC (12 years, 8 months ago) by dpvc
File size: 3979 byte(s)
Make the Package method really be a method of the context rather than
the Value objects, and make the Value method call the context one.
This means it is not necessary to pass the context as a parameter any
longer.

    1 #########################################################################
    2 #
    3 #  The basic context (Parser::Context is a subclass of this)
    4 #
    5 
    6 package Value::Context;
    7 my $pkg = "Value::Context";
    8 use strict;
    9 
   10 #
   11 #  Create a new Context object and initialize its data lists
   12 #
   13 sub new {
   14   my $self = shift; my $class = ref($self) || $self;
   15   my $context = bless {
   16     pattern => {
   17       number => '(?:\d+(?:\.\d*)?|\.\d+)(?:E[-+]?\d+)?',
   18       signedNumber => '[-+]?(?:\d+(?:\.\d*)?|\.\d+)(?:E[-+]?\d+)?',
   19     },
   20     format => {
   21       number => '%g',  # default format for Reals
   22     },
   23     error => {
   24       string => '',
   25       pos => undef,
   26       message => '',
   27       flag => 0,
   28       msg => {},  # for localization
   29     },
   30     data => {
   31       hashes => [],
   32       arrays => ['data'],
   33       values => ['flags','pattern','format','value'],
   34       objects => ['diagnostics','lists'],
   35     },
   36     value => {
   37       Formula => "Value::Formula"
   38     },
   39   }, $class;
   40   my %data = (lists=>{},flags=>{},diagnostics=>{},@_);
   41   $context->{_lists} = new Value::Context::Lists($context,%{$data{lists}});
   42   $context->{_flags} = new Value::Context::Flags($context,%{$data{flags}});
   43   $context->{_diagnostics} = new Value::Context::Diagnostics($context,%{$data{diagnostics}});
   44   $context->{_initialized} = 1;
   45   $context->update;
   46   return $context;
   47 }
   48 
   49 #
   50 #  Implemented in subclasses
   51 #
   52 sub update {}
   53 
   54 #
   55 #  Access to the data lists
   56 #
   57 sub lists         {(shift)->{_lists}}
   58 sub flags         {(shift)->{_flags}}
   59 sub flag          {(shift)->{_flags}->get(shift)}
   60 sub diagnostics   {(shift)->{_diagnostics}}
   61 
   62 #
   63 #  Make a copy of a Context object
   64 #
   65 sub copy {
   66   my $self = shift;
   67   my $context = $self->new();
   68   $context->{_initialized} = 0;
   69   foreach my $data (@{$context->{data}{objects}}) {
   70     $context->{$data} = $self->{"_$data"}->copy;
   71     $context->{"_$data"}->update;
   72   }
   73   foreach my $data (@{$context->{data}{hashes}}) {
   74     $context->{$data} = {};
   75     foreach my $x (keys %{$self->{$data}}) {
   76       $context->{$data}{$x} = {%{$self->{$data}{$x}}};
   77     }
   78   }
   79   foreach my $data (@{$context->{data}{arrays}}) {
   80     $context->{$data} = {};
   81     foreach my $x (keys %{$self->{$data}}) {
   82       $context->{$data}{$x} = [@{$self->{$data}{$x}}];
   83     }
   84   }
   85   foreach my $data (@{$context->{data}{values}}) {
   86     $context->{$data} = {%{$self->{$data}}};
   87   }
   88   $context->{_initialized} = 1;
   89   return $context;
   90 }
   91 
   92 #
   93 #  Returns the package name for the specificied Value object class
   94 #  (as specified by the context's {value} hash, or "Value::name").
   95 #
   96 sub Package {
   97   my $context = shift; my $class = shift;
   98   return $context->{value}{$class} if defined $context->{value}{$class};
   99   return "Value::$class" if defined @{"Value::${class}::ISA"};
  100   Value::Error("No such package 'Value::%s'",$class) unless $_[0];
  101 }
  102 
  103 #
  104 #  Make stringify produce TeX or regular strings
  105 #
  106 sub texStrings {shift->flags->set(StringifyAsTeX=>1)}
  107 sub normalStrings {shift->flags->set(StringifyAsTeX=>0)}
  108 
  109 #
  110 #  Clear error flags
  111 #
  112 sub clearError {
  113   my $error = (shift)->{error};
  114   $error->{string} = '';
  115   $error->{pos} = undef;
  116   $error->{message} = '';
  117   $error->{original} = '';
  118   $error->{flag} = 0;
  119 }
  120 
  121 #
  122 #  Set the error flags
  123 #
  124 sub setError {
  125   my $error = (shift)->{error};
  126   my ($message,$string,$pos,$more,$flag) = @_;
  127   my @args = ();
  128   ($message,@args) = @{$message} if ref($message) eq 'ARRAY';
  129   $error->{original} = $message;
  130   while ($message && $error->{msg}{$message}) {$message = $error->{msg}{$message}}
  131   while ($more && $error->{msg}{$more}) {$more = $error->{msg}{$more}}
  132   $message = sprintf($message,@args) if scalar(@args) > 0;
  133   $message .= sprintf($more,$pos->[0]+1) if $more;
  134   $error->{message} = $message;
  135   $error->{string} = $string;
  136   $error->{pos} = $pos;
  137   $error->{flag} = $flag || 1;
  138 }
  139 
  140 #########################################################################
  141 #
  142 #  Load the subclasses.
  143 #
  144 
  145 END {
  146   use Value::Context::Data;
  147 }
  148 
  149 #########################################################################
  150 
  151 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9