changeset 58:a35b60b16a99

Configuration, late activation
author wizard
date Fri, 05 Mar 2010 20:14:45 +0300
parents bf59ee1cd506
children 0f3e369553bd
files Lib/IMPL/Config.pm Lib/IMPL/Config/Link.pm Lib/IMPL/Web/Application.pm Lib/IMPL/Web/Response.pm _test/Resources/app.xml
diffstat 5 files changed, 197 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Config.pm	Fri Mar 05 13:59:29 2010 +0300
+++ b/Lib/IMPL/Config.pm	Fri Mar 05 20:14:45 2010 +0300
@@ -83,6 +83,10 @@
     }
 }
 
+sub spawn {
+	goto &LoadXMLFile;
+}
+
 1;
 __END__
 
@@ -99,6 +103,7 @@
 BEGIN {
     public property SimpleString => prop_all;
     public property MyClass => prop_all;
+    public lazy property DataSource => prop_all, {type => 'App::DataSource', factory => sub {}}; 
 }
 
 sub CTOR {
@@ -108,6 +113,12 @@
     $this->MyClass(new IMPL::Config::Class(Type => MyClass)) unless $this->MyClass;
 }
 
+# in some script
+
+my $app = spawn App::Config('default.xml');
+
+$app->Run();
+
 =head1 DESCRIPTION
 
 Позволяет сохранить/загрузить конфигурацию. Также все классы конфигурации
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Config/Link.pm	Fri Mar 05 20:14:45 2010 +0300
@@ -0,0 +1,22 @@
+package IMPL::Config::Link;
+
+use strict;
+
+require IMPL::Exception;
+
+require Tie::Scalar;
+our @ISA = qw(Tie::StdScalar);
+
+sub FETCH {
+	return ${$_[0]} = ${$_[0]}->instance() if UNIVERSAL::isa(${$_[0]},'IMPL::Config::Activator');
+}
+
+sub restore {
+	my ($self,$data,$surrogate) = @_;
+	
+	my %args = @$data;
+	
+	die new IMPL::Exception('A target is required for the link') unless exists $args{target};
+	
+	return $self->new($args{target});
+}
\ No newline at end of file
--- a/Lib/IMPL/Web/Application.pm	Fri Mar 05 13:59:29 2010 +0300
+++ b/Lib/IMPL/Web/Application.pm	Fri Mar 05 20:14:45 2010 +0300
@@ -3,12 +3,17 @@
 use warnings;
 
 use base qw(IMPL::Object IMPL::Object::Singleton);
+
+require IMPL::Web::Application::Action;
+require IMPL::Web::Application::Response;
+
 use IMPL::Class::Property;
 use CGI;
 
 BEGIN {
     public property handlerError => prop_all;
     public property factoryAction => prop_all;
+    public property handlersQuery => prop_all;
 }
 
 # custom factory
@@ -21,8 +26,18 @@
 sub Run {
     my ($this) = @_;
     
-    while (my $request = $this->fetch_request()) {
-        my $response = new IMPL::Web::Application::Response(request => $request);
+    while (my $query = $this->FetchRequest()) {
+        my $response = new IMPL::Web::Application::Response(request => $query);
+        
+        my $action = new IMPL::Web::Application::Action(
+        	request => $query,
+        	response => $response,
+        	application => $this, 
+        ); 
+        
+        $action->ChainHandler($_) foreach $this->handlersQuery;
+        
+        $action->Invoke();
     }
 }
 
--- a/Lib/IMPL/Web/Response.pm	Fri Mar 05 13:59:29 2010 +0300
+++ b/Lib/IMPL/Web/Response.pm	Fri Mar 05 20:14:45 2010 +0300
@@ -7,22 +7,21 @@
 require CGI;
 require CGI::Cookie;
 
+use Carp;
 use IMPL::Class::Property;
 
-use HTTP::Response;
-
 BEGIN {
 	public property query => prop_get | owner_set; # cgi query
 	public property status => prop_all, { validator => \&_checkHeaderPrinted };
 	public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String
-	public property charset => prop_all, { validator => \&_checkHeaderPrinted };
+	public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted };
 	public property expires => prop_all, { validator => \&_checkHeaderPrinted };
 	public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
 	
-	public property buffered => prop_get | owner_set; # Boolean
+	public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean
 	public property streamOut => prop_get | owner_set; # stream
 	public property streamBody => {get => \&getStreamBody }; # stream
-	public property isHeaderPrinted => prop_all; # Boolean 
+	public property isHeaderPrinted => prop_get | owner_set; # Boolean 
 	
 	private property _bufferBody => prop_all;
 	private property _streamBody => prop_all;
@@ -33,18 +32,10 @@
 sub CTOR {
 	my ($this,%args) = @_;
 	
-	$this->query(CGI->new({})) unless $this->query;
+	$this->query(CGI->new($this->query() | {})) unless $this->query;
+	$this->charset($this->query->charset) unless $this->charset;
 	
-	if ($this->buffered) {
-		my $buffer = "";
-		$this->_bufferBody(\$buffer);
-		
-		open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
-		
-		$this->_streamBody($hBody); 
-	} else {
-		$this->_streamBody($this->streamOut);
-	}
+	$this->streamOut(*STDOUT) unless $this->streamOut;
 }
 
 sub _checkHeaderPrinted {
@@ -53,6 +44,18 @@
 	die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
 }
 
+sub _canChangeBuffer {
+	my ($this,$value) = @_;
+	
+	die new IMPL::InvalidOperationException() if $this->isHeaderPrinted or $this->_streamBody;
+}
+
+sub _charset {
+	my $this = shift;
+	
+	return $this->query->charset(@_);
+}
+
 sub _PrintHeader {
 	my ($this) = @_;
 	
@@ -62,7 +65,6 @@
 		my %opt;
 		
 		$opt{-type} = $this->contentType if $this->contentType;
-		$opt{-charset} = $this->charset if $this->charset;
 		$opt{-status} = $this->status if $this->status;
 		$opt{-expires} = $this->expires if $this->expires;
 		
@@ -80,14 +82,23 @@
 sub getStreamBody {
 	my ($this) = @_;
 	
-	return undef unless $this->_bodyStream;
+	return undef unless $this->streamOut;
 	
-	if ($this->buffered) {
-		return $this->_bodyStream;
-	} else {
-		$this->_PrintHeader();
-		return $this->_bodyStream;
+	unless ($this->_streamBody) {
+		if ($this->buffered) {
+			my $buffer = "";
+			$this->_bufferBody(\$buffer);
+				
+			open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
+				
+			$this->_streamBody($hBody);
+		} else {
+			$this->_PrintHeader();
+			$this->_streamBody($this->streamOut);
+		}
 	}
+		
+	return $this->_streamBody;
 }
 
 sub Complete {
@@ -113,6 +124,8 @@
 sub Discard {
 	my ($this) = @_;
 	
+	carp "Discarding sent response" if $this->isHeaderPrinted;
+	
 	$this->_streamBody(undef);
 	$this->_bufferBody(undef);
 	$this->streamOut(undef);
@@ -124,6 +137,94 @@
 
 =pod
 
+=head1 DESCRIPTION
 
+Ответ сервера на CGI запрос, позволяет сформировать основные свойства заголовка и тело запроса.
+
+Объект позволяет буфферизировать вывод в тело ответа, что позволяет отменить или изменить
+ответ в последний момент.
+
+Свойство C< isHeaderPrinted > можно использовать для определения были ли отправлены какие-нибудь
+данные клиенту. 
+
+=head1 PROPERTIES
+
+=head2 HTTP Header
+
+Свойства отвечающие за заголовок HTTP ответа. Эти своства могут быть изменены до тех пор пока
+не будет отправлен заголовок. В противном случае выдается исключение C< IMPL::InvalidOperationException >.
+
+=over
+
+=item C< query >
+
+CGI запрос, который используется для вывода данных, заголовка и пр. Существует всегда.
+
+=item C< status >
+
+Код ошибки HTTP. Например, '200 OK'. По умолчанию не установлен, при отправке клиенту бедт отправлен '200 ОК'.
+
+=item C< contentType >
+
+Тип MIME. По умолчанию не установлен, подразумивается 'text/html'.
+
+=item C< charset >
+
+Кодировка, синоним свойства query->charset.
+
+=item C< expires >
+
+Определяет время жизни контента, например '+10m'. По умолчанию не задано и не передается.
+
+=item C< cookies >
+
+Хеш массив с cookies, например C< { cart => ['foo','bar'], display => 'list' } >.
+
+=back
+
+=head2 Response behaviour
+
+Свойства отвечающие за поведение ответа.
+
+=over
+
+=item C< buffered >
+
+C< True > - то тело ответа пишется в буффер и будет отправлено при вызове метода C< Complete >,
+заголовок также будет отправлен после вызова метода C< Complete >. 
+
+C< False > - тело ответа пишется непосредственно в поток к клиенту, при этом заголовок
+будет отправлен при первом обращении к свойству C< streamBody >
+
+Это свойство можно менять до первого обращения к потоку для записи в тело ответа.
+
+=item C< streamOut >
+
+Стандартный вывод CGI приложения.
+
+=item C< streamBody >
+
+Поток для записи в тело ответа.
+
+=item C< isHeadPrinted >
+
+Признак того, что заголовок уже был отправлен клиенту.
+
+=back
+
+=head1 METHODS
+
+=over
+
+=item C< Complete >
+
+Завершает отправку ответа.
+
+=item C< Discard >
+
+Отменяет отправку ответа, при этом если часть данных (например, заголовок)
+уже была отправлена, выдает предупреждение в STDERR.
+
+=back
 
 =cut
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Resources/app.xml	Fri Mar 05 20:14:45 2010 +0300
@@ -0,0 +1,23 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<Application id='app' type="Test::Config::Application">
+	<name>Sample application</name>
+	<options type="HASH">
+		<One>value one</One>
+		<Two>value two</Two>
+	</options>
+	<dataSource type='IMPL::Config::Activator' id='ds'>
+		<type>Test::Config::DataSource</type>
+		<parameters type='HASH'>
+			<db>data</db>
+			<user>nobody</user>
+		</parameters>
+	</dataSource>
+	<securityMod type='IMPL::Config::Activator'>
+		<type>Test::Config::Security</type>
+		<parameters type='HASH'>
+			<ds type='IMPL::Config::Link'>
+				<target ref='ds'/>
+			</ds>
+		</paremeters>
+	</securityMod>
+</Application>
\ No newline at end of file