comparison Lib/IMPL/Web/Application.pm @ 244:a02b110da931

refactoring fixed binding to CGI query parameters with multiple values
author sergey
date Mon, 22 Oct 2012 04:09:27 +0400
parents fe9d62d9054d
children 546957c50a36
comparison
equal deleted inserted replaced
243:cd2b1f121029 244:a02b110da931
6 use Carp qw(carp); 6 use Carp qw(carp);
7 use IMPL::Const qw(:prop); 7 use IMPL::Const qw(:prop);
8 8
9 use IMPL::declare { 9 use IMPL::declare {
10 require => { 10 require => {
11 Locator => 'IMPL::Web::AutoLocator',
11 TAction => 'IMPL::Web::Application::Action', 12 TAction => 'IMPL::Web::Application::Action',
12 HttpResponse => 'IMPL::Web::HttpResponse', 13 HttpResponse => 'IMPL::Web::HttpResponse',
13 TFactory => '-IMPL::Object::Factory', 14 TFactory => '-IMPL::Object::Factory',
14 Exception => 'IMPL::Exception', 15 Exception => 'IMPL::Exception',
15 InvalidOperationException => '-IMPL::InvalidOperationException', 16 InvalidOperationException => '-IMPL::InvalidOperationException',
18 base => [ 19 base => [
19 'IMPL::Config' => '@_', 20 'IMPL::Config' => '@_',
20 'IMPL::Object::Singleton' => '@_' 21 'IMPL::Object::Singleton' => '@_'
21 ], 22 ],
22 props => [ 23 props => [
24 baseUrl => PROP_RW,
23 actionFactory => PROP_RW, 25 actionFactory => PROP_RW,
24 handlers => PROP_RW | PROP_LIST, 26 handlers => PROP_RW | PROP_LIST,
25 security => PROP_RW, 27 security => PROP_RW,
26 options => PROP_RW, 28 options => PROP_RW,
27 requestCharset => PROP_RW, 29 requestCharset => PROP_RW,
28 fetchRequestMethod => PROP_RW, 30 output => PROP_RW,
29 output => PROP_RW 31 location => PROP_RO
30 ] 32 ]
31 }; 33 };
32 34
33 sub CTOR { 35 sub CTOR {
34 my ($this) = @_; 36 my ($this) = @_;
35 37
36 die IMPL::InvalidArgumentException->new( "handlers", 38 die IMPL::InvalidArgumentException->new( "handlers",
37 "At least one handler should be supplied" ) 39 "At least one handler should be supplied" )
38 unless $this->handlers->Count; 40 unless $this->handlers->Count;
39 41
42 $this->baseUrl('/') unless $this->baseUrl;
43
40 $this->actionFactory(TAction) unless $this->actionFactory; 44 $this->actionFactory(TAction) unless $this->actionFactory;
41 $this->fetchRequestMethod( \&defaultFetchRequest ) 45 $this->location(Locator->new(base => $this->baseUrl));
42 unless $this->fetchRequestMethod;
43 } 46 }
44 47
45 sub Run { 48 sub Run {
46 my ($this) = @_; 49 my ($this) = @_;
47 50
123 $handler ); 126 $handler );
124 } 127 }
125 } 128 }
126 129
127 sub FetchRequest { 130 sub FetchRequest {
128 my ($this) = @_; 131
129 132 return;
130 if ( ref $this->fetchRequestMethod eq 'CODE' ) {
131 return $this->fetchRequestMethod->($this);
132 }
133 else {
134 die new IMPL::Exception(
135 "Unknown fetchRequestMethod type",
136 ref $this->fetchRequestMethod
137 );
138 }
139 }
140
141 {
142 my $hasFetched = 0;
143
144 sub defaultFetchRequest {
145 my ($this) = @_;
146 return undef if $hasFetched;
147 $hasFetched = 1;
148 $this->output(*STDOUT);
149 my $query = CGIWrapper->new();
150 $query->charset($this->requestCharset) if $this->requestCharset;
151 return $query;
152 }
153 }
154
155 sub defaultErrorHandler {
156 my ( $this, $action, $e ) = @_;
157 warn $e;
158 if ( eval { $action->ReinitResponse(); 1; } ) {
159 $action->response->contentType('text/plain');
160 $action->response->charset( $this->responseCharset );
161 $action->response->status(500);
162 my $hout = $action->response->streamBody;
163 print $hout $e;
164 $action->response->Complete();
165 }
166 }
167
168 package CGIWrapper;
169 use parent qw(CGI);
170
171 use Encode;
172
173 our $NO_DECODE = 0;
174
175 sub param {
176 my $this = shift;
177
178 return $this->SUPER::param(@_) if $NO_DECODE;
179
180 if (wantarray) {
181 my @result = $this->SUPER::param(@_);
182
183 return map Encode::is_utf8($_)
184 ? $_
185 : Encode::decode( $this->charset, $_, Encode::LEAVE_SRC ), @result;
186 }
187 else {
188 my $result = $this->SUPER::param(@_);
189
190 return Encode::is_utf8($result)
191 ? $result
192 : Encode::decode( $this->charset, $result, Encode::LEAVE_SRC );
193 }
194
195 }
196
197 sub upload {
198 my $this = shift;
199
200 local $NO_DECODE = 1;
201 my $oldCharset = $this->charset();
202 $this->charset('ISO-8859-1');
203
204 my $fh = $this->SUPER::upload(@_);
205
206 $this->charset($oldCharset);
207 return $fh;
208 } 133 }
209 134
210 1; 135 1;
211 136
212 __END__ 137 __END__
213 138
214 =pod 139 =pod
215 140
216 =head1 NAME 141 =head1 NAME
217 142
218 C<IMPL::Web::Application> Класс для создания экземпляров приложения 143 C<IMPL::Web::Application> Базовай класс для создания экземпляров приложения
219 144
220 =head1 SYNOPSIS 145 =head1 SYNOPSIS
221 146
222 =begin code 147 =begin code
223 148
239 164
240 Приложение представлет собой модульную конструкцию, которая состоит из цепочки 165 Приложение представлет собой модульную конструкцию, которая состоит из цепочки
241 обработчиков. Цепочка обработчиков вызывается снизу вверх, при этом каждый 166 обработчиков. Цепочка обработчиков вызывается снизу вверх, при этом каждый
242 обработчик самостоятельно рекурсивно вызывает следующий (более высокого уровня). 167 обработчик самостоятельно рекурсивно вызывает следующий (более высокого уровня).
243 168
169 См. также C<IMPL::Web::CGIApplication>
170
244 =cut 171 =cut