|
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 {
|
|
38
|
23 my ($this,$object,@args) = @_;
|
|
0
|
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};
|
|
38
|
28 return $this->$template($object,@args);
|
|
0
|
29 } else {
|
|
|
30
|
|
|
31 my $template = $this->MatchTemplate($object) || $this->Default or die new IMPL::Transform::NoTransformException(ref $object);
|
|
|
32
|
|
38
|
33 return $this->$template($object,@args);
|
|
0
|
34 }
|
|
|
35 }
|
|
|
36
|
|
|
37 sub MatchTemplate {
|
|
|
38 my ($this,$object) = @_;
|
|
38
|
39 my $class = $this->GetClassForObject( $object );
|
|
0
|
40
|
|
|
41 foreach my $tClass ( keys %{$this->Templates || {}} ) {
|
|
|
42 return $this->Templates->{$tClass} if ($tClass eq $class);
|
|
|
43 }
|
|
|
44 }
|
|
|
45
|
|
38
|
46 sub GetClassForObject {
|
|
|
47 my ($this,$object) = @_;
|
|
|
48
|
|
|
49 return ref $object;
|
|
|
50 }
|
|
|
51
|
|
0
|
52 package IMPL::Transform::NoTransformException;
|
|
|
53 use base qw(IMPL::Exception);
|
|
|
54
|
|
|
55 1;
|
|
|
56
|
|
|
57 __END__
|
|
|
58
|
|
|
59 =pod
|
|
|
60 =head1 SYNOPSIS
|
|
|
61
|
|
|
62 my $obj = new AnyObject;
|
|
|
63
|
|
|
64 my $t = new Transform (
|
|
|
65 AnyClass => sub {
|
|
|
66 my ($this,$object) = @_;
|
|
|
67 return new NewClass({ Name => $object->name, Document => $this->Transform($object->Data) })
|
|
|
68 },
|
|
|
69 DocClass => sub {
|
|
|
70 my ($this,$object) = @_;
|
|
|
71 return new DocPreview(Author => $object->Author, Text => $object->Data);
|
|
7
|
72 },
|
|
|
73 -default => sub {
|
|
|
74 my ($this,$object) = @_;
|
|
|
75 return $object;
|
|
|
76 },
|
|
|
77 -plain => sub {
|
|
|
78 my ($this,$object) = @_;
|
|
|
79 return $object;
|
|
0
|
80 }
|
|
|
81 );
|
|
|
82
|
|
7
|
83 my $result = $t->Transform($obj);
|
|
|
84
|
|
38
|
85 =head1 DESCRIPTION
|
|
|
86
|
|
|
87 , .
|
|
0
|
88
|
|
|
89 =cut |
