Mercurial > pub > Impl
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;