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