49
+ − 1 package IMPL::Transform;
+ − 2 use base qw(IMPL::Object);
+ − 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;
+ − 53 use base qw(IMPL::Exception);
+ − 54
+ − 55 our %CTOR = (
+ − 56 'IMPL::Exception' => sub { 'No transformation', @_ }
+ − 57 );
+ − 58
+ − 59 1;
+ − 60
+ − 61 __END__
+ − 62
+ − 63 =pod
+ − 64 =head1 SYNOPSIS
+ − 65
+ − 66 my $obj = new AnyObject;
+ − 67
+ − 68 my $t = new Transform (
+ − 69 AnyClass => sub {
+ − 70 my ($this,$object) = @_;
+ − 71 return new NewClass({ Name => $object->name, Document => $this->Transform($object->Data) })
+ − 72 },
+ − 73 DocClass => sub {
+ − 74 my ($this,$object) = @_;
+ − 75 return new DocPreview(Author => $object->Author, Text => $object->Data);
+ − 76 },
+ − 77 -default => sub {
+ − 78 my ($this,$object) = @_;
+ − 79 return $object;
+ − 80 },
+ − 81 -plain => sub {
+ − 82 my ($this,$object) = @_;
+ − 83 return $object;
+ − 84 }
+ − 85 );
+ − 86
+ − 87 my $result = $t->Transform($obj);
+ − 88
+ − 89 =head1 DESCRIPTION
+ − 90
+ − 91 �������������� ������ ������� � �������, �������� ����� � �� �������������.
+ − 92
+ − 93 =cut