|
0
|
1 package CDBI::Transform::FormToObject;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use base qw(IMPL::Object::Autofill Form::Transform );
|
|
|
6 use IMPL::Class::Property;
|
|
|
7 require IMPL::Exception;
|
|
|
8
|
|
|
9 BEGIN {
|
|
|
10 public property Class => prop_all;
|
|
|
11 public property Namespace => prop_all;
|
|
|
12 }
|
|
|
13
|
|
|
14 sub CTOR {
|
|
|
15 my $this = shift;
|
|
|
16 $this->superCTOR(@_);
|
|
|
17
|
|
|
18 die new IMPL::InvalidArgumentException('Class is required') unless $this->Class;
|
|
|
19 }
|
|
|
20
|
|
|
21 sub TransformContainer {
|
|
|
22 my ($this,$container) = @_;
|
|
|
23
|
|
|
24 my $class;
|
|
|
25 if ($container->Name eq 'Form') {
|
|
|
26 $class = $this->Class;
|
|
|
27 } else {
|
|
|
28 $class = $this->_mk_class($container->Attributes->{'cdbi.class'}) or die new IMPL::Exception('cdbi.class isn\'t specified',$container->Id->Canonical);
|
|
|
29 }
|
|
|
30
|
|
|
31 my %data;
|
|
|
32
|
|
|
33 #my %columns = map {$_,1} $class->columns();
|
|
|
34
|
|
|
35 no strict 'refs';
|
|
|
36 my @accessors = map $_->accessor, $class->columns();# grep $columns{lc $_}, keys %{"${class}::"};
|
|
|
37
|
|
|
38 # ôîðìèðóåì èç êîíòåéíåðà ôîðìû äàííûå äëÿ îáúåêòà
|
|
|
39 foreach my $column ( @accessors, 'id' ) {
|
|
|
40 my ($val) = $container->GetChild($column);
|
|
|
41 $data{$column} = $this->Transform($val) if $val;
|
|
|
42 }
|
|
|
43
|
|
|
44 my $obj;
|
|
|
45 if ($data{id}) {
|
|
|
46 # edit value
|
|
|
47
|
|
|
48
|
|
|
49 $obj = $class->validateId($data{id});
|
|
|
50 my %filter = map { $_, $obj->$_()} @accessors;
|
|
|
51 $filter{$_} = $data{$_} foreach keys %data;
|
|
|
52 my ($newObj) = $class->lookup(\%data);
|
|
|
53 die new IMPL::DuplicateException('The object already exists', $class) if ($newObj and $newObj->id != $data{id});
|
|
|
54
|
|
|
55 $obj->$_($data{$_}) foreach keys %data;
|
|
|
56 $obj->update();
|
|
|
57 } else {
|
|
|
58 # new instance
|
|
|
59 die new IMPL::DuplicateException('The object already exists', $class) if $class->lookup(\%data);
|
|
|
60 $obj = $class->insert(\%data);
|
|
|
61 }
|
|
|
62 return $obj;
|
|
|
63 }
|
|
|
64
|
|
|
65 sub _mk_class {
|
|
|
66 my ($this,$name) = @_;
|
|
|
67
|
|
|
68 return unless $name;
|
|
|
69 return $name if $name =~ /::/;
|
|
|
70 return $this->Namespace ? $this->Namespace."::$name" : $name;
|
|
|
71 }
|
|
|
72
|
|
|
73 package CDBI::Transform::ObjectToForm;
|
|
|
74 use base qw(IMPL::Transform);
|
|
|
75
|
|
|
76 use IMPL::Class::Property;
|
|
|
77
|
|
|
78 sub CTOR {
|
|
|
79 my $this = shift;
|
|
|
80
|
|
|
81 $this->superCTOR(
|
|
|
82 Default => \&TransformObject,
|
|
|
83 Plain => sub { my ($this,$val) = @_; return $val; }
|
|
|
84 );
|
|
|
85 }
|
|
|
86
|
|
|
87 sub TransformObject {
|
|
|
88 my ($this,$object) = @_;
|
|
|
89
|
|
|
90 return $object if not ref $object;
|
|
|
91
|
|
|
92 my %data;
|
|
|
93 foreach my $column ( (map $_->accessor,$object->columns()),'id') {
|
|
|
94 my $value = $object->$column();
|
|
|
95
|
|
|
96 if (ref $value eq 'HASH') {
|
|
|
97 $data{"$column/$_"} = $value->{$_} foreach keys %$value;
|
|
|
98 } else {
|
|
|
99 $data{$column} = $value;
|
|
|
100 }
|
|
|
101 }
|
|
|
102
|
|
|
103 return \%data;
|
|
|
104 }
|
|
|
105 1;
|
