|
0
|
1 package IMPL::Transform;
|
|
7
|
2 use base qw(IMPL::Object);
|
|
0
|
3
|
|
|
4 use IMPL::Class::Property;
|
|
|
5 use IMPL::Class::Property::Direct;
|
|
|
6
|
|
|
7 BEGIN {
|
|
|
8 protected _direct property Templates => prop_all;
|
|
|
9 protected _direct property Default => prop_all;
|
|
|
10 protected _direct property Plain => prop_all;
|
|
|
11 }
|
|
|
12
|
|
7
|
13 sub CTOR {
|
|
|
14 my ($this,%args) = @_;
|
|
|
15
|
|
|
16 $this->{$Plain} = delete $args{-plain};
|
|
|
17 $this->{$Default} = delete $args{-default};
|
|
|
18
|
|
|
19 $this->{$Templates} = \%args;
|
|
|
20 }
|
|
0
|
21
|
|
|
22 sub Transform {
|
|
|
23 my ($this,$object) = @_;
|
|
|
24
|
|
|
25 if (not ref $object) {
|
|
|
26 die new IMPL::Exception("There is no the template for a plain value in the transform") unless $this->{$Plain};
|
|
|
27 my $template = $this->{$Plain};
|
|
|
28 return $this->$template($object);
|
|
|
29 } else {
|
|
|
30
|
|
|
31 my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object);
|
|
|
32
|
|
|
33 return $this->$template($object);
|
|
|
34 }
|
|
|
35 }
|
|
|
36
|
|
|
37 sub MatchTemplate {
|
|
|
38 my ($this,$object) = @_;
|
|
|
39 my $class = ref $object;
|
|
|
40
|
|
|
41 foreach my $tClass ( keys %{$this->Templates || {}} ) {
|
|
|
42 return $this->Templates->{$tClass} if ($tClass eq $class);
|
|
|
43 }
|
|
|
44 }
|
|
|
45
|
|
|
46 package IMPL::Transform::NoTransformException;
|
|
|
47 use base qw(IMPL::Exception);
|
|
|
48
|
|
|
49 1;
|
|
|
50
|
|
|
51 __END__
|
|
|
52
|
|
|
53 =pod
|
|
|
54 =head1 SYNOPSIS
|
|
|
55
|
|
|
56 my $obj = new AnyObject;
|
|
|
57
|
|
|
58 my $t = new Transform (
|
|
|
59 AnyClass => sub {
|
|
|
60 my ($this,$object) = @_;
|
|
|
61 return new NewClass({ Name => $object->name, Document => $this->Transform($object->Data) })
|
|
|
62 },
|
|
|
63 DocClass => sub {
|
|
|
64 my ($this,$object) = @_;
|
|
|
65 return new DocPreview(Author => $object->Author, Text => $object->Data);
|
|
7
|
66 },
|
|
|
67 -default => sub {
|
|
|
68 my ($this,$object) = @_;
|
|
|
69 return $object;
|
|
|
70 },
|
|
|
71 -plain => sub {
|
|
|
72 my ($this,$object) = @_;
|
|
|
73 return $object;
|
|
0
|
74 }
|
|
|
75 );
|
|
|
76
|
|
7
|
77 my $result = $t->Transform($obj);
|
|
|
78
|
|
0
|
79 =head1 Summary
|
|
|
80 .
|
|
|
81
|
|
|
82 =cut |
