package IMPL::Transform;
use base 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 base 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 (
    AnyClass => 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