view Lib/IMPL/Transform.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children 4c55aed00ff2
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,@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 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 DESCRIPTION

Преобразование одного объекта к другому, например даных к их представлению.

=cut