add automatic proxy system for passing objects to Template::Toolkit

lib/WebGUI/Template/Plugin/Asset.pm

@@ -1,6 +1,7 @@
 package WebGUI::Template::Plugin::Asset;
 
 use base 'Template::Plugin';
+use WebGUI::Template::Proxy::Asset;
 
 sub new {
     my $config = ref($_[-1]) eq 'HASH' ? pop(@_) : { };
@@ -9,42 +10,33 @@ sub new {
     my $stash = $context->stash;
     my $session = $stash->{_session};
 
-    my $self = bless {
-        _session => $session,
-        _context => $context,
-    }, $class;
-
     if ( ref $asset) {
     }
     elsif ( defined $asset ) {
-        $asset = $self->_getAsset($asset);
+        $asset = $class->_getAsset($session, $asset);
     }
     elsif ( $stash->{_asset} ) {
         $asset = $stash->{_asset};
     }
     elsif ( $stash->{assetId} ) {
-        $asset = $self->_getAsset($stash->{assetId});
+        $asset = $class->_getAsset($session, $stash->{assetId});
     }
     else {
         $asset = $session->asset;
     }
-    $self->{_asset} = $asset;
 
-    my %properties = map { $_ => 1 } $asset->meta->get_all_properties_list;
-    $self->{_callable} = \%properties;
-
-    return $self;
+    return WebGUI::Template::Proxy::Asset->_new($context, $asset);
 }
 
 sub _getAsset {
-    my ( $self, $id ) = @_;
+    my ( $class, $session, $id ) = @_;
     my ( $asset );
     try {
-        $asset = WebGUI::Asset->newByUrl( $self->session, $id );
+        $asset = WebGUI::Asset->newByUrl( $session, $id );
     }
     catch {
         try {
-            $asset = WebGUI::Asset->newById( $self->session, $id );
+            $asset = WebGUI::Asset->newById( $session, $id );
         }
         catch {
             die "Could not find asset $id to include in template: " . $_;
@@ -53,37 +45,5 @@ sub _getAsset {
     return $asset;
 }
 
-sub DESTROY {
-    # prevent AUTOLOADing
-}
-
-sub AUTOLOAD {
-    my $sub = our $AUTOLOAD;
-    $sub =~ s/.*:://;
-    my $self = shift;
-    if ($self->{_callable}{$sub}) {
-        my $result = $self->{_asset}->();
-        if ( eval { $result->isa('WebGUI::Asset'); 1 } ) {
-            return $self->_wrap($result);
-        }
-        return $result;
-    }
-    die 'Not allowed to call ' . $sub;
-}
-
-sub _wrap {
-    my $self = shift;
-    my $wrap = shift;
-    my $class = ref $self;
-    return $class->new($self->{_context}, $wrap);
-}
-
-sub parent {
-    my $self = shift;
-    my $parent = $self->{_asset}->parentNode;
-    return $self->_wrap($parent);
-}
-
 1;
 
-

lib/WebGUI/Template/Proxy.pm

@@ -0,0 +1,127 @@
+package WebGUI::Template::Proxy;
+use strict;
+use warnings;
+use Scalar::Util qw(blessed);
+use mro;
+use Try::Tiny;
+use namespace::clean;
+
+sub new {
+    my $class = shift;
+    $class = __PACKAGE__->_classify($class);
+    return $class->_new(@_);
+}
+
+sub _new {
+    my ($class, $context, $object) = @_;
+
+    my $stash = $context->stash;
+    my $session = $stash->{_session};
+
+    my $self = bless {
+        _session => $session,
+        _context => $context,
+        _object  => $object,
+    }, $class;
+
+    $self->{_methods} = $self->_get_methods($object);
+    return $self;
+}
+
+sub DESTROY {
+    # prevent AUTOLOADing
+}
+
+sub AUTOLOAD {
+    my $subname = our $AUTOLOAD;
+    $subname =~ s/.*:://;
+    my $self = shift;
+    if (my $sub = $self->can($subname)) {
+        return $self->$sub(@_);
+    }
+    die 'Method not found: ' . $subname;
+}
+
+sub can {
+    my ($self, $subname) = @_;
+    my $sub = $self->SUPER::can($subname);
+    if ($sub) {
+        return $sub;
+    }
+    elsif (ref $self) {
+        if ($self->{_methods}{$subname}) {
+            return $self->{_methods}{$subname};
+        }
+    }
+    return;
+}
+
+my %classified;
+sub _classify {
+    my $self = shift;
+    my $class = shift;
+    if ($classified{$class}) {
+        return $classified{$class};
+    }
+    my $classes = mro::get_linear_isa($class);
+    my @proxyclasses = map { (/^WebGUI::(.*)/ ? (__PACKAGE__ . '::' . $1) : (), __PACKAGE__ . '::' . $_) } @$classes;
+    for my $isa ( @proxyclasses ) {
+        (my $module = $isa . '.pm') =~ s{::}{/}g;
+        try {
+            require $module;
+            $classified{$class} = $isa;
+        } || next;
+        return $isa;
+    }
+    die "Cannot proxy $class";
+}
+
+sub _get_methods {
+    my $self = shift;
+    my $object = shift;
+    my @allowed = $self->_get_allowed($object);
+    my %methods;
+    for my $method ( @allowed ) {
+        $methods{$method} = $self->_gen_wrapped($method);
+    }
+    return \%methods;
+}
+
+sub _gen_wrapped {
+    my $self = shift;
+    my $method = shift;
+    my $context = $self->{_context};
+    my $object = $self->{_object};
+    return sub {
+        my @res;
+        if (wantarray) {
+            @res = $object->$method;
+        }
+        else {
+            $res[0] = $object->$method;
+        }
+        for my $res ( @res ) {
+            $self->_wrap(@res);
+        }
+        return wantarray ? @res : $res[0];
+    };
+}
+
+sub _wrap {
+    my $self = shift;
+    my $context = $self->{_context};
+    for my $item ( @_ ) {
+        if ( blessed $item ) {
+            if (! $item->isa(__PACKAGE__) ) {
+                $item = __PACKAGE__->new($context, $item);
+            }
+        }
+    }
+}
+
+sub _get_allowed {
+    return ();
+}
+
+1;
+

lib/WebGUI/Template/Proxy/Asset.pm

@@ -0,0 +1,22 @@
+package WebGUI::Template::Proxy::Asset;
+use strict;
+use warnings;
+
+use base 'WebGUI::Template::Proxy';
+
+sub _get_allowed {
+    my $self = shift;
+    my $asset = shift;
+    my @properties = $asset->meta->get_all_property_list;
+    return @properties;
+}
+
+sub parent {
+    my $self = shift;
+    my $parent = $self->{_asset}->parentNode;
+    $self->_wrap($parent);
+    return $parent;
+}
+
+1;
+

t/Template/Proxy.t

@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+
+use WebGUI::Test;
+use Test::More 'no_plan';
+
+use WebGUI::Asset;
+use WebGUI::Asset::Template::TemplateToolkit;
+
+my $parser = WebGUI::Asset::Template::TemplateToolkit->new(WebGUI::Test->session);
+
+my $vars = {
+    _asset => WebGUI::Test->asset(
+        title => 'proxied asset'
+    ),
+};
+
+my $template = <<'END_TEMPLATE';
+[% USE Asset -%]
+[%+ Asset.title +%]
+[%+ Asset.title('new title') +%]
+[%+ Asset.title +%]
+END_TEMPLATE
+
+my $out = $parser->process($template, $vars);
+
+my @lines = split /\n/, $out;
+
+is $lines[0], 'proxied asset', 'title retrieved';
+is $lines[2], 'proxied asset', 'title not able to be changed';
+