diff Lib/IMPL/Web/Response.pm @ 58:a35b60b16a99

Configuration, late activation
author wizard
date Fri, 05 Mar 2010 20:14:45 +0300
parents bf59ee1cd506
children
line wrap: on
line diff
--- 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