Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application/Response.pm @ 59:0f3e369553bd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents Lib/IMPL/Web/Response.pm@a35b60b16a99
children 76b878ad6596
comparison
equal deleted inserted replaced
58:a35b60b16a99 59:0f3e369553bd
1 package IMPL::Web::Application::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 Carp;
11 use IMPL::Class::Property;
12
13 BEGIN {
14 public property query => prop_get | owner_set; # cgi query
15 public property status => prop_all, { validator => \&_checkHeaderPrinted };
16 public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String
17 public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted };
18 public property expires => prop_all, { validator => \&_checkHeaderPrinted };
19 public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
20
21 public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean
22 public property streamOut => prop_get | owner_set; # stream
23 public property streamBody => {get => \&getStreamBody }; # stream
24 public property isHeaderPrinted => prop_get | owner_set; # Boolean
25
26 private property _bufferBody => prop_all;
27 private property _streamBody => prop_all;
28 }
29
30 __PACKAGE__->PassThroughArgs;
31
32 sub CTOR {
33 my ($this,%args) = @_;
34
35 $this->query(CGI->new($this->query() | {})) unless $this->query;
36 $this->charset($this->query->charset) unless $this->charset;
37
38 $this->streamOut(*STDOUT) unless $this->streamOut;
39 }
40
41 sub _checkHeaderPrinted {
42 my ($this,$value) = @_;
43
44 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
45 }
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
59 sub _PrintHeader {
60 my ($this) = @_;
61
62 unless ($this->isHeaderPrinted) {
63 $this->isHeaderPrinted(1);
64
65 my %opt;
66
67 $opt{-type} = $this->contentType if $this->contentType;
68 $opt{-status} = $this->status if $this->status;
69 $opt{-expires} = $this->expires if $this->expires;
70
71 my $refCookies = $this->cookies;
72 $opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies;
73
74 my $hOut = $this->streamOut;
75
76 print $hOut $this->query->header(
77 %opt
78 );
79 }
80 }
81
82 sub getStreamBody {
83 my ($this) = @_;
84
85 return undef unless $this->streamOut;
86
87 unless ($this->_streamBody) {
88 if ($this->buffered) {
89 my $buffer = "";
90 $this->_bufferBody(\$buffer);
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 }
99 }
100
101 return $this->_streamBody;
102 }
103
104 sub Complete {
105 my ($this) = @_;
106
107 return 0 unless $this->streamOut;
108
109 my $hOut = $this->streamOut;
110
111 $this->_PrintHeader();
112
113 if ($this->buffered) {
114 print $hOut ${$this->_bufferBody};
115 }
116
117 $this->_streamBody(undef);
118 $this->_bufferBody(undef);
119 $this->streamOut(undef);
120
121 return 1;
122 }
123
124 sub Discard {
125 my ($this) = @_;
126
127 carp "Discarding sent response" if $this->isHeaderPrinted;
128
129 $this->_streamBody(undef);
130 $this->_bufferBody(undef);
131 $this->streamOut(undef);
132 }
133
134 1;
135
136 __END__
137
138 =pod
139
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
229
230 =cut