annotate Lib/IMPL/Web/Application/ControllerUnit.pm @ 358:248f95c1762a

added simple XML Sax parser
author sergey
date Mon, 18 Nov 2013 01:25:35 +0400
parents 77df11605d3a
children
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
315
77df11605d3a code cleanup
cin
parents: 280
diff changeset
31 my %publicProps = map {$_->Name , 1} __PACKAGE__->GetMeta(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;
280
c6d0f889ef87 +IMPL::declare now supports meta attributes
cin
parents: 194
diff changeset
242 (my $module = typeof($this)) =~ s/^$namespace//;
194
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