Mercurial > pub > Impl
annotate Lib/IMPL/Transform.pm @ 270:3f59fd828d5f
merge
author | cin |
---|---|
date | Fri, 25 Jan 2013 00:25:02 +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 |