diff Lib/IMPL/Web/Response.pm @ 57:bf59ee1cd506

Web application main class functionality
author wizard
date Fri, 05 Mar 2010 13:59:29 +0300
parents
children a35b60b16a99
line wrap: on
line diff
--- /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