annotate Lib/CDBI/Transform.pm @ 5:efa7db58abae

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