|
57
|
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
|
|
58
|
10 use Carp;
|
|
57
|
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
|
|
58
|
17 public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted };
|
|
57
|
18 public property expires => prop_all, { validator => \&_checkHeaderPrinted };
|
|
|
19 public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
|
|
|
20
|
|
58
|
21 public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean
|
|
57
|
22 public property streamOut => prop_get | owner_set; # stream
|
|
|
23 public property streamBody => {get => \&getStreamBody }; # stream
|
|
58
|
24 public property isHeaderPrinted => prop_get | owner_set; # Boolean
|
|
57
|
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
|
|
58
|
35 $this->query(CGI->new($this->query() | {})) unless $this->query;
|
|
|
36 $this->charset($this->query->charset) unless $this->charset;
|
|
57
|
37
|
|
58
|
38 $this->streamOut(*STDOUT) unless $this->streamOut;
|
|
57
|
39 }
|
|
|
40
|
|
|
41 sub _checkHeaderPrinted {
|
|
|
42 my ($this,$value) = @_;
|
|
|
43
|
|
|
44 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
|
|
|
45 }
|
|
|
46
|
|
58
|
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
|
|
57
|
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
|
|
58
|
85 return undef unless $this->streamOut;
|
|
57
|
86
|
|
58
|
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 }
|
|
57
|
99 }
|
|
58
|
100
|
|
|
101 return $this->_streamBody;
|
|
57
|
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
|
|
58
|
127 carp "Discarding sent response" if $this->isHeaderPrinted;
|
|
|
128
|
|
57
|
129 $this->_streamBody(undef);
|
|
|
130 $this->_bufferBody(undef);
|
|
|
131 $this->streamOut(undef);
|
|
|
132 }
|
|
|
133
|
|
|
134 1;
|
|
|
135
|
|
|
136 __END__
|
|
|
137
|
|
|
138 =pod
|
|
|
139
|
|
58
|
140 =head1 DESCRIPTION
|
|
57
|
141
|
|
58
|
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
|
|
57
|
229
|
|
|
230 =cut |
