X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FCGI%2FEx%2FTemplate.pm;h=9adea160d20d0d366215540b157cd38638346115;hb=d0287461de3f9b5c49ce02b22957022bdc5e87d8;hp=52d92a07054174edc0763cd70ce2c0ab247df88b;hpb=48c4840be1f154e262de2c161cb86dc5000dfe47;p=chaz%2Fp5-CGI-Ex

diff --git a/lib/CGI/Ex/Template.pm b/lib/CGI/Ex/Template.pm
index 52d92a0..9adea16 100644
--- a/lib/CGI/Ex/Template.pm
+++ b/lib/CGI/Ex/Template.pm
@@ -2,7 +2,7 @@ package CGI::Ex::Template;
 
 ###----------------------------------------------------------------###
 #  See the perldoc in CGI/Ex/Template.pod
-#  Copyright 2006 - Paul Seamons                                     #
+#  Copyright 2007 - Paul Seamons                                     #
 #  Distributed under the Perl Artistic License without warranty      #
 ###----------------------------------------------------------------###
 
@@ -39,7 +39,7 @@ use vars qw($VERSION
             );
 
 BEGIN {
-    $VERSION = '2.05';
+    $VERSION = '2.07';
 
     $PACKAGE_EXCEPTION   = 'CGI::Ex::Template::Exception';
     $PACKAGE_ITERATOR    = 'CGI::Ex::Template::Iterator';
@@ -276,10 +276,12 @@ BEGIN {
     $QR_NUM       = '(?:\d*\.\d+ | \d+) (?: [eE][+-]\d+ )?';
     $QR_AQ_NOTDOT = "(?! \\s* $QR_COMMENTS \\.)";
     $QR_AQ_SPACE  = '(?: \\s+ | \$ | (?=[;+]) )'; # the + comes into play on filenames
-    $QR_PRIVATE   = qr/^_/;
+    $QR_PRIVATE   = qr/^[_.]/;
 
     $WHILE_MAX    = 1000;
     $EXTRA_COMPILE_EXT = '.sto';
+
+    eval {require Scalar::Util};
 };
 
 ###----------------------------------------------------------------###
@@ -1676,6 +1678,7 @@ sub parse_DUMP {
 sub play_DUMP {
     my ($self, $ident, $node) = @_;
     require Data::Dumper;
+    local $Data::Dumper::Sortkeys  = 1;
     my $info = $self->node_info($node);
     my $out;
     my $var;
@@ -1936,7 +1939,8 @@ sub play_MACRO {
         $sub_tree = $sub_tree->[0]->[4];
     }
 
-    my $self_copy = $self->weak_copy;
+    my $self_copy = $self;
+    eval {require Scalar::Util; Scalar::Util::weaken($self_copy)};
 
     ### install a closure in the stash that will handle the macro
     $self->set_variable($name, sub {
@@ -2376,38 +2380,41 @@ sub play_USE {
     pop @var; # remove the trailing '.'
 
     ### look for a plugin_base
-    my $base = $self->{'PLUGIN_BASE'} || 'Template::Plugin'; # I'm not maintaining plugins - leave that to TT
-    my $package = $self->{'PLUGINS'}->{$module} ? $self->{'PLUGINS'}->{$module}
-       : $self->{'PLUGIN_FACTORY'}->{$module} ? $self->{'PLUGIN_FACTORY'}->{$module}
-       : "${base}::${module}";
-    my $require = "$package.pm";
-    $require =~ s|::|/|g;
-
-    ### try and load the module - fall back to bare module if allowed
+    my $BASE = $self->{'PLUGIN_BASE'} || 'Template::Plugin'; # I'm not maintaining plugins - leave that to TT
     my $obj;
-    if ($self->{'PLUGIN_FACTORY'}->{$module} || eval {require $require}) {
-        my $shape   = $package->load;
-        my $context = $self->context;
-        my @args    = $args ? map { $self->play_expr($_) } @$args : ();
-        $obj = $shape->new($context, @args);
-    } elsif (lc($module) eq 'iterator') { # use our iterator if none found (TT's works just fine)
-        $obj = $PACKAGE_ITERATOR->new($args ? $self->play_expr($args->[0]) : []);
-    } elsif (my @packages = grep {lc($package) eq lc($_)} @{ $self->list_plugins({base => $base}) }) {
-        foreach my $package (@packages) {
-            my $require = "$package.pm";
-            $require =~ s|::|/|g;
-            eval {require $require} || next;
+
+    foreach my $base (ref($BASE) eq 'ARRAY' ? @$BASE : $BASE) {
+        my $package = $self->{'PLUGINS'}->{$module} ? $self->{'PLUGINS'}->{$module}
+        : $self->{'PLUGIN_FACTORY'}->{$module} ? $self->{'PLUGIN_FACTORY'}->{$module}
+        : "${base}::${module}";
+        my $require = "$package.pm";
+        $require =~ s|::|/|g;
+
+        ### try and load the module - fall back to bare module if allowed
+        if ($self->{'PLUGIN_FACTORY'}->{$module} || eval {require $require}) {
             my $shape   = $package->load;
             my $context = $self->context;
             my @args    = $args ? map { $self->play_expr($_) } @$args : ();
             $obj = $shape->new($context, @args);
-        }
-    } elsif ($self->{'LOAD_PERL'}) {
-        my $require = "$module.pm";
-        $require =~ s|::|/|g;
-        if (eval {require $require}) {
-            my @args = $args ? map { $self->play_expr($_) } @$args : ();
-            $obj = $module->new(@args);
+        } elsif (lc($module) eq 'iterator') { # use our iterator if none found (TT's works just fine)
+            $obj = $PACKAGE_ITERATOR->new($args ? $self->play_expr($args->[0]) : []);
+        } elsif (my @packages = grep {lc($package) eq lc($_)} @{ $self->list_plugins({base => $base}) }) {
+            foreach my $package (@packages) {
+                my $require = "$package.pm";
+                $require =~ s|::|/|g;
+                eval {require $require} || next;
+                my $shape   = $package->load;
+                my $context = $self->context;
+                my @args    = $args ? map { $self->play_expr($_) } @$args : ();
+                $obj = $shape->new($context, @args);
+            }
+        } elsif ($self->{'LOAD_PERL'}) {
+            my $require = "$module.pm";
+            $require =~ s|::|/|g;
+            if (eval {require $require}) {
+                my @args = $args ? map { $self->play_expr($_) } @$args : ();
+                $obj = $module->new(@args);
+            }
         }
     }
     if (! defined $obj) {
@@ -2778,20 +2785,6 @@ sub list_plugins {
     };
 }
 
-### get a copy of self without circular refs for use in closures
-sub weak_copy {
-    my $self = shift;
-    my $self_copy;
-    if (eval { require Scalar::Util }
-        && defined &Scalar::Util::weaken) {
-        $self_copy = $self;
-        Scalar::Util::weaken($self_copy);
-    } else {
-        $self_copy = bless {%$self}, ref($self); # hackish way to avoid circular refs on old perls (pre 5.8)
-    }
-    return $self_copy;
-}
-
 sub debug_node {
     my ($self, $node) = @_;
     my $info = $self->node_info($node);
@@ -3025,6 +3018,13 @@ sub filter_redirect {
 ###----------------------------------------------------------------###
 
 sub dump_parse {
+    my $obj = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__->new;
+    my $str = shift;
+    require Data::Dumper;
+    return Data::Dumper::Dumper($obj->parse_tree(\$str));
+}
+
+sub dump_parse_expr {
     my $obj = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__->new;
     my $str = shift;
     require Data::Dumper;