view Lib/IMPL/Transform.pm @ 19:1ca530e5c9c5

DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
author Sergey
date Fri, 11 Sep 2009 16:30:39 +0400
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