Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application/Action.pm @ 368:010ceafd0c5a
form metadata + tests
author | cin |
---|---|
date | Wed, 04 Dec 2013 17:31:53 +0400 |
parents | ec58c47edb52 |
children | 2287c72f303a |
rev | line source |
---|---|
52 | 1 package IMPL::Web::Application::Action; |
55 | 2 use strict; |
52 | 3 |
206 | 4 use Carp qw(carp); |
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
5 use URI; |
321 | 6 use JSON; |
238 | 7 |
339
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
8 use IMPL::lang; |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
9 use IMPL::Const qw(:prop); |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
10 use IMPL::Web::CGIWrapper(); |
238 | 11 use IMPL::declare { |
339
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
12 require => { |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
13 Disposable => '-IMPL::Object::Disposable' |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
14 }, |
238 | 15 base => [ |
16 'IMPL::Object' => undef, | |
339
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
17 'IMPL::Object::Autofill' => '@_', |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
18 'IMPL::Object::Disposable' => undef |
238 | 19 ], |
20 props => [ | |
324 | 21 application => PROP_RW, |
340 | 22 security => PROP_RW, |
244 | 23 query => PROP_RO, |
321 | 24 context => PROP_RW, |
25 _jsonData => PROP_RW, | |
238 | 26 ] |
27 }; | |
55 | 28 |
65 | 29 sub CTOR { |
194 | 30 my ($this) = @_; |
244 | 31 |
32 $this->context({}); | |
357 | 33 $this->security($this->application->CreateSecurity()); |
65 | 34 } |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
35 |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
36 sub cookie { |
194 | 37 my ($this,$name,$rx) = @_; |
38 | |
39 $this->_launder(scalar( $this->query->cookie($name) ), $rx ); | |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
40 } |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
41 |
320
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
42 sub header { |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
43 my ($this,$header) = @_; |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
44 |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
45 $this->query->https ? $this->query->https($header) : $this->query->http($header); |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
46 } |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
47 |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
48 sub isSecure { |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
49 shift->query->https ? 1 : 0; |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
50 } |
28eba7e0c592
*web application action: added method to access HTTP request header.
sergey
parents:
268
diff
changeset
|
51 |
323
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
322
diff
changeset
|
52 sub isJson { |
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
322
diff
changeset
|
53 return shift->contentType =~ m{^application/json} ? 1 : 0; |
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
322
diff
changeset
|
54 } |
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
322
diff
changeset
|
55 |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
56 sub param { |
194 | 57 my ($this,$name,$rx) = @_; |
58 | |
245 | 59 my $value; |
60 | |
61 if ( | |
62 $this->requestMethod eq 'GET' | |
63 or | |
321 | 64 $this->contentType eq 'multipart/form-data' |
245 | 65 or |
321 | 66 $this->contentType eq 'application/x-www-form-urlencoded' |
245 | 67 ) { |
68 $value = scalar( $this->query->param($name) ); | |
69 } else { | |
70 $value = scalar( $this->query->url_param($name) ); | |
71 } | |
72 | |
73 $this->_launder($value, $rx ); | |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
74 } |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
75 |
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
76 sub urlParam { |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
77 my ($this,$name,$rx) = @_; |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
78 |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
79 $this->_launder(scalar( $this->query->url_param($name) ), $rx); |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
80 } |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
81 |
322 | 82 sub urlParams { |
83 shift->query->url_param(); | |
84 } | |
85 | |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
86 sub rawData { |
321 | 87 my ($this, $decode) = @_; |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
88 |
321 | 89 local $IMPL::Web::CGIWrapper::NO_DECODE = $decode ? 0 : 1; |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
90 if ($this->requestMethod eq 'POST') { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
91 return $this->query->param('POSTDATA'); |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
92 } elsif($this->requestMethod eq 'PUT') { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
93 return $this->query->param('PUTDATA'); |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
94 } |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
95 } |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
96 |
321 | 97 sub jsonData { |
98 my ($this) = @_; | |
99 | |
323
b56b1ec33b59
minor changes to support JSON in transformation from a query to an object
sergey
parents:
322
diff
changeset
|
100 if ($this->isJson ) { |
321 | 101 my $data = $this->_jsonData; |
102 unless($data) { | |
103 $data = JSON->new()->decode($this->rawData('decode encoding')); | |
104 $this->_jsonData($data); | |
105 } | |
106 | |
107 return $data; | |
108 } | |
109 | |
110 return; | |
111 } | |
112 | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
113 sub requestMethod { |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
114 my ($this) = @_; |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
115 return $this->query->request_method; |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
116 } |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
117 |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
118 sub contentType { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
119 return shift->query->content_type(); |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
120 } |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
121 |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
122 sub pathInfo { |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
123 my ($this) = @_; |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
124 return $this->query->path_info; |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
125 } |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
126 |
238 | 127 sub baseUrl { |
128 my ($this) = @_; | |
129 | |
130 return $this->query->url(-base => 1); | |
131 } | |
132 | |
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
133 sub applicationUrl { |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
134 shift->application->baseUrl; |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
135 } |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
136 |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
137 sub applicationFullUrl { |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
138 my ($this) = @_; |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
139 |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
140 return URI->new_abs($this->application->baseUrl, $this->query->url(-base => 1)); |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
141 } |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
142 |
268
4abda21186cd
*refactoring IMPL::Web: added 'application' property to resources
cin
parents:
266
diff
changeset
|
143 # creates an url that contains server, schema and path parts |
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
144 sub CreateFullUrl { |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
145 my ($this,$path) = @_; |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
146 |
268
4abda21186cd
*refactoring IMPL::Web: added 'application' property to resources
cin
parents:
266
diff
changeset
|
147 return $path ? URI->new_abs($path,$this->applicationFullUrl) : $this->applicationFullUrl; |
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
148 } |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
149 |
268
4abda21186cd
*refactoring IMPL::Web: added 'application' property to resources
cin
parents:
266
diff
changeset
|
150 # creates an url that contains only a path part |
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
151 sub CreateAbsoluteUrl { |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
152 my ($this,$path) = @_; |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
153 |
268
4abda21186cd
*refactoring IMPL::Web: added 'application' property to resources
cin
parents:
266
diff
changeset
|
154 return $path ? URI->new_abs($path,$this->applicationUrl) : $this->applicationUrl; |
266
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
155 } |
89179bb8c388
*corrected TTView to handle plain (and undefined) values
cin
parents:
256
diff
changeset
|
156 |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
157 sub _launder { |
194 | 158 my ($this,$value,$rx) = @_; |
159 | |
160 if ( $value ) { | |
161 if ($rx) { | |
162 if ( my @result = ($value =~ m/$rx/) ) { | |
163 return @result > 1 ? \@result : $result[0]; | |
164 } else { | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
165 return; |
194 | 166 } |
167 } else { | |
168 return $value; | |
169 } | |
170 } else { | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
171 return; |
194 | 172 } |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
173 } |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
174 |
339
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
175 sub Dispose { |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
176 my ($this) = @_; |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
177 |
340 | 178 $this->security->Dispose() |
179 if $this->security and $this->security->can('Dispose'); | |
180 | |
339
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
181 $_->Dispose() foreach grep is($_,Disposable), values %{$this->context}; |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
182 |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
183 $this->next::method(); |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
184 } |
97628101b765
refactoring: application now holds a security object factory rather than a security object
cin
parents:
324
diff
changeset
|
185 |
52 | 186 1; |
187 | |
188 __END__ | |
189 | |
190 =pod | |
191 | |
67 | 192 =head1 NAME |
193 | |
180 | 194 C<IMPL::Web::Application::Action> - Обертка вокруг C<CGI> запроса. |
67 | 195 |
52 | 196 =head1 DESCRIPTION |
197 | |
67 | 198 C<[Infrastructure]> |
206 | 199 Свзяывет CGI запрос, приложение, орабатывающее его и ответ, который будет отправлен клиенту. |
52 | 200 |
67 | 201 =head1 MEMBERS |
202 | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
203 =head2 C<CTOR(%args)> |
67 | 204 |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
205 Инициализирует новый экземпляр. Именованными параметрами передаются значения |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
206 свойств. |
67 | 207 |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
206
diff
changeset
|
208 =head2 C< [get]application> |
67 | 209 |
180 | 210 Экземпляр приложения создавшего текущий объект |
67 | 211 |
212 =item C< [get] query > | |
213 | |
180 | 214 Экземпляр C<CGI> запроса |
67 | 215 |
216 =back | |
217 | |
218 | |
180 | 219 =cut |