changeset 57:bf59ee1cd506

Web application main class functionality
author wizard
date Fri, 05 Mar 2010 13:59:29 +0300
parents 117b6956d5a5
children a35b60b16a99
files Lib/IMPL/Web/Application.pm Lib/IMPL/Web/Application/Action.pm Lib/IMPL/Web/Application/Session.pm Lib/IMPL/Web/Response.pm
diffstat 4 files changed, 194 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Web/Application.pm	Thu Mar 04 15:46:17 2010 +0300
+++ b/Lib/IMPL/Web/Application.pm	Fri Mar 05 13:59:29 2010 +0300
@@ -4,9 +4,11 @@
 
 use base qw(IMPL::Object IMPL::Object::Singleton);
 use IMPL::Class::Property;
+use CGI;
 
 BEGIN {
     public property handlerError => prop_all;
+    public property factoryAction => prop_all;
 }
 
 # custom factory
@@ -20,11 +22,20 @@
     my ($this) = @_;
     
     while (my $request = $this->fetch_request()) {
-        my $action = $this->prepare_action($request);
-        $action->invoke($request);
+        my $response = new IMPL::Web::Application::Response(request => $request);
     }
 }
 
+{
+	my $hasFetched = 0;
+
+	sub FetchRequest {
+		return undef if $hasFetched;
+		$hasFetched = 1;
+		return CGI->new();
+	}
+}
+
 1;
 
 __END__
--- a/Lib/IMPL/Web/Application/Action.pm	Thu Mar 04 15:46:17 2010 +0300
+++ b/Lib/IMPL/Web/Application/Action.pm	Fri Mar 05 13:59:29 2010 +0300
@@ -56,18 +56,16 @@
 
 =head1 DESCRIPTION
 
-Определяет порядок выполнения запроса, форматирует результат, инициализирует контекст.
+Определяет порядок выполнения запроса.
 
-Объект создается обработчиком запросов, таким как C<IMPL::Web::Application::UriController>.
-При этом формируется цепочка обработчиков запроса, эта цапочка будет выполняться с последнего добавленного,
-причем каждый добавленный обработчик в качестве одного из параметров получает не только текущий запрос,
-но и предыдущий обработчик.
+Запрос выполняется последовательным вызовом цепочки обработчиков, при этом обработчики
+сами вызывают следующие.
 
 Типичная цепочка может быть такой, в порядке добавления
 
-$objSecCallToMethod($target,$method)
-$AuthenticateMethod
-$TDocumentOut($file)
+SecCallToMethod($target,$method)
+AuthenticateMethod
+TDocumentOut($file)
 
 что приведет к следующей последовательности
 
@@ -120,4 +118,9 @@
 
 =back 
 
+=head2 C< IMPL::Web::Application::QueryHandler >
+
+Любой объект наследованный от C< IMPL::Web::Application::QueryHandler > может быть
+использован в качестве обработчика запроса
+
 =cut
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/Session.pm	Fri Mar 05 13:59:29 2010 +0300
@@ -0,0 +1,41 @@
+package IMPL::Web::Application::Session;
+use strict;
+
+use base qw(IMPL::Object);
+
+use IMPL::Security::Auth qw(GenSSID);
+
+use IMPL::Class::Property;
+
+BEGIN {
+	public property id => prop_get | owner_set;
+	public property principal => prop_get | owner_set;
+	public property authSession => prop_get | owner_set;
+	public property roles => prop_get | owner_set | prop_list;
+}
+
+sub CTOR {
+	my ($this,%args) = @_;
+	
+	$this->principal($args{principal}) or die new IMPL::InvalidArgumentException("A principal is required");
+	$this->authSession($args{auth}) or die new IMPL::InvalidArgumentException("An auth session is required");
+	$this->roles($args{roles}) if $args{roles};
+	
+	$this->id(GenSSID());
+}
+
+sub DoAuth {
+	my ($this,$secData) = @_;
+	
+	return $this->authSession->DoAuth($secData);
+}
+
+sub ValidateSession {
+	my ($this,$secData) = @_;
+	
+	return $this->authSession->ValidateSession($secData);
+}
+
+1;
+
+__END__
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Response.pm	Fri Mar 05 13:59:29 2010 +0300
@@ -0,0 +1,129 @@
+package IMPL::Web::Response;
+use strict;
+
+use base qw(IMPL::Object IMPL::Object::Autofill);
+
+require IMPL::Exception;
+require CGI;
+require CGI::Cookie;
+
+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 expires => prop_all, { validator => \&_checkHeaderPrinted };
+	public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
+	
+	public property buffered => prop_get | owner_set; # Boolean
+	public property streamOut => prop_get | owner_set; # stream
+	public property streamBody => {get => \&getStreamBody }; # stream
+	public property isHeaderPrinted => prop_all; # Boolean 
+	
+	private property _bufferBody => prop_all;
+	private property _streamBody => prop_all;
+}
+
+__PACKAGE__->PassThroughArgs;
+
+sub CTOR {
+	my ($this,%args) = @_;
+	
+	$this->query(CGI->new({})) unless $this->query;
+	
+	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);
+	}
+}
+
+sub _checkHeaderPrinted {
+	my ($this,$value) = @_;
+	
+	die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
+}
+
+sub _PrintHeader {
+	my ($this) = @_;
+	
+	unless ($this->isHeaderPrinted) {
+		$this->isHeaderPrinted(1);
+		
+		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;
+		
+		my $refCookies = $this->cookies;
+		$opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies;
+		
+		my $hOut = $this->streamOut;
+		
+		print $hOut $this->query->header(
+			%opt
+		);
+	}
+}
+
+sub getStreamBody {
+	my ($this) = @_;
+	
+	return undef unless $this->_bodyStream;
+	
+	if ($this->buffered) {
+		return $this->_bodyStream;
+	} else {
+		$this->_PrintHeader();
+		return $this->_bodyStream;
+	}
+}
+
+sub Complete {
+	my ($this) = @_;
+	
+	return 0 unless $this->streamOut;
+	
+	my $hOut = $this->streamOut;
+	
+	$this->_PrintHeader();
+	
+	if ($this->buffered) {
+		print $hOut ${$this->_bufferBody};	
+	}
+	
+	$this->_streamBody(undef);
+	$this->_bufferBody(undef);
+	$this->streamOut(undef);
+	
+	return 1;
+}
+
+sub Discard {
+	my ($this) = @_;
+	
+	$this->_streamBody(undef);
+	$this->_bufferBody(undef);
+	$this->streamOut(undef);
+}
+
+1;
+
+__END__
+
+=pod
+
+
+
+=cut
\ No newline at end of file