Mercurial > pub > Impl
annotate Lib/IMPL/Transform.pm @ 166:4267a2ac3d46
Added Class::Template,
Rewritten SQL::Schema
'use parent' directive instead of 'use base'
| author | wizard |
|---|---|
| date | Sat, 23 Apr 2011 23:12:06 +0400 |
| parents | e6447ad85cb4 |
| children | d1676be8afcc |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::Transform; |
| 166 | 2 use parent qw(IMPL::Object); |
| 49 | 3 |
| 4 use IMPL::Class::Property; | |
| 5 use IMPL::Class::Property::Direct; | |
| 6 | |
| 7 BEGIN { | |
| 8 protected _direct property Templates => prop_all; | |
| 9 protected _direct property Default => prop_all; | |
| 10 protected _direct property Plain => prop_all; | |
| 11 } | |
| 12 | |
| 13 sub CTOR { | |
| 14 my ($this,%args) = @_; | |
| 15 | |
| 16 $this->{$Plain} = delete $args{-plain}; | |
| 17 $this->{$Default} = delete $args{-default}; | |
| 18 | |
| 19 $this->{$Templates} = \%args; | |
| 20 } | |
| 21 | |
| 22 sub Transform { | |
| 23 my ($this,$object,@args) = @_; | |
| 24 | |
| 25 if (not ref $object) { | |
| 26 die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$Plain}; | |
| 27 my $template = $this->{$Plain}; | |
| 28 return $this->$template($object,@args); | |
| 29 } else { | |
| 30 | |
| 31 my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object); | |
| 32 | |
| 33 return $this->$template($object,@args); | |
| 34 } | |
| 35 } | |
| 36 | |
| 37 sub MatchTemplate { | |
| 38 my ($this,$object) = @_; | |
| 39 my $class = $this->GetClassForObject( $object ); | |
| 40 | |
| 41 foreach my $tClass ( keys %{$this->Templates || {}} ) { | |
| 42 return $this->Templates->{$tClass} if ($tClass eq $class); | |
| 43 } | |
| 44 } | |
| 45 | |
| 46 sub GetClassForObject { | |
| 47 my ($this,$object) = @_; | |
| 48 | |
| 49 return ref $object; | |
| 50 } | |
| 51 | |
| 52 package IMPL::Transform::NoTransformException; | |
| 166 | 53 use parent qw(IMPL::Exception); |
| 49 | 54 |
| 55 our %CTOR = ( | |
| 56 'IMPL::Exception' => sub { 'No transformation', @_ } | |
| 57 ); | |
| 58 | |
| 59 1; | |
| 60 | |
| 61 __END__ | |
| 62 | |
| 63 =pod | |
| 96 | 64 |
| 65 =head1 NAME | |
| 66 | |
| 67 C<IMPL::Transform> - преобразование объектной структуры | |
| 68 | |
| 49 | 69 =head1 SYNOPSIS |
| 70 | |
| 96 | 71 =begin code |
| 72 | |
| 49 | 73 my $obj = new AnyObject; |
| 74 | |
| 75 my $t = new Transform ( | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
96
diff
changeset
|
76 SomeClass => sub { |
| 49 | 77 my ($this,$object) = @_; |
| 78 return new NewClass({ Name => $object->name, Document => $this->Transform($object->Data) }) | |
| 79 }, | |
| 80 DocClass => sub { | |
| 81 my ($this,$object) = @_; | |
| 82 return new DocPreview(Author => $object->Author, Text => $object->Data); | |
| 83 }, | |
| 84 -default => sub { | |
| 85 my ($this,$object) = @_; | |
| 86 return $object; | |
| 87 }, | |
| 88 -plain => sub { | |
| 89 my ($this,$object) = @_; | |
| 90 return $object; | |
| 91 } | |
| 92 ); | |
| 93 | |
| 94 my $result = $t->Transform($obj); | |
| 95 | |
| 96 | 96 =end code |
| 97 | |
| 49 | 98 =head1 DESCRIPTION |
| 99 | |
| 100 Преобразование одного объекта к другому, например даных к их представлению. | |
| 101 | |
| 102 =cut |