Mercurial > pub > Impl

comparison lib/IMPL/Web/Application/Action.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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