Mercurial > pub > Impl
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 |
