Mercurial > pub > Impl
diff Lib/IMPL/Web/Application.pm @ 229:47f77e6409f7
heavily reworked the resource model of the web application:
*some ResourcesContraact functionality moved to Resource
+Added CustomResource
*Corrected action handlers
author | sergey |
---|---|
date | Sat, 29 Sep 2012 02:34:47 +0400 |
parents | d6e2ea24af08 |
children | 6d8092d8ce1b |
line wrap: on
line diff
--- a/Lib/IMPL/Web/Application.pm Thu Sep 13 17:55:01 2012 +0400 +++ b/Lib/IMPL/Web/Application.pm Sat Sep 29 02:34:47 2012 +0400 @@ -8,147 +8,159 @@ use IMPL::declare { require => { - TAction => 'IMPL::Web::Application::Action', - TResponse => 'IMPL::Web::Application::Response', - TFactory => '-IMPL::Object::Factory' - }, - base => { - 'IMPL::Config' => '@_', + TAction => 'IMPL::Web::Application::Action', + HttpResponse => 'IMPL::Web::HttpResponse', + TFactory => '-IMPL::Object::Factory', + Exception => 'IMPL::Exception', + InvalidOperationException => 'IMPL::InvalidOperationException', + Loader => 'IMPL::Code::Loader' + }, + base => [ + 'IMPL::Config' => '@_', 'IMPL::Object::Singleton' => '@_' - } + ], + props => [ + actionFactory => PROP_ALL, + handlers => PROP_ALL | PROP_LIST, + security => PROP_ALL, + options => PROP_ALL, + fetchRequestMethod => PROP_ALL, + output => PROP_ALL + ] }; -BEGIN { - public property errorHandler => PROP_ALL; - public property actionFactory => PROP_ALL; - public property handlers => PROP_ALL | PROP_LIST; - public property responseCharset => PROP_ALL; - public property security => PROP_ALL; - public property options => PROP_ALL; - public property fetchRequestMethod => PROP_ALL; -} - +sub CTOR { + my ($this) = @_; -#TODO: remove -sub handlersQuery { - carp "handlersQuery is obsolete use handlers instead"; - goto &handlers; -} - + die IMPL::InvalidArgumentException->new( "handlers", + "At least one handler should be supplied" ) + unless $this->handlers->Count; -sub CTOR { - my ($this) = @_; - - die IMPL::InvalidArgumentException->new("handlers","At least one handler should be supplied") unless $this->handlers->Count; - - $this->actionFactory(TAction) unless $this->actionFactory; - $this->responseCharset('utf-8') unless $this->responseCharset; - $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod; - $this->errorHandler(\&defaultErrorHandler) unless $this->errorHandler; + $this->actionFactory(TAction) unless $this->actionFactory; + $this->fetchRequestMethod( \&defaultFetchRequest ) + unless $this->fetchRequestMethod; } sub Run { - my ($this) = @_; - - my $handler; - - $handler = _ChainHandler($_,$handler) foreach $this->handlers; - - while (my $query = $this->FetchRequest()) { - - my $action = $this->actionFactory->new( - query => $query, - application => $this, - ); - - eval { - $action->response->charset($this->responseCharset); - - $handler->($action); - - $action->response->Complete; - }; - if ($@) { - my $e = $@; - # we are expecting this method to be safe otherwise we can trust nothing in this wolrd - $this->errorHandler()->($this,$action,$e); - } - } + my ($this) = @_; + + my $handler; + + $handler = _ChainHandler( $_, $handler ) foreach $this->handlers; + + while ( my $query = $this->FetchRequest() ) { + + my $action = $this->actionFactory->new( + query => $query, + application => $this, + ); + + eval { + my $result = $handler->($action); + + die InvalidOperationException->new( +"Invalid handlers result. A reference to IMPL::Web::HttpResponse is expexted." + ) unless eval { $result->isa(HttpResponse) }; + + $result->PrintResponse( $this->output ); + }; + if ($@) { + my $e = $@; + + HttpResponse->InternalError( + type => 'text/plain', + charset => 'utf-8', + body => $e + )->PrintResponse( $this->output ); + + } + } } sub _ChainHandler { - my ($handler,$next) = @_; - - if (ref $handler eq 'CODE') { + my ( $handler, $next ) = @_; + + if ( ref $handler eq 'CODE' ) { return sub { my ($action) = @_; - return $handler->($action,$next); + return $handler->( $action, $next ); }; - } elsif (eval { $handler->can('Invoke') } ) { + } + elsif ( eval { $handler->can('Invoke') } ) { return sub { my ($action) = @_; - return $handler->Invoke($action,$next); + return $handler->Invoke( $action, $next ); }; - } elsif (eval{ $handler->isa(TFactory) }) { + } + elsif ( eval { $handler->isa(TFactory) } ) { return sub { my ($action) = @_; my $inst = $handler->new(); - return $inst->Invoke($action,$next); - } - } elsif ($handler and not ref $handler and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/) { + return $inst->Invoke( $action, $next ); + } + } + elsif ( $handler + and not ref $handler + and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/ ) + { my $class = $2; - if (not $1) { - my $mod = $class; - $mod =~ s/::/\//g; - require "$mod.pm"; - - die IMPL::InvalidArgumentException->("An invalid handler supplied",$handler) unless $class->can('Invoke'); + if ( not $1 ) { + Loader->safe->Require($class); + die IMPL::InvalidArgumentException->( + "An invalid handler supplied", $handler + ) unless $class->can('Invoke'); } - + return sub { my ($action) = @_; my $inst = $class->new(); - return $inst->Invoke($action,$next); + return $inst->Invoke( $action, $next ); }; - } else { - die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler); + } + else { + die new IMPL::InvalidArgumentException( "An invalid handler supplied", + $handler ); } } sub FetchRequest { - my ($this) = @_; - - if( ref $this->fetchRequestMethod eq 'CODE' ) { - return $this->fetchRequestMethod->($this); - } else { - die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod); - } + my ($this) = @_; + + if ( ref $this->fetchRequestMethod eq 'CODE' ) { + return $this->fetchRequestMethod->($this); + } + else { + die new IMPL::Exception( + "Unknown fetchRequestMethod type", + ref $this->fetchRequestMethod + ); + } } { - my $hasFetched = 0; + my $hasFetched = 0; - sub defaultFetchRequest { - my ($this) = @_; - return undef if $hasFetched; - $hasFetched = 1; - my $query = CGIWrapper->new(); - $query->charset($this->responseCharset); - return $query; - } + sub defaultFetchRequest { + my ($this) = @_; + return undef if $hasFetched; + $hasFetched = 1; + $this->output(*STDOUT); + my $query = CGIWrapper->new(); + return $query; + } } sub defaultErrorHandler { - my ($this,$action,$e) = @_; - warn $e; - if ( eval { $action->ReinitResponse(); 1; } ) { - $action->response->contentType('text/plain'); - $action->response->charset($this->responseCharset); - $action->response->status(500); - my $hout = $action->response->streamBody; - print $hout $e; - $action->response->Complete(); - } + my ( $this, $action, $e ) = @_; + warn $e; + if ( eval { $action->ReinitResponse(); 1; } ) { + $action->response->contentType('text/plain'); + $action->response->charset( $this->responseCharset ); + $action->response->status(500); + my $hout = $action->response->streamBody; + print $hout $e; + $action->response->Complete(); + } } package CGIWrapper; @@ -159,33 +171,38 @@ our $NO_DECODE = 0; sub param { - my $this = shift; - - return $this->SUPER::param(@_) if $NO_DECODE; - - if (wantarray) { - my @result = $this->SUPER::param(@_); - - return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result; - } else { - my $result = $this->SUPER::param(@_); - - return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC); - } + my $this = shift; + + return $this->SUPER::param(@_) if $NO_DECODE; + + if (wantarray) { + my @result = $this->SUPER::param(@_); + + return map Encode::is_utf8($_) + ? $_ + : Encode::decode( $this->charset, $_, Encode::LEAVE_SRC ), @result; + } + else { + my $result = $this->SUPER::param(@_); + + return Encode::is_utf8($result) + ? $result + : Encode::decode( $this->charset, $result, Encode::LEAVE_SRC ); + } } sub upload { - my $this = shift; - - local $NO_DECODE = 1; - my $oldCharset = $this->charset(); - $this->charset('ISO-8859-1'); - - my $fh = $this->SUPER::upload(@_); - - $this->charset($oldCharset); - return $fh; + my $this = shift; + + local $NO_DECODE = 1; + my $oldCharset = $this->charset(); + $this->charset('ISO-8859-1'); + + my $fh = $this->SUPER::upload(@_); + + $this->charset($oldCharset); + return $fh; } 1; @@ -194,166 +211,32 @@ =pod +=head1 NAME + +C<IMPL::Web::Application> Класс для создания экземпляров приложения + =head1 SYNOPSIS =begin code -require MyApp; +use IMPL::require { + App => 'IMPL::Web::Application' +}; -my $instance = spawn MyApp('app.config'); +my $instance = App->spawn(); # will use ./IMPL/Web/Application.xml as configuration -$instance->Run(); +$instance->Run; =end code =head1 DESCRIPTION -C< inherits IMPL::Config, IMPL::Object::Singleton > - -Зкземпляр приложения содержит в себе глобальные настройки, реализует контроллер запросов, -в качестве источника запросов используется CGI или иной совместимый модуль. - -Процесс обработки запроса состоит из следующих частей - -=over - -=item 1 +Создает экземпляр объекта, который получает и обрабатывает C<HTTP> запрос. +Приложение можно загрузить из C<xml> файла в котором описано состояние свойств, +для этого используется механизм C<IMPL::Serialization>. -Получение cgi запроса - -=item 2 - -Создание объекта C<IMPL::Web::Application::Action> - -=item 3 - -Формирование цепочки вызовов при помощи C<< IMPL::Web::Application::Action->ChainHandler >> - -=item 4 - -Выполнение запроса C<< IMPL::Web::Application::Action->Invoke >> +Приложение представлет собой модульную конструкцию, которая состоит из цепочки +обработчиков. Цепочка обработчиков вызывается снизу вверх, при этом каждый +обработчик самостоятельно рекурсивно вызывает следующий (более высокого уровня). =cut - -Также приложение поддерживает отложенное создание объектов, которые по первому обращению -к свойствам. Это реализовано в базовом классе C< IMPL::Configuration >. Для настройки -активаторов можно использовать свойство C<options>, в которое должен быть помещен хеш -со ссылками на активаторы, см. пример ниже C<CONFIGURATION>. - -=head2 CONFIGURATION - -Ниже приведен пример конфигурации приложения - -=begin code xml - -<?xml version="1.0" encoding="UTF-8"?> -<Application id='app' type="Test::Web::Application::Instance"> - - <!-- Begin custom properties --> - <name>Sample application</name> - <dataSource type='IMPL::Config::Activator' id='ds'> - <factory>IMPL::Object</factory> - <parameters type='HASH'> - <db>data</db> - <user>nobody</user> - </parameters> - </dataSource> - <securityMod type='IMPL::Config::Activator'> - <factory>IMPL::Object</factory> - <parameters type='HASH'> - <ds refid='ds'/> - </parameters> - </securityMod> - <!-- End custom properties --> - - <!-- direct access to the activators --> - <options type="HASH"> - <dataSource refid='ds'/> - </options> - - <!-- Set default output encoding, can be changed due query handling --> - <responseCharset>utf-8</responseCharset> - - <!-- Actions creation configuration --> - <actionFactory type="IMPL::Object::Factory"> - - <!-- Construct actions --> - <factory>IMPL::Web::Application::Action</factory> - <parameters type='HASH'> - - <!-- with special responseFactory --> - <responseFactory type='IMPL::Object::Factory'> - - <!-- Where resopnses have a special streamOut --> - <factory>IMPL::Web::Application::Response</factory> - <parameters type='HASH'> - - <!-- in memory dummy output instead of STDOUT --> - <streamOut>memory</streamOut> - - </parameters> - </responseFactory> - </parameters> - </actionFactory> - - <!-- Query processing chain --> - <handlersQuery type="IMPL::Object::List"> - <item type="IMPL::Web::QueryHandler::PageFormat"> - <templatesCharset>cp1251</templatesCharset> - </item> - </handlersQuery> -</Application> - -=end code xml - -=head1 MEMBERS - -=over - -=item C<[get,set] errorHandler> - -Обработчик который будет вызван в случае возникновения необработанной ошибки -в процессе работы приложения. После чего приложение корректно завершается. - -=item C<[get,set] actionFactory> - -Фабрика объектов, которая используется приложением, для создания объектов -типа C<IMPL::Web::Application::Action> при обработки C<CGI> запросов. - -=begin code - -my $action = $this->actionFactory->new( - query => $query, - application => $this, -); - -=end code - -=item C< [get,set] fetchRequestMethod > - -Метод получения CGI запроса. Возвращает C<CGI> объект следующего запроса, если -запросов больше нет, то возвращает C<undef>. По-умолчанию использует C<defaultFetchRequest>. - -Может быть как ссылкой на функцию, так и объектом типа C<IMPL::Web::Application::RequestFetcher>. - -=item C< [get,set,list] handlersQuery > - -Список обработчиков запросов, которые будут переданы созданному объекту-действию. - -=item C< [get,set] responseCharset> - -Кодировка ответа клиенту. - -=item C< [get,set] security > - -Объект C<IMPL::Web::Security>, для работы с инфраструктурой безопасности. - -=item C< [get,set] options > - -Обычно ссылка на хеш с настраиваемыми объектами, используется для возможности -програмной настройки активаторов, т.к. напрямую через свойства приложения получить -к ним доступ не получится. - -=back - -=cut