annotate Lib/IMPL/Web/Application/ControllerUnit.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +0400
parents 4d0e1962161c
children c6d0f889ef87
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
1 use strict;
110
c13a215508ca Refactoring,
wizard
parents:
diff changeset
2 package IMPL::Web::Application::ControllerUnit;
166
4267a2ac3d46 Added Class::Template,
wizard
parents: 160
diff changeset
3 use parent qw(IMPL::Object);
110
c13a215508ca Refactoring,
wizard
parents:
diff changeset
4
c13a215508ca Refactoring,
wizard
parents:
diff changeset
5 use IMPL::Class::Property;
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
6 use IMPL::DOM::Transform::PostToDOM;
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
7 use IMPL::DOM::Schema;
113
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
8 use Class::Inspector;
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
9 use File::Spec;
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
10 use Sub::Name;
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
11
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
12 use constant {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
13 CONTROLLER_METHODS => 'controller_methods',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
14 STATE_CORRECT => 'correct',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
15 STATE_NEW => 'new',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
16 STATE_INVALID => 'invalid',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
17 TTYPE_FORM => 'form',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
18 TTYPE_TRANS => 'tran'
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
19 };
110
c13a215508ca Refactoring,
wizard
parents:
diff changeset
20
c13a215508ca Refactoring,
wizard
parents:
diff changeset
21 BEGIN {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
22 public property action => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
23 public property application => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
24 public property query => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
25 public property response => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
26 public property formData => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
27 public property formSchema => prop_get | owner_set;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
28 public property formErrors => prop_get | owner_set;
110
c13a215508ca Refactoring,
wizard
parents:
diff changeset
29 }
c13a215508ca Refactoring,
wizard
parents:
diff changeset
30
170
b88b7fe60aa3 refactoring
sourcer
parents: 166
diff changeset
31 my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo);
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
32
113
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
33 __PACKAGE__->class_data(CONTROLLER_METHODS,{});
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
34
170
b88b7fe60aa3 refactoring
sourcer
parents: 166
diff changeset
35 our @schemaInc;
b88b7fe60aa3 refactoring
sourcer
parents: 166
diff changeset
36
110
c13a215508ca Refactoring,
wizard
parents:
diff changeset
37 sub CTOR {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
38 my ($this,$action,$args) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
39
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
40 $this->action($action);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
41 $this->application($action->application);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
42 $this->query($action->query);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
43 $this->response($action->response);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
44
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
45 $this->$_($args->{$_}) foreach qw(formData formSchema formErrors);
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
46 }
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
47
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
48 sub unitNamespace() {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
49 ""
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
50 }
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
51
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
52 sub transactions {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
53 my ($self,%methods) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
54
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
55 while (my ($method,$info) = each %methods) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
56 if ($info and ref $info ne 'HASH') {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
57 warn "Bad transaction $method description";
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
58 $info = {};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
59 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
60
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
61 $info->{wrapper} = 'TransactionWrapper';
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
62 $info->{method} ||= $method;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
63 $info->{context}{transactionType} = TTYPE_TRANS;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
64 $self->class_data(CONTROLLER_METHODS)->{$method} = $info;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
65 }
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
66 }
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
67
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
68 sub forms {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
69 my ($self,%forms) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
70
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
71 while ( my ($method,$info) = each %forms ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
72 die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
73 if ( not ref $info ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
74 $self->class_data(CONTROLLER_METHODS)->{$method} = {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
75 wrapper => 'FormWrapper',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
76 schema => $info,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
77 method => $method,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
78 context => { transactionType => TTYPE_FORM }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
79 };
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
80 } elsif (ref $info eq 'HASH') {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
81 $info->{wrapper} = 'FormWrapper';
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
82 $info->{method} ||= $method;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
83 $info->{context}{transactionType} = TTYPE_FORM;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
84
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
85 $self->class_data(CONTROLLER_METHODS)->{$method} = $info;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
86 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
87 die new IMPL::Exception("Unsupported method information",$self,$method);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
88 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
89 }
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
90 }
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
91
110
c13a215508ca Refactoring,
wizard
parents:
diff changeset
92 sub InvokeAction {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
93 my ($self,$method,$action) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
94
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
95 if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
96 if (my $ctx = $methodInfo->{context}) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
97 $action->context->{$_} = $ctx->{$_} foreach keys %$ctx;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
98 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
99 if (my $wrapper = $methodInfo->{wrapper}) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
100 return $self->$wrapper($method,$action,$methodInfo);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
101 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
102 return $self->TransactionWrapper($method,$action,$methodInfo);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
103 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
104 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
105 die new IMPL::InvalidOperationException("Invalid method call",$self,$method);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
106 }
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
107 }
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
108
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
109 sub MakeParams {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
110 my ($this,$methodInfo) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
111
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
112 my $params;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
113 if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
114 return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
115 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
116 return();
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
117 }
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
118
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
119 sub ResolveParam {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
120 my ($this,$param,$inflate) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
121
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
122 if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
123 return $this->$1();
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
124 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
125 my $value;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
126 if ( my $rx = $inflate->{rx} ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
127 $value = $this->action->param($param,$rx);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
128 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
129 $value = $this->query->param($param);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
130 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
131
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
132 if (my $method = $inflate->{method}) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
133 $value = $this->$method($value);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
134 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
135 return $value;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
136 }
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
137 }
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
138
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
139 sub TransactionWrapper {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
140 my ($self,$method,$action,$methodInfo) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
141
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
142 my $unit = $self->new($action);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
143 my $handler = $methodInfo->{method};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
144 return $unit->$handler($unit->MakeParams($methodInfo));
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
145 }
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
146
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
147 sub FormWrapper {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
148 my ($self,$method,$action,$methodInfo) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
149
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
150 my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
151
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
152 my $process = $action->query->param('process') || 0;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
153 my $form = $methodInfo->{form}
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
154 || $action->query->param('form')
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
155 || $method;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
156
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
157 my %result;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
158
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
159 my $transform = IMPL::DOM::Transform::PostToDOM->new(
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
160 undef,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
161 $schema,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
162 $form
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
163 );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
164
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
165 my $handler = $methodInfo->{method};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
166
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
167 $result{formName} = $form;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
168 $result{formSchema} = $schema;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
169
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
170 if ($process) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
171 $result{formData} = $transform->Transform($action->query);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
172 $result{formErrors} = $transform->Errors->as_list;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
173 if ($transform->Errors->Count) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
174 $result{state} = STATE_INVALID;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
175 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
176 $result{state} = STATE_CORRECT;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
177 my $unit = $self->new($action,\%result);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
178
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
179 eval {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
180 $result{result} = $unit->$handler($unit->MakeParams($methodInfo));
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
181 };
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
182 if (my $err = $@) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
183 $result{state} = STATE_INVALID;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
184 if (eval { $err->isa(typeof IMPL::WrongDataException) } ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
185 $result{formErrors} = $err->Args;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
186 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
187 die $err;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
188 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
189 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
190 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
191 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
192 if (my $initMethod = $methodInfo->{init}) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
193 my $unit = $self->new($action,\%result);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
194 $result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
195 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
196 $result{formData} = $transform->Transform($action->query);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
197 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
198
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
199 # ignore errors for new forms
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
200 #$result{formErrors} = $transform->Errors->as_list;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
201 $result{state} = STATE_NEW;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
202 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
203
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
204 return \%result;
113
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
205 }
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
206
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
207 sub loadSchema {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
208 my ($self,$name) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
209
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
210 foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
211 return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
212 }
113
7b14e0122b79 Updated PostToDOM transformation
wizard
parents: 112
diff changeset
213
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
214 die new IMPL::Exception("A schema isn't found", $name);
170
b88b7fe60aa3 refactoring
sourcer
parents: 166
diff changeset
215 }
b88b7fe60aa3 refactoring
sourcer
parents: 166
diff changeset
216
b88b7fe60aa3 refactoring
sourcer
parents: 166
diff changeset
217 sub unitSchema {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
218 my ($self) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
219
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
220 my $class = ref $self || $self;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
221
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
222 my @parts = split(/:+/, $class);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
223
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
224 my $file = pop @parts;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
225 $file = "${file}.schema.xml";
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
226
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
227 foreach my $inc ( @schemaInc ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
228 my $path = File::Spec->catfile($inc,@parts,$file);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
229
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
230 return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
231 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
232
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
233 return undef;
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
234 }
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
235
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
236 sub discover {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
237 my ($this) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
238
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
239 my $methods = $this->class_data(CONTROLLER_METHODS);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
240
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
241 my $namespace = $this->unitNamespace;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
242 (my $module = typeof $this) =~ s/^$namespace//;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
243
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
244 my %smd = (
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
245 module => [grep $_, split /::/, $module ],
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
246 );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
247
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
248 while (my ($method,$info) = each %$methods) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
249 my %methodInfo = (
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
250 name => $method
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
251 );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
252 $methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY';
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
253 push @{$smd{methods}},\%methodInfo;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
254 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
255 return \%smd;
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
256 }
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
257
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
258 __PACKAGE__->transactions(
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
259 discover => undef
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
260 );
133
a07a66fd8d5c Added IMPL::Class::MethodInfo
wizard
parents: 132
diff changeset
261
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
262 1;
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
263
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
264 __END__
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
265
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
266 =pod
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
267
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
268 =head1 NAME
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
269
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
270 C<IMPL::Web::Application::ControllerUnit> - базовый класс для обработчика транзакций в модели контроллера.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
271
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
272 =head1 DESCRIPTION
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
273
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
274 Классы, наследуемые от данного класса называется пакетом транзакций. Часть методов в таком классе
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
275 объявляются как транзакции при помощи методов C<transaction>, C<form>.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
276
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
277 Перед выполнением транзакции создается экземпляр объекта, в рамках которого будет выполнена транзакция.
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
278 Для этого вызывается метод C<InvokeAction($method,$action)>, который создает/восстанавливает контекст
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
279 транзакции.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
280
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
281 Транзакции на данный момент делятся на простые и формы. Различные типы транзакций выполняются при помощи
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
282 различных оберток (C<TransactionWrapper> и C<FormWrapper>). Каждая обертка отвечает за конструирование
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
283 экземпляра объекта и вызов метода для выполнения транзакции, а также за возврат результата выполнения.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
284
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
285 =head2 Простые транзакции
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
286
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
287 Простые транзакции получаю только запрос, без предварительной обработки, и возвращенный результат напрямую
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
288 передается пользователю.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
289
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
290 =head2 Формы
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
291
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
292 При использовании форм запрос предварительно обрабатывается, для получения DOM документа с данными формы.
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
293 Для постороенния DOM документа используется схема. При этом становятся доступны дополнительные свойства
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
294 C<formData>, C<formSchema>, C<formErrors>.
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
295
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
296 Результат выполнения транзакции не возвращается наверх напрямую, а включается в структуру, которая
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
297 выглядит следующим образом
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
298
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
299 =begin code
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
300
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
301 {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
302 state => '{ new | correct | invalid }',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
303 result => $transactionResult,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
304 formData => $formDOM,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
305 formSchema => $formSchema,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
306 formErrors => @errors
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
307 }
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
308
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
309 =end code
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
310
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
311 =over
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
312
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
313 =item C<state>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
314
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
315 Состояние верификации формы.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
316
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
317 =over
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
318
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
319 =item C<new>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
320
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
321 Первоначальное содержимое формы, оно может быть некорректным, но это нормально.
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
322 В данном состоянии транзакция обычно не выполняется.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
323
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
324 =item C<correct>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
325
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
326 Данные формы корректны, транзакция выполнена, и ее результат доступен через поле C<result>
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
327
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
328 =item C<invalid>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
329
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
330 Содержимое формы не прошло верификацию, ошибки доступны через поле C<formErrors>. Транзакция
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
331 не выполнялась.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
332
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
333 =back
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
334
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
335 =item C<result>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
336
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
337 Результат выполнения транзакции, если конечно таковая выполнялась.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
338
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
339 =item C<formData>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
340
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
341 ДОМ документ с данными формами. Документ существует всегда, не зависимо от его корректности,
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
342 может быть использован для построения формы, уже заполненную параметрами.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
343
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
344 =item C<formSchema>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
345
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
346 Схема данных формы, может использоваться для построения динамических форм.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
347
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
348 =item C<formErrors>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
349
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
350 Ссылка на массив с ошибками при проверки формы.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
351
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
352 =back
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
353
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
354 =head1 MEMBERS
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
355
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
356 =over
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
357
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
358 =item C<[get] application>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
359
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
360 Объект приложения, которое обрабатывает запрос.
128
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 127
diff changeset
361
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
362 =item C<[get] query>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
363
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
364 Текущий запрос.
128
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 127
diff changeset
365
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
366 =item C<[get] response>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
367
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
368 Текущий ответ.
128
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 127
diff changeset
369
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
370 =item C<[get] formData>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
371
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
372 C<IMPL::DOM::Document> документ с данныим, если данный запрос является формой.
128
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 127
diff changeset
373
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
374 =item C<[get] formSchema>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
375
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
376 C<IMPL::DOM::Schema> документ со схемой формы данного запроса.
128
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 127
diff changeset
377
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
378 =item C<[get] formErrors>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
379
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
380 Ошибки верификации данных, если таковые были. Обычно при наличии ошибок в форме, транзакция
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
381 не выполняется, а эти ошибки передаются в ответ.
128
08753833173d Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents: 127
diff changeset
382
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
383 =item C<InvokeAction($method,$action)>
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
384
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
385 Конструирует контекст выполнения транзакции, может быть переопределен для конструирования контекста по
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
386 своим правилам.
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
387
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
388 =item C<TransactionWrapper($method,$action,$methodInfo)>
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
389
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
390 Обертка для конструирования простых транзакций, может быть переопределен для конструирования контекста по
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
391 своим правилам.
112
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
392
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
393 =item C<FormWrapper($method,$action,$methodInfo)>
0ed8e2541b1c Form processing mechanism
wizard
parents: 111
diff changeset
394
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
395 Обертка для конструирования форм, может быть переопределен для конструирования контекста по
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
396 своим правилам.
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
397
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
398 =item C<discover()>
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
399
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
400 Метод, опубликованный для вызова контроллером, возвращает описание методов в формате C<Simple Module Definition>.
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
401
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
402 =begin code
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
403
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
404 # SMD structure
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
405 {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
406 module => ['Foo','Bar'],
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
407 methods => [
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
408 {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
409 name => 'search',
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
410 parameters => ['text','limit'] #optional
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
411 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
412 ]
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
413 }
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
414
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
415 =end code
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
416
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
417 =back
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
418
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
419 =head1 EXAMPLE
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
420
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
421 =begin code
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
422
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
423 package MyBooksUnit;
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
424 use strict;
166
4267a2ac3d46 Added Class::Template,
wizard
parents: 160
diff changeset
425 use parent qw(IMPL::Web::Application::ControllerUnit);
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
426
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
427 __PACKAGE__->PassThroughArgs;
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
428
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
429 sub unitDataClass { 'My::Books' }
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
430
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
431 __PACKAGE__->transactions(
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
432 find => {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
433 parameters => [qw(author)]
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
434 },
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
435 info => {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
436 parameters => [qw(id)]
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
437 }
134
44977efed303 Significant performance optimizations
wizard
parents: 133
diff changeset
438 );
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
439 __PACKAGE__->forms(
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
440 create => 'books.create.xml'
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
441 );
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
442
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
443 sub find {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
444 my ($this,$author) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
445
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
446 return $this->ds->find({author => $author});
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
447 }
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
448
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
449 sub info {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
450 my ($this,$id) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
451
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
452 return $this->ds->find({id => $id});
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
453 }
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
454
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
455 sub create {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
456 my ($this) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
457
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
458 my %book = map {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
459 $_->nodeName, $_->nodeValue
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
460 } $this->formData->selectNodes([qw(author_id title year ISBN)]);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
461
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
462 return $this->ds->create(\%book);
111
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
463 }
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
464
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
465 =end code
6c25ea91c985 ControllerUnit concept
wizard
parents: 110
diff changeset
466
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 173
diff changeset
467 =cut