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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2579 - (download) (as text) (annotate)
Mon Aug 9 21:38:01 2004 UTC (15 years, 5 months ago) by dpvc
File size: 4142 byte(s)
Significant update to new parser.

New features include:

  Better control over format of vector output (you can now
    specify ijk-format rather than <...> format)

  "Fuzzy" reals, where the relations like == return true when the
    two values are "close enough".  (This is controlable using
    parameters similar to those used in NUM_CMP).

  The fuzzy reals are now used in vectors/points/matrices/complexes/intervals
    and so on so that their relations will also be fuzzy.  E.g.,
    (1E-13,2) == (0,3) will be true, and norm(Vector(0,1E-13)) will
    equal 0.

  The two main portions of the parser (the Parser and Value packages)
    now share a common context object for configuration purposes.

    1 #########################################################################
    2 #
    3 #  Implements base class for data list in Context objects.
    4 #
    5 package Value::Context::Data;
    6 use strict;
    7 
    8 sub new {
    9   my $self = shift; my $class = ref($self) || $self;
   10   my $parent = shift;
   11   my $data = bless {
   12     context => $parent,     # parent context
   13     dataName => {},         # name of data storage in context hash
   14     pattern => '',          # pattern for names of data items
   15     namePattern => '',      # pattern for allowed names for new items
   16     name => '', Name => '', # lower- and upper-case names for the class of items
   17   }, $class;
   18   $data->init();
   19   $parent->{$data->{dataName}} = {};
   20   $data->add(@_);
   21   return $data;
   22 }
   23 
   24 #
   25 #  Implemented in sub-classes
   26 #
   27 sub init {}
   28 sub create {shift; shift}
   29 
   30 #
   31 #  Sort names so that they can be joined for regexp matching
   32 #
   33 sub byName {
   34   my $result = length($b) <=> length($a);
   35   return $result unless $result == 0;
   36   return $a cmp $b;
   37 }
   38 
   39 #
   40 #  Update the pattern for the names
   41 #
   42 sub update {
   43   my $self = shift;
   44   my $data = $self->{context}->{$self->{dataName}};
   45   my $single = ''; my @multi = ();
   46   foreach my $x (sort byName (keys %{$data})) {
   47     unless ($data->{$x}{hidden}) {
   48       if (length($x) == 1) {$single .= $x} else {push(@multi,$x)}
   49     }
   50   }
   51   $self->{pattern} = $self->getPattern($single,@multi);
   52   $self->{context}->update;
   53 }
   54 
   55 #
   56 #  Build a regexp pattern from the characters and list of names
   57 #  (protect special characters)
   58 #
   59 sub getPattern {
   60   shift; my $s = shift;
   61   foreach my $x (@_) {$x = protectRegexp($x)}
   62   my @pattern = ();
   63   push(@pattern,join('|',@_)) if scalar(@_) > 0;
   64   push(@pattern,protectRegexp($s)) if length($s) ==1;
   65   push(@pattern,"[".protectChars($s)."]") if length($s) > 1;
   66   my $pattern = join('|',@pattern);
   67   return $pattern;
   68 }
   69 
   70 sub protectRegexp {
   71   my $string = shift;
   72   $string =~ s/[\[\](){}|+.*?\\]/\\$&/g;
   73   return $string;
   74 }
   75 
   76 sub protectChars {
   77   my $string = shift;
   78   $string =~ s/\]/\\\]/g;
   79   return $string;
   80 }
   81 
   82 
   83 #
   84 #  Add one or more new items to the list
   85 #
   86 sub add {
   87   my $self = shift; my %D = (@_); return if scalar(@_) == 0;
   88   my $data = $self->{context}{$self->{dataName}};
   89   foreach my $x (keys %D) {
   90     Value::Error("Illegal $self->{name} name '$x'") unless $x =~ m/^$self->{namePattern}$/;
   91     warn "$self->{Name} '$x' already exists" if defined($data->{$x});
   92     $data->{$x} = $self->create($D{$x});
   93   }
   94   $self->update;
   95 }
   96 
   97 #
   98 #  Remove one or more items
   99 #
  100 sub remove {
  101   my $self = shift;
  102   my $data = $self->{context}{$self->{dataName}};
  103   foreach my $x (@_) {
  104     warn "$self->{Name} '$x' doesn't exist" unless defined($data->{$x});
  105     delete $data->{$x};
  106   }
  107   $self->update;
  108 }
  109 
  110 #
  111 #  Replace an item with a new definition
  112 #
  113 sub replace {
  114   my $self = shift; my %list = (@_);
  115   $self->remove(keys %list);
  116   $self->add(@_);
  117 }
  118 
  119 #
  120 #  Clear all items
  121 #
  122 sub clear {
  123   my $self = shift;
  124   $self->{context}{$self->{dataName}} = {};
  125   $self->update;
  126 }
  127 
  128 #
  129 #  Make the data be only these items
  130 #
  131 sub are {
  132   my $self = shift;
  133   $self->clear;
  134   $self->add(@_);
  135 }
  136 
  137 #
  138 #  Make one or more items become undefined, but still recognized.
  139 #  (Implemented in the sub-classes.)
  140 #
  141 sub undefine {my $self = shift; $self->remove(@_)}
  142 
  143 
  144 #
  145 #  Get hash for an item
  146 #
  147 sub get {
  148   my $self = shift; my $x = shift;
  149   return $self->{context}{$self->{dataName}}{$x};
  150 }
  151 
  152 #
  153 #  Set flags for one or more items
  154 #
  155 sub set {
  156   my $self = shift; my %D = (@_);
  157   my $data = $self->{context}{$self->{dataName}};
  158   foreach my $x (keys(%D)) {
  159     $data->{$x} = (defined($data->{$x}) && ref($data->{$x}) eq 'HASH') ?
  160                     {%{$data->{$x}},%{$D{$x}}} :
  161                     $self->create($D{$x});
  162   };
  163 }
  164 
  165 #
  166 #  Get the names of all items
  167 #
  168 sub names {
  169   my $self = shift;
  170   return sort(keys %{$self->{context}{$self->{dataName}}});
  171 }
  172 
  173 #
  174 #  Get the complete data hash
  175 #
  176 sub all {
  177   my $self = shift;
  178   $self->{context}{$self->{dataName}};
  179 }
  180 
  181 #########################################################################
  182 #
  183 #  Load the subclasses.
  184 #
  185 
  186 use Value::Context::Flags;
  187 use Value::Context::Lists;
  188 
  189 #########################################################################
  190 
  191 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9