Mercurial > pub > Impl
annotate Lib/IMPL/Web/HttpResponse.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
| author | sergey |
|---|---|
| date | Mon, 29 Oct 2012 03:15:22 +0400 |
| parents | 23daf2fae33a |
| 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 |