annotate Lib/IMPL/Web/Application/ControllerUnit.pm @ 170:b88b7fe60aa3

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