view Lib/IMPL/Transform.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 94d47b388442
children d660fb38b7cc
line wrap: on
line source

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) = @_;
    
    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);
    } else {
    
        my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object);
    
        return $this->$template($object);
    }
}

sub MatchTemplate {
    my ($this,$object) = @_;
    my $class = ref $object;
    
    foreach my $tClass ( keys %{$this->Templates || {}} ) {
        return $this->Templates->{$tClass} if ($tClass eq $class);
    }
}

package IMPL::Transform::NoTransformException;
use base qw(IMPL::Exception);

1;

__END__

=pod
=head1 SYNOPSIS

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);

=head1 Summary
Преобразует данные содержащиеся в форме в реальные объекты используя специальное преобразование.

=cut