Mercurial > pub > Impl
view Lib/IMPL/Transform.pm @ 194:4d0e1962161c
Replaced tabs with spaces
IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author | cin |
---|---|
date | Tue, 10 Apr 2012 20:08:29 +0400 |
parents | d1676be8afcc |
children | 6b1dda998839 |
line wrap: on
line source
package IMPL::Transform; use parent qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Class::Property::Direct; BEGIN { protected _direct property Templates => prop_all; protected _direct property Default => prop_all; protected _direct property Plain => prop_all; } sub CTOR { my ($this,%args) = @_; $this->{$Plain} = delete $args{-plain}; $this->{$Default} = delete $args{-default}; $this->{$Templates} = \%args; } sub Transform { my ($this,$object,@args) = @_; if (not ref $object) { die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$Plain}; my $template = $this->{$Plain}; return $this->$template($object,@args); } else { my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object); return $this->$template($object,@args); } } sub MatchTemplate { my ($this,$object) = @_; my $class = $this->GetClassForObject( $object ); foreach my $tClass ( keys %{$this->Templates || {}} ) { return $this->Templates->{$tClass} if ($tClass eq $class); } } sub GetClassForObject { my ($this,$object) = @_; return ref $object; } package IMPL::Transform::NoTransformException; use parent qw(IMPL::Exception); our %CTOR = ( 'IMPL::Exception' => sub { 'No transformation', @_ } ); 1; __END__ =pod =head1 NAME C<IMPL::Transform> - преобразование объектной структуры =head1 SYNOPSIS =begin code my $obj = new AnyObject; my $t = new Transform ( SomeClass => sub { my ($this,$object) = @_; return new NewClass({ Name => $object->name, Document => $this->Transform($object->Data) }) }, DocClass => sub { my ($this,$object) = @_; return new DocPreview(Author => $object->Author, Text => $object->Data); }, -default => sub { my ($this,$object) = @_; return $object; }, -plain => sub { my ($this,$object) = @_; return $object; } ); my $result = $t->Transform($obj); =end code =head1 DESCRIPTION Преобразование одного объекта к другому, например даных к их представлению. =cut