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