Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
196:a705e848dcc7 197:6b1dda998839
1 package IMPL::Transform; 1 package IMPL::Transform;
2 use strict;
3
2 use parent qw(IMPL::Object); 4 use parent qw(IMPL::Object);
3 5
4 use IMPL::Class::Property; 6 use IMPL::lang qw(:declare :constants);
7
5 use IMPL::Class::Property::Direct; 8 use IMPL::Class::Property::Direct;
6 9
7 BEGIN { 10 BEGIN {
8 protected _direct property Templates => prop_all; 11 public _direct property templates => PROP_ALL;
9 protected _direct property Default => prop_all; 12 public _direct property default => PROP_ALL;
10 protected _direct property Plain => prop_all; 13 public _direct property plain => PROP_ALL;
14 private _direct property _cache => PROP_ALL;
11 } 15 }
12 16
13 sub CTOR { 17 sub CTOR {
14 my ($this,%args) = @_; 18 my ($this,%args) = @_;
15 19
16 $this->{$Plain} = delete $args{-plain}; 20 $this->{$plain} = delete $args{-plain};
17 $this->{$Default} = delete $args{-default}; 21 $this->{$default} = delete $args{-default};
18 22
19 $this->{$Templates} = \%args; 23 $this->{$templates} = \%args;
20 } 24 }
21 25
22 sub Transform { 26 sub Transform {
23 my ($this,$object,@args) = @_; 27 my ($this,$object,@args) = @_;
24 28
25 if (not ref $object) { 29 if (not ref $object) {
26 die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$Plain}; 30 die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$plain};
27 my $template = $this->{$Plain}; 31 my $template = $this->{$plain};
28 return $this->$template($object,@args); 32 return $this->$template($object,@args);
29 } else { 33 } else {
30 34
31 my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object); 35 my $template = $this->MatchTemplate($object) || $this->default or die new IMPL::Transform::NoTransformException(ref $object);
32 36
33 return $this->$template($object,@args); 37 return $this->ProcessTemplate($template,$object,\@args);
34 } 38 }
35 } 39 }
36 40
37 sub MatchTemplate { 41 sub MatchTemplate {
38 my ($this,$object) = @_; 42 my ($this,$object) = @_;
39 my $class = $this->GetClassForObject( $object ); 43 my $class = $this->GetClassForObject( $object );
40 44
41 foreach my $tClass ( keys %{$this->Templates || {}} ) { 45 if (my $t = $this->{$_cache}->{$class} ) {
42 return $this->Templates->{$tClass} if ($tClass eq $class); 46 return $t;
47 } else {
48 $t = $this->{$templates}->{$class};
49
50 return $this->{$_cache}->{$class} = $t if $t;
51
52 {
53 no strict 'refs';
54
55 my @isa = @{"${class}::ISA"};
56
57 while (@isa) {
58 my $sclass = shift @isa;
59
60 $t = $this->{$templates}->{$sclass};
61
62 return $this->{$_cache}->{$class} = $t if $t;
63
64 push @isa, @{"${sclass}::ISA"};
65 }
66 };
43 } 67 }
68 }
69
70 sub ProcessTemplate {
71 my ($this,$t,$obj,$args) = @_;
72
73 return $this->$t($obj,@$args);
44 } 74 }
45 75
46 sub GetClassForObject { 76 sub GetClassForObject {
47 my ($this,$object) = @_; 77 my ($this,$object) = @_;
48 78
49 return ref $object; 79 return ref $object;
50 } 80 }
51 81
52 package IMPL::Transform::NoTransformException; 82 package IMPL::Transform::NoTransformException;
53 use parent qw(IMPL::Exception); 83 use IMPL::declare {
54 84 base => {
55 our %CTOR = ( 85 'IMPL::Exception' => sub { 'No transformation', @_ }
56 'IMPL::Exception' => sub { 'No transformation', @_ } 86 }
57 ); 87 };
58 88
59 1; 89 1;
60 90
61 __END__ 91 __END__
62 92