Mercurial > pub > Impl
annotate Lib/IMPL/Transform.pm @ 274:8d36073411b1
+Added AutoDispose class
*code cleanups
| author | cin |
|---|---|
| date | Wed, 30 Jan 2013 03:30:28 +0400 |
| parents | cd2b1f121029 |
| children | 4ddb27ff4a0b |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::Transform; |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
2 use strict; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
3 |
| 166 | 4 use parent qw(IMPL::Object); |
| 49 | 5 |
| 236 | 6 use IMPL::lang qw(:declare); |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
7 |
| 49 | 8 use IMPL::Class::Property::Direct; |
| 9 | |
| 10 BEGIN { | |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
11 public _direct property templates => PROP_ALL; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
12 public _direct property default => PROP_ALL; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
13 public _direct property plain => PROP_ALL; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
14 private _direct property _cache => PROP_ALL; |
| 49 | 15 } |
| 16 | |
| 17 sub CTOR { | |
| 198 | 18 my $this = shift; |
| 19 my $args = @_ == 1 ? shift : { @_ }; | |
| 49 | 20 |
| 198 | 21 $this->{$plain} = delete $args->{-plain}; |
| 22 $this->{$default} = delete $args->{-default}; | |
| 49 | 23 |
| 198 | 24 $this->{$templates} = $args; |
| 49 | 25 } |
| 26 | |
| 27 sub Transform { | |
| 28 my ($this,$object,@args) = @_; | |
| 29 | |
| 30 if (not ref $object) { | |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
31 die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$plain}; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
32 my $template = $this->{$plain}; |
| 49 | 33 return $this->$template($object,@args); |
| 34 } else { | |
| 35 | |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
36 my $template = $this->MatchTemplate($object) || $this->default or die new IMPL::Transform::NoTransformException(ref $object); |
| 49 | 37 |
|
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
198
diff
changeset
|
38 return $this->ProcessTemplate($template,$object,@args); |
| 49 | 39 } |
| 40 } | |
| 41 | |
| 42 sub MatchTemplate { | |
| 43 my ($this,$object) = @_; | |
| 44 my $class = $this->GetClassForObject( $object ); | |
| 45 | |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
46 if (my $t = $this->{$_cache}->{$class} ) { |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
47 return $t; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
48 } else { |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
49 $t = $this->{$templates}->{$class}; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
50 |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
51 return $this->{$_cache}->{$class} = $t if $t; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
52 |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
53 { |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
54 no strict 'refs'; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
55 |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
56 my @isa = @{"${class}::ISA"}; |
| 212 | 57 |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
58 while (@isa) { |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
59 my $sclass = shift @isa; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
60 |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
61 $t = $this->{$templates}->{$sclass}; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
62 |
| 198 | 63 #cache and return |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
64 return $this->{$_cache}->{$class} = $t if $t; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
65 |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
66 push @isa, @{"${sclass}::ISA"}; |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
67 } |
|
243
cd2b1f121029
*TTView: fixed template selection based on the model type
sergey
parents:
236
diff
changeset
|
68 ; |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
69 }; |
| 49 | 70 } |
| 71 } | |
| 72 | |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
73 sub ProcessTemplate { |
|
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
198
diff
changeset
|
74 my ($this,$t,$obj,@args) = @_; |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
75 |
|
199
e743a8481327
Added REST support for forms (with only get and post methods)
sergey
parents:
198
diff
changeset
|
76 return $this->$t($obj,@args); |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
77 } |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
78 |
| 49 | 79 sub GetClassForObject { |
| 80 my ($this,$object) = @_; | |
| 81 | |
| 82 return ref $object; | |
| 83 } | |
| 84 | |
| 85 package IMPL::Transform::NoTransformException; | |
|
197
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
86 use IMPL::declare { |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
87 base => { |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
88 'IMPL::Exception' => sub { 'No transformation', @_ } |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
89 } |
|
6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
sergey
parents:
180
diff
changeset
|
90 }; |
| 49 | 91 |
| 92 1; | |
| 93 | |
| 94 __END__ | |
| 95 | |
| 96 =pod | |
| 96 | 97 |
| 98 =head1 NAME | |
| 99 | |
| 180 | 100 C<IMPL::Transform> - преобразование объектной структуры |
| 96 | 101 |
| 49 | 102 =head1 SYNOPSIS |
| 103 | |
| 96 | 104 =begin code |
| 105 | |
| 49 | 106 my $obj = new AnyObject; |
| 107 | |
| 108 my $t = new Transform ( | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
96
diff
changeset
|
109 SomeClass => sub { |
| 49 | 110 my ($this,$object) = @_; |
| 111 return new NewClass({ Name => $object->name, Document => $this->Transform($object->Data) }) | |
| 112 }, | |
| 113 DocClass => sub { | |
| 114 my ($this,$object) = @_; | |
| 115 return new DocPreview(Author => $object->Author, Text => $object->Data); | |
| 116 }, | |
| 117 -default => sub { | |
| 118 my ($this,$object) = @_; | |
| 119 return $object; | |
| 120 }, | |
| 121 -plain => sub { | |
| 122 my ($this,$object) = @_; | |
| 123 return $object; | |
| 124 } | |
| 125 ); | |
| 126 | |
| 127 my $result = $t->Transform($obj); | |
| 128 | |
| 96 | 129 =end code |
| 130 | |
| 49 | 131 =head1 DESCRIPTION |
| 132 | |
| 180 | 133 Преобразование одного объекта к другому, например даных к их представлению. |
| 49 | 134 |
| 135 =cut |