Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Configuration, late activation
author wizard
date Fri, 05 Mar 2010 20:14:45 +0300
parents bf59ee1cd506
children
comparison
equal deleted inserted replaced
57:bf59ee1cd506 58:a35b60b16a99
5 5
6 require IMPL::Exception; 6 require IMPL::Exception;
7 require CGI; 7 require CGI;
8 require CGI::Cookie; 8 require CGI::Cookie;
9 9
10 use Carp;
10 use IMPL::Class::Property; 11 use IMPL::Class::Property;
11
12 use HTTP::Response;
13 12
14 BEGIN { 13 BEGIN {
15 public property query => prop_get | owner_set; # cgi query 14 public property query => prop_get | owner_set; # cgi query
16 public property status => prop_all, { validator => \&_checkHeaderPrinted }; 15 public property status => prop_all, { validator => \&_checkHeaderPrinted };
17 public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String 16 public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String
18 public property charset => prop_all, { validator => \&_checkHeaderPrinted }; 17 public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted };
19 public property expires => prop_all, { validator => \&_checkHeaderPrinted }; 18 public property expires => prop_all, { validator => \&_checkHeaderPrinted };
20 public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash 19 public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
21 20
22 public property buffered => prop_get | owner_set; # Boolean 21 public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean
23 public property streamOut => prop_get | owner_set; # stream 22 public property streamOut => prop_get | owner_set; # stream
24 public property streamBody => {get => \&getStreamBody }; # stream 23 public property streamBody => {get => \&getStreamBody }; # stream
25 public property isHeaderPrinted => prop_all; # Boolean 24 public property isHeaderPrinted => prop_get | owner_set; # Boolean
26 25
27 private property _bufferBody => prop_all; 26 private property _bufferBody => prop_all;
28 private property _streamBody => prop_all; 27 private property _streamBody => prop_all;
29 } 28 }
30 29
31 __PACKAGE__->PassThroughArgs; 30 __PACKAGE__->PassThroughArgs;
32 31
33 sub CTOR { 32 sub CTOR {
34 my ($this,%args) = @_; 33 my ($this,%args) = @_;
35 34
36 $this->query(CGI->new({})) unless $this->query; 35 $this->query(CGI->new($this->query() | {})) unless $this->query;
37 36 $this->charset($this->query->charset) unless $this->charset;
38 if ($this->buffered) { 37
39 my $buffer = ""; 38 $this->streamOut(*STDOUT) unless $this->streamOut;
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 } 39 }
49 40
50 sub _checkHeaderPrinted { 41 sub _checkHeaderPrinted {
51 my ($this,$value) = @_; 42 my ($this,$value) = @_;
52 43
53 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted; 44 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
54 } 45 }
55 46
47 sub _canChangeBuffer {
48 my ($this,$value) = @_;
49
50 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted or $this->_streamBody;
51 }
52
53 sub _charset {
54 my $this = shift;
55
56 return $this->query->charset(@_);
57 }
58
56 sub _PrintHeader { 59 sub _PrintHeader {
57 my ($this) = @_; 60 my ($this) = @_;
58 61
59 unless ($this->isHeaderPrinted) { 62 unless ($this->isHeaderPrinted) {
60 $this->isHeaderPrinted(1); 63 $this->isHeaderPrinted(1);
61 64
62 my %opt; 65 my %opt;
63 66
64 $opt{-type} = $this->contentType if $this->contentType; 67 $opt{-type} = $this->contentType if $this->contentType;
65 $opt{-charset} = $this->charset if $this->charset;
66 $opt{-status} = $this->status if $this->status; 68 $opt{-status} = $this->status if $this->status;
67 $opt{-expires} = $this->expires if $this->expires; 69 $opt{-expires} = $this->expires if $this->expires;
68 70
69 my $refCookies = $this->cookies; 71 my $refCookies = $this->cookies;
70 $opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies; 72 $opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies;
78 } 80 }
79 81
80 sub getStreamBody { 82 sub getStreamBody {
81 my ($this) = @_; 83 my ($this) = @_;
82 84
83 return undef unless $this->_bodyStream; 85 return undef unless $this->streamOut;
84 86
85 if ($this->buffered) { 87 unless ($this->_streamBody) {
86 return $this->_bodyStream; 88 if ($this->buffered) {
87 } else { 89 my $buffer = "";
88 $this->_PrintHeader(); 90 $this->_bufferBody(\$buffer);
89 return $this->_bodyStream; 91
92 open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
93
94 $this->_streamBody($hBody);
95 } else {
96 $this->_PrintHeader();
97 $this->_streamBody($this->streamOut);
98 }
90 } 99 }
100
101 return $this->_streamBody;
91 } 102 }
92 103
93 sub Complete { 104 sub Complete {
94 my ($this) = @_; 105 my ($this) = @_;
95 106
111 } 122 }
112 123
113 sub Discard { 124 sub Discard {
114 my ($this) = @_; 125 my ($this) = @_;
115 126
127 carp "Discarding sent response" if $this->isHeaderPrinted;
128
116 $this->_streamBody(undef); 129 $this->_streamBody(undef);
117 $this->_bufferBody(undef); 130 $this->_bufferBody(undef);
118 $this->streamOut(undef); 131 $this->streamOut(undef);
119 } 132 }
120 133
122 135
123 __END__ 136 __END__
124 137
125 =pod 138 =pod
126 139
127 140 =head1 DESCRIPTION
141
142 Ответ сервера на CGI запрос, позволяет сформировать основные свойства заголовка и тело запроса.
143
144 Объект позволяет буфферизировать вывод в тело ответа, что позволяет отменить или изменить
145 ответ в последний момент.
146
147 Свойство C< isHeaderPrinted > можно использовать для определения были ли отправлены какие-нибудь
148 данные клиенту.
149
150 =head1 PROPERTIES
151
152 =head2 HTTP Header
153
154 Свойства отвечающие за заголовок HTTP ответа. Эти своства могут быть изменены до тех пор пока
155 не будет отправлен заголовок. В противном случае выдается исключение C< IMPL::InvalidOperationException >.
156
157 =over
158
159 =item C< query >
160
161 CGI запрос, который используется для вывода данных, заголовка и пр. Существует всегда.
162
163 =item C< status >
164
165 Код ошибки HTTP. Например, '200 OK'. По умолчанию не установлен, при отправке клиенту бедт отправлен '200 ОК'.
166
167 =item C< contentType >
168
169 Тип MIME. По умолчанию не установлен, подразумивается 'text/html'.
170
171 =item C< charset >
172
173 Кодировка, синоним свойства query->charset.
174
175 =item C< expires >
176
177 Определяет время жизни контента, например '+10m'. По умолчанию не задано и не передается.
178
179 =item C< cookies >
180
181 Хеш массив с cookies, например C< { cart => ['foo','bar'], display => 'list' } >.
182
183 =back
184
185 =head2 Response behaviour
186
187 Свойства отвечающие за поведение ответа.
188
189 =over
190
191 =item C< buffered >
192
193 C< True > - то тело ответа пишется в буффер и будет отправлено при вызове метода C< Complete >,
194 заголовок также будет отправлен после вызова метода C< Complete >.
195
196 C< False > - тело ответа пишется непосредственно в поток к клиенту, при этом заголовок
197 будет отправлен при первом обращении к свойству C< streamBody >
198
199 Это свойство можно менять до первого обращения к потоку для записи в тело ответа.
200
201 =item C< streamOut >
202
203 Стандартный вывод CGI приложения.
204
205 =item C< streamBody >
206
207 Поток для записи в тело ответа.
208
209 =item C< isHeadPrinted >
210
211 Признак того, что заголовок уже был отправлен клиенту.
212
213 =back
214
215 =head1 METHODS
216
217 =over
218
219 =item C< Complete >
220
221 Завершает отправку ответа.
222
223 =item C< Discard >
224
225 Отменяет отправку ответа, при этом если часть данных (например, заголовок)
226 уже была отправлена, выдает предупреждение в STDERR.
227
228 =back
128 229
129 =cut 230 =cut