Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Web application main class functionality
author wizard
date Fri, 05 Mar 2010 13:59:29 +0300
parents
children a35b60b16a99
comparison
equal deleted inserted replaced
56:117b6956d5a5 57:bf59ee1cd506
1 package IMPL::Web::Response;
2 use strict;
3
4 use base qw(IMPL::Object IMPL::Object::Autofill);
5
6 require IMPL::Exception;
7 require CGI;
8 require CGI::Cookie;
9
10 use IMPL::Class::Property;
11
12 use HTTP::Response;
13
14 BEGIN {
15 public property query => prop_get | owner_set; # cgi query
16 public property status => prop_all, { validator => \&_checkHeaderPrinted };
17 public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String
18 public property charset => prop_all, { validator => \&_checkHeaderPrinted };
19 public property expires => prop_all, { validator => \&_checkHeaderPrinted };
20 public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
21
22 public property buffered => prop_get | owner_set; # Boolean
23 public property streamOut => prop_get | owner_set; # stream
24 public property streamBody => {get => \&getStreamBody }; # stream
25 public property isHeaderPrinted => prop_all; # Boolean
26
27 private property _bufferBody => prop_all;
28 private property _streamBody => prop_all;
29 }
30
31 __PACKAGE__->PassThroughArgs;
32
33 sub CTOR {
34 my ($this,%args) = @_;
35
36 $this->query(CGI->new({})) unless $this->query;
37
38 if ($this->buffered) {
39 my $buffer = "";
40 $this->_bufferBody(\$buffer);
41
42 open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
43
44 $this->_streamBody($hBody);
45 } else {
46 $this->_streamBody($this->streamOut);
47 }
48 }
49
50 sub _checkHeaderPrinted {
51 my ($this,$value) = @_;
52
53 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
54 }
55
56 sub _PrintHeader {
57 my ($this) = @_;
58
59 unless ($this->isHeaderPrinted) {
60 $this->isHeaderPrinted(1);
61
62 my %opt;
63
64 $opt{-type} = $this->contentType if $this->contentType;
65 $opt{-charset} = $this->charset if $this->charset;
66 $opt{-status} = $this->status if $this->status;
67 $opt{-expires} = $this->expires if $this->expires;
68
69 my $refCookies = $this->cookies;
70 $opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies;
71
72 my $hOut = $this->streamOut;
73
74 print $hOut $this->query->header(
75 %opt
76 );
77 }
78 }
79
80 sub getStreamBody {
81 my ($this) = @_;
82
83 return undef unless $this->_bodyStream;
84
85 if ($this->buffered) {
86 return $this->_bodyStream;
87 } else {
88 $this->_PrintHeader();
89 return $this->_bodyStream;
90 }
91 }
92
93 sub Complete {
94 my ($this) = @_;
95
96 return 0 unless $this->streamOut;
97
98 my $hOut = $this->streamOut;
99
100 $this->_PrintHeader();
101
102 if ($this->buffered) {
103 print $hOut ${$this->_bufferBody};
104 }
105
106 $this->_streamBody(undef);
107 $this->_bufferBody(undef);
108 $this->streamOut(undef);
109
110 return 1;
111 }
112
113 sub Discard {
114 my ($this) = @_;
115
116 $this->_streamBody(undef);
117 $this->_bufferBody(undef);
118 $this->streamOut(undef);
119 }
120
121 1;
122
123 __END__
124
125 =pod
126
127
128
129 =cut