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 |