|
407
|
1 package IMPL::Web::Application::Action;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use Carp qw(carp);
|
|
|
5 use URI;
|
|
|
6 use JSON;
|
|
|
7
|
|
|
8 use IMPL::lang;
|
|
|
9 use IMPL::Const qw(:prop);
|
|
|
10 use IMPL::Web::CGIWrapper();
|
|
|
11 use IMPL::declare {
|
|
|
12 require => {
|
|
|
13 Disposable => '-IMPL::Object::Disposable',
|
|
|
14 HttpResponse => 'IMPL::Web::HttpResponse'
|
|
|
15 },
|
|
|
16 base => [
|
|
|
17 'IMPL::Object' => undef,
|
|
|
18 'IMPL::Object::Autofill' => '@_',
|
|
|
19 'IMPL::Object::Disposable' => undef
|
|
|
20 ],
|
|
|
21 props => [
|
|
|
22 application => PROP_RW,
|
|
|
23 security => PROP_RW,
|
|
|
24 query => PROP_RO,
|
|
|
25 context => PROP_RW,
|
|
|
26 _jsonData => PROP_RW,
|
|
|
27 ]
|
|
|
28 };
|
|
|
29
|
|
|
30 sub CTOR {
|
|
|
31 my ($this) = @_;
|
|
|
32
|
|
|
33 $this->context({});
|
|
|
34 $this->security($this->application->CreateSecurity());
|
|
|
35 }
|
|
|
36
|
|
|
37 sub cookie {
|
|
|
38 my ($this,$name,$rx) = @_;
|
|
|
39
|
|
|
40 $this->_launder(scalar( $this->query->cookie($name) ), $rx );
|
|
|
41 }
|
|
|
42
|
|
|
43 sub header {
|
|
|
44 my ($this,$header) = @_;
|
|
|
45
|
|
|
46 $this->query->https ? $this->query->https($header) : $this->query->http($header);
|
|
|
47 }
|
|
|
48
|
|
|
49 sub isSecure {
|
|
|
50 shift->query->https ? 1 : 0;
|
|
|
51 }
|
|
|
52
|
|
|
53 sub isJson {
|
|
|
54 return shift->contentType =~ m{^application/json} ? 1 : 0;
|
|
|
55 }
|
|
|
56
|
|
|
57 sub param {
|
|
|
58 my ($this,$name,$rx) = @_;
|
|
|
59
|
|
|
60 my $value;
|
|
|
61
|
|
|
62 if (
|
|
|
63 $this->requestMethod eq 'GET'
|
|
|
64 or
|
|
|
65 $this->contentType eq 'multipart/form-data'
|
|
|
66 or
|
|
|
67 $this->contentType eq 'application/x-www-form-urlencoded'
|
|
|
68 ) {
|
|
|
69 $value = scalar( $this->query->param($name) );
|
|
|
70 } else {
|
|
|
71 $value = scalar( $this->query->url_param($name) );
|
|
|
72 }
|
|
|
73
|
|
|
74 $this->_launder($value, $rx );
|
|
|
75 }
|
|
|
76
|
|
|
77 sub urlParam {
|
|
|
78 my ($this,$name,$rx) = @_;
|
|
|
79
|
|
|
80 $this->_launder(scalar( $this->query->url_param($name) ), $rx);
|
|
|
81 }
|
|
|
82
|
|
|
83 sub urlParams {
|
|
|
84 shift->query->url_param();
|
|
|
85 }
|
|
|
86
|
|
|
87 sub rawData {
|
|
|
88 my ($this, $decode) = @_;
|
|
|
89
|
|
|
90 local $IMPL::Web::CGIWrapper::NO_DECODE = $decode ? 0 : 1;
|
|
|
91 if ($this->requestMethod eq 'POST') {
|
|
|
92 return $this->query->param('POSTDATA');
|
|
|
93 } elsif($this->requestMethod eq 'PUT') {
|
|
|
94 return $this->query->param('PUTDATA');
|
|
|
95 }
|
|
|
96 }
|
|
|
97
|
|
|
98 sub jsonData {
|
|
|
99 my ($this) = @_;
|
|
|
100
|
|
|
101 if ($this->isJson ) {
|
|
|
102 my $data = $this->_jsonData;
|
|
|
103 unless($data) {
|
|
|
104 $data = JSON->new()->decode($this->rawData('decode encoding'));
|
|
|
105 $this->_jsonData($data);
|
|
|
106 }
|
|
|
107
|
|
|
108 return $data;
|
|
|
109 }
|
|
|
110
|
|
|
111 return;
|
|
|
112 }
|
|
|
113
|
|
|
114 sub requestMethod {
|
|
|
115 my ($this) = @_;
|
|
|
116 return $this->query->request_method;
|
|
|
117 }
|
|
|
118
|
|
|
119 sub contentType {
|
|
|
120 return shift->query->content_type();
|
|
|
121 }
|
|
|
122
|
|
|
123 sub pathInfo {
|
|
|
124 my ($this) = @_;
|
|
|
125 return $this->query->path_info;
|
|
|
126 }
|
|
|
127
|
|
|
128 sub baseUrl {
|
|
|
129 my ($this) = @_;
|
|
|
130
|
|
|
131 return $this->query->url(-base => 1);
|
|
|
132 }
|
|
|
133
|
|
|
134 sub applicationUrl {
|
|
|
135 shift->application->baseUrl;
|
|
|
136 }
|
|
|
137
|
|
|
138 sub applicationFullUrl {
|
|
|
139 my ($this) = @_;
|
|
|
140
|
|
|
141 return URI->new_abs($this->application->baseUrl, $this->query->url(-base => 1));
|
|
|
142 }
|
|
|
143
|
|
|
144 # creates an url that contains server, schema and path parts
|
|
|
145 sub CreateFullUrl {
|
|
|
146 my ($this,$path) = @_;
|
|
|
147
|
|
|
148 return $path ? URI->new_abs($path,$this->applicationFullUrl) : $this->applicationFullUrl;
|
|
|
149 }
|
|
|
150
|
|
|
151 # creates an url that contains only a path part
|
|
|
152 sub CreateAbsoluteUrl {
|
|
|
153 my ($this,$path) = @_;
|
|
|
154
|
|
|
155 return $path ? URI->new_abs($path,$this->applicationUrl) : $this->applicationUrl;
|
|
|
156 }
|
|
|
157
|
|
|
158 sub Redirect {
|
|
|
159 my ($this,$path) = @_;
|
|
|
160 return HttpResponse->Redirect(
|
|
|
161 location => $this->CreateFullUrl($path)
|
|
|
162 );
|
|
|
163 }
|
|
|
164
|
|
|
165 sub _launder {
|
|
|
166 my ($this,$value,$rx) = @_;
|
|
|
167
|
|
|
168 if ( $value ) {
|
|
|
169 if ($rx) {
|
|
|
170 if ( my @result = ($value =~ m/$rx/) ) {
|
|
|
171 return @result > 1 ? \@result : $result[0];
|
|
|
172 } else {
|
|
|
173 return;
|
|
|
174 }
|
|
|
175 } else {
|
|
|
176 return $value;
|
|
|
177 }
|
|
|
178 } else {
|
|
|
179 return;
|
|
|
180 }
|
|
|
181 }
|
|
|
182
|
|
|
183 sub Dispose {
|
|
|
184 my ($this) = @_;
|
|
|
185
|
|
|
186 $this->security->Dispose()
|
|
|
187 if $this->security and $this->security->can('Dispose');
|
|
|
188
|
|
|
189 $_->Dispose() foreach grep is($_,Disposable), values %{$this->context};
|
|
|
190
|
|
|
191 $this->next::method();
|
|
|
192 }
|
|
|
193
|
|
|
194 1;
|
|
|
195
|
|
|
196 __END__
|
|
|
197
|
|
|
198 =pod
|
|
|
199
|
|
|
200 =head1 NAME
|
|
|
201
|
|
|
202 C<IMPL::Web::Application::Action> - Обертка вокруг C<CGI> запроса.
|
|
|
203
|
|
|
204 =head1 DESCRIPTION
|
|
|
205
|
|
|
206 C<[Infrastructure]>
|
|
|
207 Свзяывет CGI запрос, приложение, орабатывающее его и ответ, который будет отправлен клиенту.
|
|
|
208
|
|
|
209 =head1 MEMBERS
|
|
|
210
|
|
|
211 =head2 C<CTOR(%args)>
|
|
|
212
|
|
|
213 Инициализирует новый экземпляр. Именованными параметрами передаются значения
|
|
|
214 свойств.
|
|
|
215
|
|
|
216 =head2 C< [get]application>
|
|
|
217
|
|
|
218 Экземпляр приложения создавшего текущий объект
|
|
|
219
|
|
|
220 =item C< [get] query >
|
|
|
221
|
|
|
222 Экземпляр C<CGI> запроса
|
|
|
223
|
|
|
224 =back
|
|
|
225
|
|
|
226
|
|
|
227 =cut
|
