[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 3370 - (download) (as text) (annotate)
Tue Jul 12 22:29:53 2005 UTC (14 years, 6 months ago) by dpvc
File size: 4288 byte(s)
A first pass at making parser error messages localizable.  The
Context()->{error}{msg} hash can be used to specify translations of
the standard messages.  For example,

    Context()->{error}{msg}{'Division by zero'} = "Don't divide by zero, dude!";
    Context()->{error}{msg}{'Function '%s' has too many inputs'} =
        "You passed too many arguments to '%s'";

(I didn't translate into another language, here, but you could do
that, too.)

The msg hash could also be used within answer checkers to make certain
answer messages more appropriate for the given type of expected answer.

    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 (default never matches)
   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   $pattern = '^$' if $pattern eq '';
   68   return $pattern;
   69 }
   70 
   71 sub protectRegexp {
   72   my $string = shift;
   73   $string =~ s/[\[\](){}|+.*?\\]/\\$&/g;
   74   return $string;
   75 }
   76 
   77 sub protectChars {
   78   my $string = shift;
   79   $string =~ s/\]/\\\]/g;
   80   $string =~ s/^(.*)-(.*)$/-$1$2/g;
   81   return $string;
   82 }
   83 
   84 
   85 #
   86 #  Add one or more new items to the list
   87 #
   88 sub add {
   89   my $self = shift; my %D = (@_); return if scalar(@_) == 0;
   90   my $data = $self->{context}{$self->{dataName}};
   91   foreach my $x (keys %D) {
   92     Value::Error("Illegal %s name '%s'",$self->{name},$x) unless $x =~ m/^$self->{namePattern}$/;
   93     warn "$self->{Name} '$x' already exists" if defined($data->{$x});
   94     $data->{$x} = $self->create($D{$x});
   95   }
   96   $self->update;
   97 }
   98 
   99 #
  100 #  Remove one or more items
  101 #
  102 sub remove {
  103   my $self = shift;
  104   my $data = $self->{context}{$self->{dataName}};
  105   foreach my $x (@_) {
  106     warn "$self->{Name} '$x' doesn't exist" unless defined($data->{$x});
  107     delete $data->{$x};
  108   }
  109   $self->update;
  110 }
  111 
  112 #
  113 #  Replace an item with a new definition
  114 #
  115 sub replace {
  116   my $self = shift; my %list = (@_);
  117   $self->remove(keys %list);
  118   $self->add(@_);
  119 }
  120 
  121 #
  122 #  Clear all items
  123 #
  124 sub clear {
  125   my $self = shift;
  126   $self->{context}{$self->{dataName}} = {};
  127   $self->update;
  128 }
  129 
  130 #
  131 #  Make the data be only these items
  132 #
  133 sub are {
  134   my $self = shift;
  135   $self->clear;
  136   $self->add(@_);
  137 }
  138 
  139 #
  140 #  Make one or more items become undefined, but still recognized.
  141 #  (Implemented in the sub-classes.)
  142 #
  143 sub undefine {my $self = shift; $self->remove(@_)}
  144 
  145 
  146 #
  147 #  Get hash for an item
  148 #
  149 sub get {
  150   my $self = shift; my $x = shift;
  151   return $self->{context}{$self->{dataName}}{$x};
  152 }
  153 
  154 #
  155 #  Set flags for one or more items
  156 #
  157 sub set {
  158   my $self = shift; my %D = (@_);
  159   my $data = $self->{context}{$self->{dataName}};
  160   foreach my $x (keys(%D)) {
  161     my $xref = $data->{$x};
  162     if (defined($xref) && ref($xref) eq 'HASH') {
  163       foreach my $id (keys %{$D{$x}}) {$xref->{$id} = $D{$x}{$id}}
  164     } else {
  165       $data->{$x} = $self->create($D{$x});
  166     }
  167   };
  168 }
  169 
  170 #
  171 #  Get the names of all items
  172 #
  173 sub names {
  174   my $self = shift;
  175   return sort(keys %{$self->{context}{$self->{dataName}}});
  176 }
  177 
  178 #
  179 #  Get the complete data hash
  180 #
  181 sub all {
  182   my $self = shift;
  183   $self->{context}{$self->{dataName}};
  184 }
  185 
  186 #########################################################################
  187 #
  188 #  Load the subclasses.
  189 #
  190 
  191 use Value::Context::Flags;
  192 use Value::Context::Lists;
  193 
  194 #########################################################################
  195 
  196 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9