[Templates-cvs] cvs commit: TT3/lib/Template Base.pm

[cvs@template-toolkit.org]

cvs         04/12/03 10:05:26

  Modified:    lib/Template Base.pm
  Log:
  * added pkgvars() and error_msg() methods
  
  Revision  Changes    Path
  1.11      +73 -11    TT3/lib/Template/Base.pm
  
  Index: Base.pm
  ===================================================================
  RCS file: /template-toolkit/TT3/lib/Template/Base.pm,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- Base.pm	2004/11/26 12:42:23	1.10
  +++ Base.pm	2004/12/03 10:05:26	1.11
  @@ -16,7 +16,7 @@
   #   modify it under the same terms as Perl itself.
   #
   # REVISION
  -#   $Id: Base.pm,v 1.10 2004/11/26 12:42:23 abw Exp $
  +#   $Id: Base.pm,v 1.11 2004/12/03 10:05:26 abw Exp $
   #
   #========================================================================
   
  @@ -29,7 +29,7 @@
   require Template::Utils;
   require Template::Exception;
   
  -our $VERSION   = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
  +our $VERSION   = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
   our $DEBUG     = 0 unless defined $DEBUG;
   our $ERROR     = '';
   our $PAD       = '  ';
  @@ -109,31 +109,67 @@
   
   
   #------------------------------------------------------------------------
  -# pkgvar($name, $default)
  +# pkgvar($name, $default, $all)
   #
   # Looks for the scalar package variable named by the first argument
   # (no leading '$') in the current package, accounting for subclassing,
  -# returning the $default value if not defined.
  +# returning the $default value if not found.  The third argument is 
  +# a flag which can be set true to return a list of all variables found 
  +# (and also the default, if defined, returned as the last item).  
  +# Otherwise the first instance found is returned.
   #------------------------------------------------------------------------
   
   sub pkgvar {
  -    my ($self, $var, $default) = @_;
  +    my ($self, $name, $default, $all) = @_;
       my $class = ref $self || $self;
       my @pending = ($class);
  -    my ($pkg, $value, %seen);
  +    my ($pkg, $value, %seen, @got);
   
       no strict 'refs';
   
       while ($pkg = shift @pending) {
           # iterate through each package in @pending looking for a
  -        # package variable named $var, skipping any packages we've
  +        # package variable named $name, skipping any packages we've
           # already seen and adding all base class packages (@ISA) to
  -        # @pending
  +        # @pending.  if all have been asked for, we push any found 
  +        # onto a list, otherwise we return the first we find.
           next if $seen{ $pkg }++;
  -        last if defined ($value = ${"$pkg\::$var"});
  +        if (defined ($value = ${"$pkg\::$name"})) {
  +            if ($all) {
  +                push(@got, $value);
  +            }
  +            else {
  +                return $value;
  +            }
  +        }
           push(@pending, @{"$pkg\::ISA"});
  +    }
  +
  +    # if we got here then we either wanted all variables or we 
  +    # wanted one, but didn't find any
  +
  +    if ($all) {
  +        # add any default to the (possibly empty) list and return it
  +        push(@got, $default) if $default;
  +        return @got;
  +    }
  +    else {
  +        # otherwise return the default, if there is one
  +        return $default;
       }
  -    return defined $value ? $value : $default;
  +}
  +
  +
  +#------------------------------------------------------------------------
  +# pkgvars($name, $default)
  +#
  +# Wrapper around pkgvar() with sets the third option true to return all
  +# variables found.
  +#------------------------------------------------------------------------
  +
  +sub pkgvars {
  +    my ($self, $name, $default) = @_;
  +    return $self->pkgvar($name, $default, 1);
   }
   
   
  @@ -247,6 +283,32 @@
   
   
   #------------------------------------------------------------------------
  +# error_msg($code, @args)
  +#
  +# Searches up through the inheritance tree looking for an hash defined in
  +# an $ERRORS package variable that contains an error message indexed by 
  +# the key $code.  It then passes it through sprintf(), applying any @args
  +# to it, and then onto error().
  +#------------------------------------------------------------------------
  +
  +sub error_msg {
  +    my ($self, $code, @args) = @_;
  +
  +    foreach my $errors ($self->pkgvars('ERRORS')) {
  +        if (my $format = $errors->{ $code }) {
  +            return $self->error(sprintf($format, @args));
  +        }
  +    }
  +
  +    # print warning about invalid error code
  +    my ($pkg, $file, $line) = caller(0);
  +    warn "error_msg() called with invalid error code '$code' at $file line $line\n";
  +
  +    return $self->error($code, @args);
  +}
  +
  +
  +#------------------------------------------------------------------------
   # throw($error)
   # throw($type, $error)
   # throw($type, $error, @args)
  @@ -1106,7 +1168,7 @@
   
   =head1 VERSION
   
  -$Revision: 1.10 $
  +$Revision: 1.11 $
   
   =head1 COPYRIGHT