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