--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Transform.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,134 @@
+package IMPL::Transform;
+use strict;
+
+use parent qw(IMPL::Object);
+
+use IMPL::lang qw(:declare);
+
+
+BEGIN {
+    public _direct property templates => PROP_ALL;
+    public _direct property default => PROP_ALL;
+    public _direct property plain => PROP_ALL;
+    private _direct property _cache => PROP_ALL;
+}
+
+sub CTOR {
+    my $this = shift;
+    my $args = @_ == 1 ? shift : { @_ };
+    
+    $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->ProcessTemplate($template,$object,@args);
+    }
+}
+
+sub MatchTemplate {
+    my ($this,$object) = @_;
+    my $class = $this->GetClassForObject( $object );
+    
+    if (my $t = $this->{$_cache}->{$class} ) {
+    	return $t;
+    } else {
+    	$t = $this->{$templates}->{$class};
+    	
+    	return $this->{$_cache}->{$class} = $t if $t;
+    	
+    	{
+            no strict 'refs';
+    	
+            my @isa = @{"${class}::ISA"};
+           
+            while (@isa) {
+            	my $sclass = shift @isa;
+            	
+            	$t = $this->{$templates}->{$sclass};
+            	
+            	#cache and return
+            	return $this->{$_cache}->{$class} = $t if $t;
+            	
+            	push @isa, @{"${sclass}::ISA"};
+            } 
+            ;
+    	};
+    }
+}
+
+sub ProcessTemplate {
+	my ($this,$t,$obj,@args) = @_;
+	
+	return $this->$t($obj,@args);
+}
+
+sub GetClassForObject {
+    my ($this,$object) = @_;
+    
+    return ref $object;
+}
+
+package IMPL::Transform::NoTransformException;
+use IMPL::declare {
+	base => {
+		'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