Mercurial > pub > Impl
annotate Lib/IMPL/Web/HttpResponse.pm @ 246:2746a8e5a6c4
Fixed regressions in DOM due previous refactorings
Fixed ObjectToDOM transformation to handle a schema with mixed node types
| author | sergey |
|---|---|
| date | Tue, 30 Oct 2012 01:17:31 +0400 |
| parents | 7c517134c42f |
| children | 32aceba4ee6d |
| 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)"; | |
| 49 } | |
| 50 | |
| 230 | 51 print $out $q->header(\%headers); |
| 213 | 52 |
| 53 if(my $body = $this->body) { | |
| 54 if(ref $body eq 'CODE') { | |
| 55 $body->($out); | |
| 56 } else { | |
| 57 print $out $body; | |
| 58 } | |
| 59 } | |
| 60 } | |
| 61 | |
| 62 #used to map a pair name valie to a valid cookie object | |
| 63 sub _createCookie { | |
| 239 | 64 return UNIVERSAL::isa($_[1], 'CGI::Cookie') |
| 65 ? $_[1] | |
| 66 : ( defined $_[1] | |
| 67 ? CGI::Cookie->new(-name => $_[0], -value => $_[1] ) | |
| 68 : CGI::Cookie->new(-name => $_[0], -expires => '-1d', -value => '') | |
| 69 ); | |
| 213 | 70 } |
| 71 | |
| 230 | 72 sub InternalError { |
| 73 my ($self,%args) = @_; | |
| 74 | |
| 75 $args{status} ||= '500 Internal Server Error'; | |
| 76 | |
| 77 return $self->new(%args); | |
| 78 } | |
| 79 | |
| 80 sub Redirect { | |
| 81 my ($self,%args) = @_; | |
| 82 | |
| 83 return $self->new( | |
| 84 status => $args{status} || '303 See other', | |
| 85 headers => { | |
| 86 location => $args{location} | |
| 87 } | |
| 88 ); | |
| 89 } | |
| 90 | |
| 245 | 91 sub NoContent { |
| 92 my ($self,%args) = @_; | |
| 93 | |
| 94 return $self->new( | |
| 95 status => $args{status} || '204 No Content' | |
| 96 ); | |
| 97 } | |
| 98 | |
| 213 | 99 1; |
| 100 | |
| 101 __END__ | |
| 102 | |
| 103 =pod | |
| 104 | |
| 105 =head1 NAME | |
| 106 | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
107 C<IMPL::Web::HttpResponse> - Результат обработки C<HTTP> запроса. |
| 213 | 108 |
| 109 =head1 SYNOPSIS | |
| 110 | |
| 111 =head1 DESCRIPTION | |
| 112 | |
| 113 Базовый класс для ответов приложения на C<HTTP> запрос. Каждый вид ответа, | |
| 114 например | |
| 115 | |
| 116 Данный объект используется для формирования и передачи данных C<HTTP> ответа | |
| 117 напрямую. Основными полями являются C<body> и C<status>. | |
| 118 | |
| 119 Кроме свойств относящихся непосредственно к самому C<HTTP> ответу, данный объект | |
| 120 может содержать свойства относящиеся к процессу обработки запроса, например | |
| 121 механизму формирования представления. | |
| 122 | |
| 123 =head1 MEMBERS | |
| 124 | |
| 125 =head2 C<[get,set]status> | |
| 126 | |
| 127 Статус который будет отправлен сервером клиенту, например, C<200 OK> или | |
| 128 C<204 No response>. Если не указан, то будет C<200 OK>. | |
| 129 | |
| 130 =head2 C<[get,set]type> | |
| 131 | |
| 132 Тип содержимого, которое будет передано клиенту, если не указано, будет | |
| 133 C<text/html>. | |
| 134 | |
| 135 =head2 C<[get,set]charset> | |
| 136 | |
| 137 Кодировка в которой будут переданны данные. Следует задавать если и только, если | |
| 138 передается текстовая информация. Если указана кодировка, то она будет | |
| 139 автоматически применена к потоку, который будет передан методу C<PrintResponse>. | |
| 140 | |
| 141 =head2 C<[get,set]cookies> | |
| 142 | |
| 143 Опционально. Ссылка на хеш с печеньками. | |
| 144 | |
| 145 =head2 C<[get,set]headers> | |
| 146 | |
| 147 Опционально. Ссылка на хеш с дополнительными полями заголовка ответа. Формат | |
| 148 имен полей как у модуля C<CGI>. | |
| 149 | |
|
229
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
150 =begin code |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
151 |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
152 $response->header->{custom_header} = "my value"; |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
153 |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
154 #will produce the following header |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
155 |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
156 Custom-header: my value |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
157 |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
158 =end code |
|
47f77e6409f7
heavily reworked the resource model of the web application:
sergey
parents:
213
diff
changeset
|
159 |
| 213 | 160 =head2 C<[get,set]body> |
| 161 | |
| 162 Тело ответа. Может быть как простой скаляр, который будет приведен к строке и | |
| 163 выдан в поток вывода метода C<PrintResponse>. Также может быть ссылкой на | |
| 164 процедуру, в таком случае будет вызвана эта процедура и ей будет передан | |
| 165 первым параметром поток для вывода тела ответа. | |
| 166 | |
| 167 =head2 C<PrintResponse($outStream)> | |
| 168 | |
| 169 Формирует заголовок и выводит ответ сервера в указанный параметром поток. | |
| 170 | |
| 171 =cut |