Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application/ControllerUnit.pm @ 194:4d0e1962161c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents d1676be8afcc
children c6d0f889ef87
comparison
equal deleted inserted replaced
193:8e8401c0aea4 194:4d0e1962161c
8 use Class::Inspector; 8 use Class::Inspector;
9 use File::Spec; 9 use File::Spec;
10 use Sub::Name; 10 use Sub::Name;
11 11
12 use constant { 12 use constant {
13 CONTROLLER_METHODS => 'controller_methods', 13 CONTROLLER_METHODS => 'controller_methods',
14 STATE_CORRECT => 'correct', 14 STATE_CORRECT => 'correct',
15 STATE_NEW => 'new', 15 STATE_NEW => 'new',
16 STATE_INVALID => 'invalid', 16 STATE_INVALID => 'invalid',
17 TTYPE_FORM => 'form', 17 TTYPE_FORM => 'form',
18 TTYPE_TRANS => 'tran' 18 TTYPE_TRANS => 'tran'
19 }; 19 };
20 20
21 BEGIN { 21 BEGIN {
22 public property action => prop_get | owner_set; 22 public property action => prop_get | owner_set;
23 public property application => prop_get | owner_set; 23 public property application => prop_get | owner_set;
24 public property query => prop_get | owner_set; 24 public property query => prop_get | owner_set;
25 public property response => prop_get | owner_set; 25 public property response => prop_get | owner_set;
26 public property formData => prop_get | owner_set; 26 public property formData => prop_get | owner_set;
27 public property formSchema => prop_get | owner_set; 27 public property formSchema => prop_get | owner_set;
28 public property formErrors => prop_get | owner_set; 28 public property formErrors => prop_get | owner_set;
29 } 29 }
30 30
31 my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo); 31 my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo);
32 32
33 __PACKAGE__->class_data(CONTROLLER_METHODS,{}); 33 __PACKAGE__->class_data(CONTROLLER_METHODS,{});
34 34
35 our @schemaInc; 35 our @schemaInc;
36 36
37 sub CTOR { 37 sub CTOR {
38 my ($this,$action,$args) = @_; 38 my ($this,$action,$args) = @_;
39 39
40 $this->action($action); 40 $this->action($action);
41 $this->application($action->application); 41 $this->application($action->application);
42 $this->query($action->query); 42 $this->query($action->query);
43 $this->response($action->response); 43 $this->response($action->response);
44 44
45 $this->$_($args->{$_}) foreach qw(formData formSchema formErrors); 45 $this->$_($args->{$_}) foreach qw(formData formSchema formErrors);
46 } 46 }
47 47
48 sub unitNamespace() { 48 sub unitNamespace() {
49 "" 49 ""
50 } 50 }
51 51
52 sub transactions { 52 sub transactions {
53 my ($self,%methods) = @_; 53 my ($self,%methods) = @_;
54 54
55 while (my ($method,$info) = each %methods) { 55 while (my ($method,$info) = each %methods) {
56 if ($info and ref $info ne 'HASH') { 56 if ($info and ref $info ne 'HASH') {
57 warn "Bad transaction $method description"; 57 warn "Bad transaction $method description";
58 $info = {}; 58 $info = {};
59 } 59 }
60 60
61 $info->{wrapper} = 'TransactionWrapper'; 61 $info->{wrapper} = 'TransactionWrapper';
62 $info->{method} ||= $method; 62 $info->{method} ||= $method;
63 $info->{context}{transactionType} = TTYPE_TRANS; 63 $info->{context}{transactionType} = TTYPE_TRANS;
64 $self->class_data(CONTROLLER_METHODS)->{$method} = $info; 64 $self->class_data(CONTROLLER_METHODS)->{$method} = $info;
65 } 65 }
66 } 66 }
67 67
68 sub forms { 68 sub forms {
69 my ($self,%forms) = @_; 69 my ($self,%forms) = @_;
70 70
71 while ( my ($method,$info) = each %forms ) { 71 while ( my ($method,$info) = each %forms ) {
72 die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method); 72 die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method);
73 if ( not ref $info ) { 73 if ( not ref $info ) {
74 $self->class_data(CONTROLLER_METHODS)->{$method} = { 74 $self->class_data(CONTROLLER_METHODS)->{$method} = {
75 wrapper => 'FormWrapper', 75 wrapper => 'FormWrapper',
76 schema => $info, 76 schema => $info,
77 method => $method, 77 method => $method,
78 context => { transactionType => TTYPE_FORM } 78 context => { transactionType => TTYPE_FORM }
79 }; 79 };
80 } elsif (ref $info eq 'HASH') { 80 } elsif (ref $info eq 'HASH') {
81 $info->{wrapper} = 'FormWrapper'; 81 $info->{wrapper} = 'FormWrapper';
82 $info->{method} ||= $method; 82 $info->{method} ||= $method;
83 $info->{context}{transactionType} = TTYPE_FORM; 83 $info->{context}{transactionType} = TTYPE_FORM;
84 84
85 $self->class_data(CONTROLLER_METHODS)->{$method} = $info; 85 $self->class_data(CONTROLLER_METHODS)->{$method} = $info;
86 } else { 86 } else {
87 die new IMPL::Exception("Unsupported method information",$self,$method); 87 die new IMPL::Exception("Unsupported method information",$self,$method);
88 } 88 }
89 } 89 }
90 } 90 }
91 91
92 sub InvokeAction { 92 sub InvokeAction {
93 my ($self,$method,$action) = @_; 93 my ($self,$method,$action) = @_;
94 94
95 if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) { 95 if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) {
96 if (my $ctx = $methodInfo->{context}) { 96 if (my $ctx = $methodInfo->{context}) {
97 $action->context->{$_} = $ctx->{$_} foreach keys %$ctx; 97 $action->context->{$_} = $ctx->{$_} foreach keys %$ctx;
98 } 98 }
99 if (my $wrapper = $methodInfo->{wrapper}) { 99 if (my $wrapper = $methodInfo->{wrapper}) {
100 return $self->$wrapper($method,$action,$methodInfo); 100 return $self->$wrapper($method,$action,$methodInfo);
101 } else { 101 } else {
102 return $self->TransactionWrapper($method,$action,$methodInfo); 102 return $self->TransactionWrapper($method,$action,$methodInfo);
103 } 103 }
104 } else { 104 } else {
105 die new IMPL::InvalidOperationException("Invalid method call",$self,$method); 105 die new IMPL::InvalidOperationException("Invalid method call",$self,$method);
106 } 106 }
107 } 107 }
108 108
109 sub MakeParams { 109 sub MakeParams {
110 my ($this,$methodInfo) = @_; 110 my ($this,$methodInfo) = @_;
111 111
112 my $params; 112 my $params;
113 if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') { 113 if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') {
114 return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params; 114 return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params;
115 } 115 }
116 return(); 116 return();
117 } 117 }
118 118
119 sub ResolveParam { 119 sub ResolveParam {
120 my ($this,$param,$inflate) = @_; 120 my ($this,$param,$inflate) = @_;
121 121
122 if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) { 122 if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) {
123 return $this->$1(); 123 return $this->$1();
124 } else { 124 } else {
125 my $value; 125 my $value;
126 if ( my $rx = $inflate->{rx} ) { 126 if ( my $rx = $inflate->{rx} ) {
127 $value = $this->action->param($param,$rx); 127 $value = $this->action->param($param,$rx);
128 } else { 128 } else {
129 $value = $this->query->param($param); 129 $value = $this->query->param($param);
130 } 130 }
131 131
132 if (my $method = $inflate->{method}) { 132 if (my $method = $inflate->{method}) {
133 $value = $this->$method($value); 133 $value = $this->$method($value);
134 } 134 }
135 return $value; 135 return $value;
136 } 136 }
137 } 137 }
138 138
139 sub TransactionWrapper { 139 sub TransactionWrapper {
140 my ($self,$method,$action,$methodInfo) = @_; 140 my ($self,$method,$action,$methodInfo) = @_;
141 141
142 my $unit = $self->new($action); 142 my $unit = $self->new($action);
143 my $handler = $methodInfo->{method}; 143 my $handler = $methodInfo->{method};
144 return $unit->$handler($unit->MakeParams($methodInfo)); 144 return $unit->$handler($unit->MakeParams($methodInfo));
145 } 145 }
146 146
147 sub FormWrapper { 147 sub FormWrapper {
148 my ($self,$method,$action,$methodInfo) = @_; 148 my ($self,$method,$action,$methodInfo) = @_;
149 149
150 my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema; 150 my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema;
151 151
152 my $process = $action->query->param('process') || 0; 152 my $process = $action->query->param('process') || 0;
153 my $form = $methodInfo->{form} 153 my $form = $methodInfo->{form}
154 || $action->query->param('form') 154 || $action->query->param('form')
155 || $method; 155 || $method;
156 156
157 my %result; 157 my %result;
158 158
159 my $transform = IMPL::DOM::Transform::PostToDOM->new( 159 my $transform = IMPL::DOM::Transform::PostToDOM->new(
160 undef, 160 undef,
161 $schema, 161 $schema,
162 $form 162 $form
163 ); 163 );
164 164
165 my $handler = $methodInfo->{method}; 165 my $handler = $methodInfo->{method};
166 166
167 $result{formName} = $form; 167 $result{formName} = $form;
168 $result{formSchema} = $schema; 168 $result{formSchema} = $schema;
169 169
170 if ($process) { 170 if ($process) {
171 $result{formData} = $transform->Transform($action->query); 171 $result{formData} = $transform->Transform($action->query);
172 $result{formErrors} = $transform->Errors->as_list; 172 $result{formErrors} = $transform->Errors->as_list;
173 if ($transform->Errors->Count) { 173 if ($transform->Errors->Count) {
174 $result{state} = STATE_INVALID; 174 $result{state} = STATE_INVALID;
175 } else { 175 } else {
176 $result{state} = STATE_CORRECT; 176 $result{state} = STATE_CORRECT;
177 my $unit = $self->new($action,\%result); 177 my $unit = $self->new($action,\%result);
178 178
179 eval { 179 eval {
180 $result{result} = $unit->$handler($unit->MakeParams($methodInfo)); 180 $result{result} = $unit->$handler($unit->MakeParams($methodInfo));
181 }; 181 };
182 if (my $err = $@) { 182 if (my $err = $@) {
183 $result{state} = STATE_INVALID; 183 $result{state} = STATE_INVALID;
184 if (eval { $err->isa(typeof IMPL::WrongDataException) } ) { 184 if (eval { $err->isa(typeof IMPL::WrongDataException) } ) {
185 $result{formErrors} = $err->Args; 185 $result{formErrors} = $err->Args;
186 } else { 186 } else {
187 die $err; 187 die $err;
188 } 188 }
189 } 189 }
190 } 190 }
191 } else { 191 } else {
192 if (my $initMethod = $methodInfo->{init}) { 192 if (my $initMethod = $methodInfo->{init}) {
193 my $unit = $self->new($action,\%result); 193 my $unit = $self->new($action,\%result);
194 $result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) ); 194 $result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) );
195 } else { 195 } else {
196 $result{formData} = $transform->Transform($action->query); 196 $result{formData} = $transform->Transform($action->query);
197 } 197 }
198 198
199 # ignore errors for new forms 199 # ignore errors for new forms
200 #$result{formErrors} = $transform->Errors->as_list; 200 #$result{formErrors} = $transform->Errors->as_list;
201 $result{state} = STATE_NEW; 201 $result{state} = STATE_NEW;
202 } 202 }
203 203
204 return \%result; 204 return \%result;
205 } 205 }
206 206
207 sub loadSchema { 207 sub loadSchema {
208 my ($self,$name) = @_; 208 my ($self,$name) = @_;
209 209
210 foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) { 210 foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) {
211 return IMPL::DOM::Schema->LoadSchema($path) if -f $path; 211 return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
212 } 212 }
213 213
214 die new IMPL::Exception("A schema isn't found", $name); 214 die new IMPL::Exception("A schema isn't found", $name);
215 } 215 }
216 216
217 sub unitSchema { 217 sub unitSchema {
218 my ($self) = @_; 218 my ($self) = @_;
219 219
220 my $class = ref $self || $self; 220 my $class = ref $self || $self;
221 221
222 my @parts = split(/:+/, $class); 222 my @parts = split(/:+/, $class);
223 223
224 my $file = pop @parts; 224 my $file = pop @parts;
225 $file = "${file}.schema.xml"; 225 $file = "${file}.schema.xml";
226 226
227 foreach my $inc ( @schemaInc ) { 227 foreach my $inc ( @schemaInc ) {
228 my $path = File::Spec->catfile($inc,@parts,$file); 228 my $path = File::Spec->catfile($inc,@parts,$file);
229 229
230 return IMPL::DOM::Schema->LoadSchema($path) if -f $path; 230 return IMPL::DOM::Schema->LoadSchema($path) if -f $path;
231 } 231 }
232 232
233 return undef; 233 return undef;
234 } 234 }
235 235
236 sub discover { 236 sub discover {
237 my ($this) = @_; 237 my ($this) = @_;
238 238
239 my $methods = $this->class_data(CONTROLLER_METHODS); 239 my $methods = $this->class_data(CONTROLLER_METHODS);
240 240
241 my $namespace = $this->unitNamespace; 241 my $namespace = $this->unitNamespace;
242 (my $module = typeof $this) =~ s/^$namespace//; 242 (my $module = typeof $this) =~ s/^$namespace//;
243 243
244 my %smd = ( 244 my %smd = (
245 module => [grep $_, split /::/, $module ], 245 module => [grep $_, split /::/, $module ],
246 ); 246 );
247 247
248 while (my ($method,$info) = each %$methods) { 248 while (my ($method,$info) = each %$methods) {
249 my %methodInfo = ( 249 my %methodInfo = (
250 name => $method 250 name => $method
251 ); 251 );
252 $methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY'; 252 $methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY';
253 push @{$smd{methods}},\%methodInfo; 253 push @{$smd{methods}},\%methodInfo;
254 } 254 }
255 return \%smd; 255 return \%smd;
256 } 256 }
257 257
258 __PACKAGE__->transactions( 258 __PACKAGE__->transactions(
259 discover => undef 259 discover => undef
260 ); 260 );
261 261
262 1; 262 1;
263 263
264 __END__ 264 __END__
297 выглядит следующим образом 297 выглядит следующим образом
298 298
299 =begin code 299 =begin code
300 300
301 { 301 {
302 state => '{ new | correct | invalid }', 302 state => '{ new | correct | invalid }',
303 result => $transactionResult, 303 result => $transactionResult,
304 formData => $formDOM, 304 formData => $formDOM,
305 formSchema => $formSchema, 305 formSchema => $formSchema,
306 formErrors => @errors 306 formErrors => @errors
307 } 307 }
308 308
309 =end code 309 =end code
310 310
311 =over 311 =over
401 401
402 =begin code 402 =begin code
403 403
404 # SMD structure 404 # SMD structure
405 { 405 {
406 module => ['Foo','Bar'], 406 module => ['Foo','Bar'],
407 methods => [ 407 methods => [
408 { 408 {
409 name => 'search', 409 name => 'search',
410 parameters => ['text','limit'] #optional 410 parameters => ['text','limit'] #optional
411 } 411 }
412 ] 412 ]
413 } 413 }
414 414
415 =end code 415 =end code
416 416
417 =back 417 =back
427 __PACKAGE__->PassThroughArgs; 427 __PACKAGE__->PassThroughArgs;
428 428
429 sub unitDataClass { 'My::Books' } 429 sub unitDataClass { 'My::Books' }
430 430
431 __PACKAGE__->transactions( 431 __PACKAGE__->transactions(
432 find => { 432 find => {
433 parameters => [qw(author)] 433 parameters => [qw(author)]
434 }, 434 },
435 info => { 435 info => {
436 parameters => [qw(id)] 436 parameters => [qw(id)]
437 } 437 }
438 ); 438 );
439 __PACKAGE__->forms( 439 __PACKAGE__->forms(
440 create => 'books.create.xml' 440 create => 'books.create.xml'
441 ); 441 );
442 442
443 sub find { 443 sub find {
444 my ($this,$author) = @_; 444 my ($this,$author) = @_;
445 445
446 return $this->ds->find({author => $author}); 446 return $this->ds->find({author => $author});
447 } 447 }
448 448
449 sub info { 449 sub info {
450 my ($this,$id) = @_; 450 my ($this,$id) = @_;
451 451
452 return $this->ds->find({id => $id}); 452 return $this->ds->find({id => $id});
453 } 453 }
454 454
455 sub create { 455 sub create {
456 my ($this) = @_; 456 my ($this) = @_;
457 457
458 my %book = map { 458 my %book = map {
459 $_->nodeName, $_->nodeValue 459 $_->nodeName, $_->nodeValue
460 } $this->formData->selectNodes([qw(author_id title year ISBN)]); 460 } $this->formData->selectNodes([qw(author_id title year ISBN)]);
461 461
462 return $this->ds->create(\%book); 462 return $this->ds->create(\%book);
463 } 463 }
464 464
465 =end code 465 =end code
466 466
467 =cut 467 =cut