Mercurial > pub > Impl
view Lib/IMPL/Web/Application/Action.pm @ 308:47a09a8dc23a
sync
author | sergey |
---|---|
date | Thu, 18 Apr 2013 20:06:05 +0400 |
parents | 4abda21186cd |
children | 28eba7e0c592 |
line wrap: on
line source
package IMPL::Web::Application::Action; use strict; use Carp qw(carp); use IMPL::Const qw(:prop); use IMPL::Web::CGIWrapper(); use URI; use IMPL::declare { base => [ 'IMPL::Object' => undef, 'IMPL::Object::Autofill' => '@_' ], props => [ application => PROP_RO, query => PROP_RO, context => PROP_RW ] }; sub CTOR { my ($this) = @_; $this->context({}); } sub cookie { my ($this,$name,$rx) = @_; $this->_launder(scalar( $this->query->cookie($name) ), $rx ); } sub param { my ($this,$name,$rx) = @_; my $value; if ( $this->requestMethod eq 'GET' or $this->query->content_type eq 'multipart/form-data' or $this->query->content_type eq 'application/x-www-form-urlencoded' ) { $value = scalar( $this->query->param($name) ); } else { $value = scalar( $this->query->url_param($name) ); } $this->_launder($value, $rx ); } sub urlParam { my ($this,$name,$rx) = @_; $this->_launder(scalar( $this->query->url_param($name) ), $rx); } sub rawData { my ($this) = @_; local $IMPL::Web::CGIWrapper::NO_DECODE = 1; if ($this->requestMethod eq 'POST') { return $this->query->param('POSTDATA'); } elsif($this->requestMethod eq 'PUT') { return $this->query->param('PUTDATA'); } } sub requestMethod { my ($this) = @_; return $this->query->request_method; } sub contentType { return shift->query->content_type(); } sub pathInfo { my ($this) = @_; return $this->query->path_info; } sub baseUrl { my ($this) = @_; return $this->query->url(-base => 1); } sub applicationUrl { shift->application->baseUrl; } sub applicationFullUrl { my ($this) = @_; return URI->new_abs($this->application->baseUrl, $this->query->url(-base => 1)); } # creates an url that contains server, schema and path parts sub CreateFullUrl { my ($this,$path) = @_; return $path ? URI->new_abs($path,$this->applicationFullUrl) : $this->applicationFullUrl; } # creates an url that contains only a path part sub CreateAbsoluteUrl { my ($this,$path) = @_; return $path ? URI->new_abs($path,$this->applicationUrl) : $this->applicationUrl; } sub _launder { my ($this,$value,$rx) = @_; if ( $value ) { if ($rx) { if ( my @result = ($value =~ m/$rx/) ) { return @result > 1 ? \@result : $result[0]; } else { return; } } else { return $value; } } else { return; } } 1; __END__ =pod =head1 NAME C<IMPL::Web::Application::Action> - Обертка вокруг C<CGI> запроса. =head1 DESCRIPTION C<[Infrastructure]> Свзяывет CGI запрос, приложение, орабатывающее его и ответ, который будет отправлен клиенту. =head1 MEMBERS =head2 C<CTOR(%args)> Инициализирует новый экземпляр. Именованными параметрами передаются значения свойств. =head2 C< [get]application> Экземпляр приложения создавшего текущий объект =item C< [get] query > Экземпляр C<CGI> запроса =back =cut