Mercurial > pub > Impl
annotate Lib/IMPL/Web/HttpResponse.pm @ 340:c090d9102a38
web application security refactoring
author | cin |
---|---|
date | Fri, 21 Jun 2013 02:43:56 +0400 |
parents | 32aceba4ee6d |
children |
rev | line source |
---|---|
213 | 1 use strict; |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
2 package IMPL::Web::HttpResponse; |
213 | 3 |
4 use CGI(); | |
245 | 5 use IMPL::lang qw(:declare :hash); |
213 | 6 use IMPL::declare { |
7 require => { | |
8 Exception => 'IMPL::Exception', | |
9 ArgumentException => '-IMPL::InvalidArgumentException' | |
10 }, | |
11 base => [ | |
12 'IMPL::Object' => undef, | |
13 'IMPL::Object::Autofill' => '@_' | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
14 ], |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
15 props => [ |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
16 status => PROP_ALL, |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
17 type => PROP_ALL, |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
18 charset => PROP_ALL, |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
19 cookies => PROP_ALL, |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
20 headers => PROP_ALL, |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
21 body => PROP_ALL |
213 | 22 ] |
23 }; | |
24 | |
25 sub CTOR { | |
26 my ($this) = @_; | |
27 | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
28 $this->headers({}) unless $this->headers(); |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
29 $this->cookies({}) unless $this->cookies(); |
213 | 30 } |
31 | |
32 sub PrintResponse { | |
33 my ($this,$out) = @_; | |
34 | |
35 my $q = CGI->new({}); | |
36 | |
37 my %headers = %{$this->headers}; | |
38 | |
39 if(my $cookies = $this->cookies) { | |
40 $headers{-cookie} = [map _createCookie($_,$cookies->{$_}), keys %$cookies] if $cookies; | |
41 } | |
42 | |
43 $headers{'-status'} = $this->status || '200 OK'; | |
44 $headers{'-type'} = $this->type || 'text/html'; | |
45 | |
46 if(my $charset = $this->charset) { | |
47 $q->charset($charset); | |
48 binmode $out, ":encoding($charset)"; | |
256
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
49 } else { |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
50 $q->charset(''); |
32aceba4ee6d
corrected ViewHandlers to handle cookies and headers.
sergey
parents:
245
diff
changeset
|
51 binmode $out; |
213 | 52 } |
53 | |
230 | 54 print $out $q->header(\%headers); |
213 | 55 |
56 if(my $body = $this->body) { | |
57 if(ref $body eq 'CODE') { | |
58 $body->($out); | |
59 } else { | |
60 print $out $body; | |
61 } | |
62 } | |
63 } | |
64 | |
65 #used to map a pair name valie to a valid cookie object | |
66 sub _createCookie { | |
239 | 67 return UNIVERSAL::isa($_[1], 'CGI::Cookie') |
68 ? $_[1] | |
69 : ( defined $_[1] | |
70 ? CGI::Cookie->new(-name => $_[0], -value => $_[1] ) | |
71 : CGI::Cookie->new(-name => $_[0], -expires => '-1d', -value => '') | |
72 ); | |
213 | 73 } |
74 | |
230 | 75 sub InternalError { |
76 my ($self,%args) = @_; | |
77 | |
78 $args{status} ||= '500 Internal Server Error'; | |
79 | |
80 return $self->new(%args); | |
81 } | |
82 | |
83 sub Redirect { | |
84 my ($self,%args) = @_; | |
85 | |
86 return $self->new( | |
87 status => $args{status} || '303 See other', | |
88 headers => { | |
89 location => $args{location} | |
90 } | |
91 ); | |
92 } | |
93 | |
245 | 94 sub NoContent { |
95 my ($self,%args) = @_; | |
96 | |
97 return $self->new( | |
98 status => $args{status} || '204 No Content' | |
99 ); | |
100 } | |
101 | |
213 | 102 1; |
103 | |
104 __END__ | |
105 | |
106 =pod | |
107 | |
108 =head1 NAME | |
109 | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
110 C<IMPL::Web::HttpResponse> - Результат обработки C<HTTP> запроса. |
213 | 111 |
112 =head1 SYNOPSIS | |
113 | |
114 =head1 DESCRIPTION | |
115 | |
116 Базовый класс для ответов приложения на C<HTTP> запрос. Каждый вид ответа, | |
117 например | |
118 | |
119 Данный объект используется для формирования и передачи данных C<HTTP> ответа | |
120 напрямую. Основными полями являются C<body> и C<status>. | |
121 | |
122 Кроме свойств относящихся непосредственно к самому C<HTTP> ответу, данный объект | |
123 может содержать свойства относящиеся к процессу обработки запроса, например | |
124 механизму формирования представления. | |
125 | |
126 =head1 MEMBERS | |
127 | |
128 =head2 C<[get,set]status> | |
129 | |
130 Статус который будет отправлен сервером клиенту, например, C<200 OK> или | |
131 C<204 No response>. Если не указан, то будет C<200 OK>. | |
132 | |
133 =head2 C<[get,set]type> | |
134 | |
135 Тип содержимого, которое будет передано клиенту, если не указано, будет | |
136 C<text/html>. | |
137 | |
138 =head2 C<[get,set]charset> | |
139 | |
140 Кодировка в которой будут переданны данные. Следует задавать если и только, если | |
141 передается текстовая информация. Если указана кодировка, то она будет | |
142 автоматически применена к потоку, который будет передан методу C<PrintResponse>. | |
143 | |
144 =head2 C<[get,set]cookies> | |
145 | |
146 Опционально. Ссылка на хеш с печеньками. | |
147 | |
148 =head2 C<[get,set]headers> | |
149 | |
150 Опционально. Ссылка на хеш с дополнительными полями заголовка ответа. Формат | |
151 имен полей как у модуля C<CGI>. | |
152 | |
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
153 =begin code |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
154 |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
155 $response->header->{custom_header} = "my value"; |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
156 |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
157 #will produce the following header |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
158 |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
159 Custom-header: my value |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
160 |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
161 =end code |
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
162 |
213 | 163 =head2 C<[get,set]body> |
164 | |
165 Тело ответа. Может быть как простой скаляр, который будет приведен к строке и | |
166 выдан в поток вывода метода C<PrintResponse>. Также может быть ссылкой на | |
167 процедуру, в таком случае будет вызвана эта процедура и ей будет передан | |
168 первым параметром поток для вывода тела ответа. | |
169 | |
170 =head2 C<PrintResponse($outStream)> | |
171 | |
172 Формирует заголовок и выводит ответ сервера в указанный параметром поток. | |
173 | |
174 =cut |