diff Lib/IMPL/Transform.pm @ 197:6b1dda998839

Added IMPL::declare, IMPL::require, to simplify module definitions IMPL::Transform now admires object inheritance while searching for the transformation Added HTTP some exceptions IMPL::Web::Application::RestResource almost implemented
author sergey
date Thu, 19 Apr 2012 02:10:02 +0400
parents d1676be8afcc
children 2ffe6f661605
line wrap: on
line diff
--- a/Lib/IMPL/Transform.pm	Mon Apr 16 17:42:54 2012 +0400
+++ b/Lib/IMPL/Transform.pm	Thu Apr 19 02:10:02 2012 +0400
@@ -1,36 +1,40 @@
 package IMPL::Transform;
+use strict;
+
 use parent qw(IMPL::Object);
 
-use IMPL::Class::Property;
+use IMPL::lang qw(:declare :constants);
+
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    protected _direct property Templates => prop_all;
-    protected _direct property Default => prop_all;
-    protected _direct property Plain => prop_all;
+    public _direct property templates => PROP_ALL;
+    public _direct property default => PROP_ALL;
+    public _direct property plain => PROP_ALL;
+    private _direct property _cache => PROP_ALL;
 }
 
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->{$Plain} = delete $args{-plain};
-    $this->{$Default} = delete $args{-default};
+    $this->{$plain} = delete $args{-plain};
+    $this->{$default} = delete $args{-default};
     
-    $this->{$Templates} = \%args;
+    $this->{$templates} = \%args;
 }
 
 sub Transform {
     my ($this,$object,@args) = @_;
     
     if (not ref $object) {
-        die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$Plain};
-        my $template = $this->{$Plain};
+        die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$plain};
+        my $template = $this->{$plain};
         return $this->$template($object,@args);
     } else {
     
-        my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object);
+        my $template = $this->MatchTemplate($object) || $this->default or die new IMPL::Transform::NoTransformException(ref $object);
     
-        return $this->$template($object,@args);
+        return $this->ProcessTemplate($template,$object,\@args);
     }
 }
 
@@ -38,11 +42,37 @@
     my ($this,$object) = @_;
     my $class = $this->GetClassForObject( $object );
     
-    foreach my $tClass ( keys %{$this->Templates || {}} ) {
-        return $this->Templates->{$tClass} if ($tClass eq $class);
+    if (my $t = $this->{$_cache}->{$class} ) {
+    	return $t;
+    } else {
+    	$t = $this->{$templates}->{$class};
+    	
+    	return $this->{$_cache}->{$class} = $t if $t;
+    	
+    	{
+            no strict 'refs';
+    	
+            my @isa = @{"${class}::ISA"};
+            
+            while (@isa) {
+            	my $sclass = shift @isa;
+            	
+            	$t = $this->{$templates}->{$sclass};
+            	
+            	return $this->{$_cache}->{$class} = $t if $t;
+            	
+            	push @isa, @{"${sclass}::ISA"};
+            } 
+    	};
     }
 }
 
+sub ProcessTemplate {
+	my ($this,$t,$obj,$args) = @_;
+	
+	return $this->$t($obj,@$args);
+}
+
 sub GetClassForObject {
     my ($this,$object) = @_;
     
@@ -50,11 +80,11 @@
 }
 
 package IMPL::Transform::NoTransformException;
-use parent qw(IMPL::Exception);
-
-our %CTOR = (
-    'IMPL::Exception' => sub { 'No transformation', @_ }
-);
+use IMPL::declare {
+	base => {
+		'IMPL::Exception' =>  sub { 'No transformation', @_ }
+	}
+};
 
 1;