line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Catalyst::Response; |
2
|
|
|
|
|
|
|
|
3
|
167
|
|
|
167
|
|
5693
|
use Moose; |
|
167
|
|
|
|
|
468005
|
|
|
167
|
|
|
|
|
1460
|
|
4
|
167
|
|
|
167
|
|
1174720
|
use HTTP::Headers; |
|
167
|
|
|
|
|
7872
|
|
|
167
|
|
|
|
|
6057
|
|
5
|
167
|
|
|
167
|
|
1237
|
use Moose::Util::TypeConstraints; |
|
167
|
|
|
|
|
467
|
|
|
167
|
|
|
|
|
2113
|
|
6
|
167
|
|
|
167
|
|
393280
|
use Scalar::Util 'blessed'; |
|
167
|
|
|
|
|
601
|
|
|
167
|
|
|
|
|
12941
|
|
7
|
167
|
|
|
167
|
|
80299
|
use Catalyst::Response::Writer; |
|
167
|
|
|
|
|
638
|
|
|
167
|
|
|
|
|
5453
|
|
8
|
167
|
|
|
167
|
|
20177
|
use Catalyst::Utils (); |
|
167
|
|
|
|
|
509
|
|
|
167
|
|
|
|
|
4752
|
|
9
|
|
|
|
|
|
|
|
10
|
167
|
|
|
167
|
|
1146
|
use namespace::clean -except => ['meta']; |
|
167
|
|
|
|
|
422
|
|
|
167
|
|
|
|
|
1587
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
with 'MooseX::Emulate::Class::Accessor::Fast'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $DEFAULT_ENCODE_CONTENT_TYPE_MATCH = qr{text|xml$|javascript$}; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
has encodable_content_type => ( |
17
|
|
|
|
|
|
|
is => 'rw', |
18
|
|
|
|
|
|
|
required => 1, |
19
|
|
|
|
|
|
|
default => sub { $DEFAULT_ENCODE_CONTENT_TYPE_MATCH } |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
has _response_cb => ( |
23
|
|
|
|
|
|
|
is => 'ro', |
24
|
|
|
|
|
|
|
isa => 'CodeRef', |
25
|
|
|
|
|
|
|
writer => '_set_response_cb', |
26
|
|
|
|
|
|
|
clearer => '_clear_response_cb', |
27
|
|
|
|
|
|
|
predicate => '_has_response_cb', |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
subtype 'Catalyst::Engine::Types::Writer', |
31
|
|
|
|
|
|
|
as duck_type([qw(write close)]); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
has _writer => ( |
34
|
|
|
|
|
|
|
is => 'ro', |
35
|
|
|
|
|
|
|
isa => 'Catalyst::Engine::Types::Writer', #Pointless since we control how this is built |
36
|
|
|
|
|
|
|
#writer => '_set_writer', Now that its lazy I think this is safe to remove |
37
|
|
|
|
|
|
|
clearer => '_clear_writer', |
38
|
|
|
|
|
|
|
predicate => '_has_writer', |
39
|
|
|
|
|
|
|
lazy => 1, |
40
|
|
|
|
|
|
|
builder => '_build_writer', |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub _build_writer { |
44
|
17
|
|
|
17
|
|
39
|
my $self = shift; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
## These two lines are probably crap now... |
47
|
17
|
100
|
|
|
|
517
|
$self->_context->finalize_headers unless |
48
|
|
|
|
|
|
|
$self->finalized_headers; |
49
|
|
|
|
|
|
|
|
50
|
17
|
|
|
|
|
48
|
my @headers; |
51
|
17
|
|
|
89
|
|
77
|
$self->headers->scan(sub { push @headers, @_ }); |
|
89
|
|
|
|
|
1378
|
|
52
|
|
|
|
|
|
|
|
53
|
17
|
|
|
|
|
191
|
my $writer = $self->_response_cb->([ $self->status, \@headers ]); |
54
|
17
|
|
|
|
|
7020
|
$self->_clear_response_cb; |
55
|
|
|
|
|
|
|
|
56
|
17
|
|
|
|
|
506
|
return $writer; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
has write_fh => ( |
60
|
|
|
|
|
|
|
is=>'ro', |
61
|
|
|
|
|
|
|
predicate=>'_has_write_fh', |
62
|
|
|
|
|
|
|
lazy=>1, |
63
|
|
|
|
|
|
|
builder=>'_build_write_fh', |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub _build_write_fh { |
67
|
5
|
|
|
5
|
|
161
|
my $writer = $_[0]->_writer; # We need to get the finalize headers side effect... |
68
|
5
|
|
|
|
|
45
|
my $requires_encoding = $_[0]->encodable_response; |
69
|
5
|
|
|
|
|
209
|
my %fields = ( |
70
|
|
|
|
|
|
|
_writer => $writer, |
71
|
|
|
|
|
|
|
_context => $_[0]->_context, |
72
|
|
|
|
|
|
|
_requires_encoding => $requires_encoding, |
73
|
|
|
|
|
|
|
); |
74
|
|
|
|
|
|
|
|
75
|
5
|
|
|
|
|
187
|
return bless \%fields, 'Catalyst::Response::Writer'; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub DEMOLISH { |
79
|
926
|
|
|
926
|
1
|
2456
|
my $self = shift; |
80
|
926
|
50
|
|
|
|
30070
|
return if $self->_has_write_fh; |
81
|
926
|
50
|
|
|
|
30922
|
if($self->_has_writer) { |
82
|
0
|
|
|
|
|
0
|
$self->_writer->close |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
has cookies => (is => 'rw', default => sub { {} }); |
87
|
|
|
|
|
|
|
has body => (is => 'rw', default => undef); |
88
|
1
|
|
|
1
|
1
|
25
|
sub has_body { defined($_[0]->body) } |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
has location => (is => 'rw'); |
91
|
|
|
|
|
|
|
has status => (is => 'rw', default => 200); |
92
|
|
|
|
|
|
|
has finalized_headers => (is => 'rw', default => 0); |
93
|
|
|
|
|
|
|
has headers => ( |
94
|
|
|
|
|
|
|
is => 'rw', |
95
|
|
|
|
|
|
|
isa => 'HTTP::Headers', |
96
|
|
|
|
|
|
|
handles => [qw(content_encoding content_length content_type content_type_charset header)], |
97
|
|
|
|
|
|
|
default => sub { HTTP::Headers->new() }, |
98
|
|
|
|
|
|
|
required => 1, |
99
|
|
|
|
|
|
|
lazy => 1, |
100
|
|
|
|
|
|
|
); |
101
|
|
|
|
|
|
|
has _context => ( |
102
|
|
|
|
|
|
|
is => 'rw', |
103
|
|
|
|
|
|
|
weak_ref => 1, |
104
|
|
|
|
|
|
|
clearer => '_clear_context', |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
before [qw(status headers content_encoding content_length content_type )] => sub { |
108
|
|
|
|
|
|
|
my $self = shift; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
$self->_context->log->warn( |
111
|
|
|
|
|
|
|
"Useless setting a header value after finalize_headers and the response callback has been called." . |
112
|
|
|
|
|
|
|
" Since we don't support tail headers this will not work as you might expect." ) |
113
|
|
|
|
|
|
|
if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ ); |
114
|
|
|
|
|
|
|
}; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# This has to be different since the first param to ->header is the header name and presumably |
117
|
|
|
|
|
|
|
# you should be able to request the header even after finalization, just not try to change it. |
118
|
|
|
|
|
|
|
before 'header' => sub { |
119
|
|
|
|
|
|
|
my $self = shift; |
120
|
|
|
|
|
|
|
my $header = shift; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
$self->_context->log->warn( |
123
|
|
|
|
|
|
|
"Useless setting a header value after finalize_headers and the response callback has been called." . |
124
|
|
|
|
|
|
|
" Since we don't support tail headers this will not work as you might expect." ) |
125
|
|
|
|
|
|
|
if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ ); |
126
|
|
|
|
|
|
|
}; |
127
|
|
|
|
|
|
|
|
128
|
128
|
|
|
128
|
1
|
3807
|
sub output { shift->body(@_) } |
129
|
|
|
|
|
|
|
|
130
|
3
|
|
|
3
|
1
|
18
|
sub code { shift->status(@_) } |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub write { |
133
|
31
|
|
|
31
|
1
|
87
|
my ( $self, $buffer ) = @_; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# Finalize headers if someone manually writes output |
136
|
31
|
100
|
|
|
|
879
|
$self->_context->finalize_headers unless $self->finalized_headers; |
137
|
|
|
|
|
|
|
|
138
|
31
|
100
|
|
|
|
96
|
$buffer = q[] unless defined $buffer; |
139
|
|
|
|
|
|
|
|
140
|
31
|
100
|
|
|
|
123
|
if($self->encodable_response) { |
141
|
18
|
|
|
|
|
544
|
$buffer = $self->_context->encoding->encode( $buffer, $self->_context->_encode_check ) |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
31
|
|
|
|
|
82
|
my $len = length($buffer); |
145
|
31
|
|
|
|
|
945
|
$self->_writer->write($buffer); |
146
|
|
|
|
|
|
|
|
147
|
31
|
|
|
|
|
1320
|
return $len; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub unencoded_write { |
151
|
3
|
|
|
3
|
1
|
15
|
my ( $self, $buffer ) = @_; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# Finalize headers if someone manually writes output |
154
|
3
|
50
|
|
|
|
89
|
$self->_context->finalize_headers unless $self->finalized_headers; |
155
|
|
|
|
|
|
|
|
156
|
3
|
50
|
|
|
|
13
|
$buffer = q[] unless defined $buffer; |
157
|
|
|
|
|
|
|
|
158
|
3
|
|
|
|
|
9
|
my $len = length($buffer); |
159
|
3
|
|
|
|
|
79
|
$self->_writer->write($buffer); |
160
|
|
|
|
|
|
|
|
161
|
3
|
|
|
|
|
695
|
return $len; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub finalize_headers { |
165
|
925
|
|
|
925
|
1
|
2584
|
my ($self) = @_; |
166
|
925
|
|
|
|
|
1984
|
return; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub from_psgi_response { |
170
|
44
|
|
|
44
|
1
|
1553
|
my ($self, $psgi_res) = @_; |
171
|
44
|
100
|
66
|
|
|
278
|
if(blessed($psgi_res) && $psgi_res->can('as_psgi')) { |
172
|
1
|
|
|
|
|
6
|
$psgi_res = $psgi_res->as_psgi; |
173
|
|
|
|
|
|
|
} |
174
|
44
|
100
|
|
|
|
224
|
if(ref $psgi_res eq 'ARRAY') { |
|
|
50
|
|
|
|
|
|
175
|
36
|
|
|
|
|
91
|
my ($status, $headers, $body) = @$psgi_res; |
176
|
36
|
|
|
|
|
191
|
$self->status($status); |
177
|
36
|
|
|
|
|
173
|
$self->headers(HTTP::Headers->new(@$headers)); |
178
|
|
|
|
|
|
|
# Can be arrayref or filehandle... |
179
|
36
|
50
|
|
|
|
134
|
if(defined $body) { # probably paranoia |
180
|
36
|
100
|
|
|
|
1213
|
ref $body eq 'ARRAY' ? $self->body(join('', @$body)) : $self->body($body); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} elsif(ref $psgi_res eq 'CODE') { |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# Its not clear to me this is correct. Right now if the PSGI application wants |
185
|
|
|
|
|
|
|
# to stream, we stream immediately and then completely bypass the rest of the |
186
|
|
|
|
|
|
|
# Catalyst finalization process (unlike if the PSGI app sets an arrayref). Part of |
187
|
|
|
|
|
|
|
# me thinks we should override the current _response_cb and then let finalize_body |
188
|
|
|
|
|
|
|
# call that. I'm not sure the downside of bypassing those bits. I'm going to leave |
189
|
|
|
|
|
|
|
# this be for now and document the behavior. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
$psgi_res->(sub { |
192
|
8
|
|
|
8
|
|
910
|
my $response = shift; |
193
|
8
|
|
|
|
|
62
|
my ($status, $headers, $maybe_body) = @$response; |
194
|
8
|
|
|
|
|
47
|
$self->status($status); |
195
|
8
|
|
|
|
|
50
|
$self->headers(HTTP::Headers->new(@$headers)); |
196
|
8
|
100
|
|
|
|
48
|
if(defined $maybe_body) { |
197
|
|
|
|
|
|
|
# Can be arrayref or filehandle... |
198
|
5
|
50
|
|
|
|
191
|
ref $maybe_body eq 'ARRAY' ? $self->body(join('', @$maybe_body)) : $self->body($maybe_body); |
199
|
|
|
|
|
|
|
} else { |
200
|
3
|
|
|
|
|
97
|
return $self->write_fh; |
201
|
|
|
|
|
|
|
} |
202
|
8
|
|
|
|
|
72
|
}); |
203
|
|
|
|
|
|
|
} else { |
204
|
0
|
|
|
|
|
0
|
die "You can't set a Catalyst response from that, expect a valid PSGI response"; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# Encoding compatibilty. If the response set a charset, well... we need |
208
|
|
|
|
|
|
|
# to assume its properly encoded and NOT encode for this response. Otherwise |
209
|
|
|
|
|
|
|
# We risk double encoding. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# We check first to make sure headers have not been finalized. Headers might be finalized |
212
|
|
|
|
|
|
|
# in the case where a PSGI response is streaming and the PSGI application already wrote |
213
|
|
|
|
|
|
|
# to the output stream and close the filehandle. |
214
|
44
|
100
|
100
|
|
|
2004
|
if(!$self->finalized_headers && $self->content_type_charset) { |
215
|
|
|
|
|
|
|
# We have to do this since for backcompat reasons having a charset doesn't always |
216
|
|
|
|
|
|
|
# mean that the body is already encoded :( |
217
|
1
|
|
|
|
|
148
|
$self->_context->clear_encoding; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head1 NAME |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Catalyst::Response - stores output responding to the current client request |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head1 SYNOPSIS |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
$res = $c->response; |
228
|
|
|
|
|
|
|
$res->body; |
229
|
|
|
|
|
|
|
$res->code; |
230
|
|
|
|
|
|
|
$res->content_encoding; |
231
|
|
|
|
|
|
|
$res->content_length; |
232
|
|
|
|
|
|
|
$res->content_type; |
233
|
|
|
|
|
|
|
$res->cookies; |
234
|
|
|
|
|
|
|
$res->header; |
235
|
|
|
|
|
|
|
$res->headers; |
236
|
|
|
|
|
|
|
$res->output; |
237
|
|
|
|
|
|
|
$res->redirect; |
238
|
|
|
|
|
|
|
$res->status; |
239
|
|
|
|
|
|
|
$res->write; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head1 DESCRIPTION |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
This is the Catalyst Response class, which provides methods for responding to |
244
|
|
|
|
|
|
|
the current client request. The appropriate L<Catalyst::Engine> for your environment |
245
|
|
|
|
|
|
|
will turn the Catalyst::Response into a HTTP Response and return it to the client. |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head1 METHODS |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=head2 $res->body( $text | $fh | $iohandle_object ) |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
$c->response->body('Catalyst rocks!'); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
Sets or returns the output (text or binary data). If you are returning a large body, |
254
|
|
|
|
|
|
|
you might want to use a L<IO::Handle> type of object (Something that implements the getline method |
255
|
|
|
|
|
|
|
in the same fashion), or a filehandle GLOB. These will be passed down to the PSGI |
256
|
|
|
|
|
|
|
handler you are using and might be optimized using server specific abilities (for |
257
|
|
|
|
|
|
|
example L<Twiggy> will attempt to server a real local file in a non blocking manner). |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
If you are using a filehandle as the body response you are responsible for |
260
|
|
|
|
|
|
|
making sure it conforms to the L<PSGI> specification with regards to content |
261
|
|
|
|
|
|
|
encoding. Unlike with scalar body values or when using the streaming interfaces |
262
|
|
|
|
|
|
|
we currently do not attempt to normalize and encode your filehandle. In general |
263
|
|
|
|
|
|
|
this means you should be sure to be sending bytes not UTF8 decoded multibyte |
264
|
|
|
|
|
|
|
characters. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Most of the time when you do: |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
open(my $fh, '<:raw', $path); |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
You should be fine. If you open a filehandle with a L<PerlIO> layer you probably |
271
|
|
|
|
|
|
|
are not fine. You can usually fix this by explicitly using binmode to set |
272
|
|
|
|
|
|
|
the IOLayer to :raw. Its possible future versions of L<Catalyst> will try to |
273
|
|
|
|
|
|
|
'do the right thing'. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
When using a L<IO::Handle> type of object and no content length has been |
276
|
|
|
|
|
|
|
already set in the response headers Catalyst will make a reasonable attempt |
277
|
|
|
|
|
|
|
to determine the size of the Handle. Depending on the implementation of your |
278
|
|
|
|
|
|
|
handle object, setting the content length may fail. If it is at all possible |
279
|
|
|
|
|
|
|
for you to determine the content length of your handle object, |
280
|
|
|
|
|
|
|
it is recommended that you set the content length in the response headers |
281
|
|
|
|
|
|
|
yourself, which will be respected and sent by Catalyst in the response. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Please note that the object needs to implement C<getline>, not just |
284
|
|
|
|
|
|
|
C<read>. Older versions of L<Catalyst> expected your filehandle like objects |
285
|
|
|
|
|
|
|
to do read. If you have code written for this expectation and you cannot |
286
|
|
|
|
|
|
|
change the code to meet the L<PSGI> specification, you can try the following |
287
|
|
|
|
|
|
|
middleware L<Plack::Middleware::AdaptFilehandleRead> which will attempt to |
288
|
|
|
|
|
|
|
wrap your object in an interface that so conforms. |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Starting from version 5.90060, when using an L<IO::Handle> object, you |
291
|
|
|
|
|
|
|
may want to use L<Plack::Middleware::XSendfile>, to delegate the |
292
|
|
|
|
|
|
|
actual serving to the frontend server. To do so, you need to pass to |
293
|
|
|
|
|
|
|
C<body> an IO object with a C<path> method. This can be achieved in |
294
|
|
|
|
|
|
|
two ways. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
Either using L<Plack::Util>: |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
my $fh = IO::File->new($file, 'r'); |
299
|
|
|
|
|
|
|
Plack::Util::set_io_path($fh, $file); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
Or using L<IO::File::WithPath> |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
my $fh = IO::File::WithPath->new($file, 'r'); |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
And then passing the filehandle to body and setting headers, if needed. |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
$c->response->body($fh); |
308
|
|
|
|
|
|
|
$c->response->headers->content_type('text/plain'); |
309
|
|
|
|
|
|
|
$c->response->headers->content_length(-s $file); |
310
|
|
|
|
|
|
|
$c->response->headers->last_modified((stat($file))[9]); |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
L<Plack::Middleware::XSendfile> can be loaded in the application so: |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
__PACKAGE__->config( |
315
|
|
|
|
|
|
|
psgi_middleware => [ |
316
|
|
|
|
|
|
|
'XSendfile', |
317
|
|
|
|
|
|
|
# other middlewares here... |
318
|
|
|
|
|
|
|
], |
319
|
|
|
|
|
|
|
); |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
B<Beware> that loading the middleware without configuring the |
322
|
|
|
|
|
|
|
webserver to set the request header C<X-Sendfile-Type> to a supported |
323
|
|
|
|
|
|
|
type (C<X-Accel-Redirect> for nginx, C<X-Sendfile> for Apache and |
324
|
|
|
|
|
|
|
Lighttpd), could lead to the disclosure of private paths to malicious |
325
|
|
|
|
|
|
|
clients setting that header. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
Nginx needs the additional X-Accel-Mapping header to be set in the |
328
|
|
|
|
|
|
|
webserver configuration, so the middleware will replace the absolute |
329
|
|
|
|
|
|
|
path of the IO object with the internal nginx path. This is also |
330
|
|
|
|
|
|
|
useful to prevent a buggy app to server random files from the |
331
|
|
|
|
|
|
|
filesystem, as it's an internal redirect. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
An nginx configuration for FastCGI could look so: |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
server { |
336
|
|
|
|
|
|
|
server_name example.com; |
337
|
|
|
|
|
|
|
root /my/app/root; |
338
|
|
|
|
|
|
|
location /private/repo/ { |
339
|
|
|
|
|
|
|
internal; |
340
|
|
|
|
|
|
|
alias /my/app/repo/; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
location /private/staging/ { |
343
|
|
|
|
|
|
|
internal; |
344
|
|
|
|
|
|
|
alias /my/app/staging/; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
location @proxy { |
347
|
|
|
|
|
|
|
include /etc/nginx/fastcgi_params; |
348
|
|
|
|
|
|
|
fastcgi_param SCRIPT_NAME ''; |
349
|
|
|
|
|
|
|
fastcgi_param PATH_INFO $fastcgi_script_name; |
350
|
|
|
|
|
|
|
fastcgi_param HTTP_X_SENDFILE_TYPE X-Accel-Redirect; |
351
|
|
|
|
|
|
|
fastcgi_param HTTP_X_ACCEL_MAPPING /my/app=/private; |
352
|
|
|
|
|
|
|
fastcgi_pass unix:/my/app/run/app.sock; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
In the example above, passing filehandles with a local path matching |
357
|
|
|
|
|
|
|
/my/app/staging or /my/app/repo will be served by nginx. Passing paths |
358
|
|
|
|
|
|
|
with other locations will lead to an internal server error. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
Setting the body to a filehandle without the C<path> method bypasses |
361
|
|
|
|
|
|
|
the middleware completely. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
For Apache and Lighttpd, the mapping doesn't apply and setting the |
364
|
|
|
|
|
|
|
X-Sendfile-Type is enough. |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=head2 $res->has_body |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
Predicate which returns true when a body has been set. |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head2 $res->code |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Alias for $res->status. |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=head2 $res->content_encoding |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
Shortcut for $res->headers->content_encoding. |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=head2 $res->content_length |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
Shortcut for $res->headers->content_length. |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head2 $res->content_type |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Shortcut for $res->headers->content_type. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
This value is typically set by your view or plugin. For example, |
387
|
|
|
|
|
|
|
L<Catalyst::Plugin::Static::Simple> will guess the mime type based on the file |
388
|
|
|
|
|
|
|
it found, while L<Catalyst::View::TT> defaults to C<text/html>. |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 $res->content_type_charset |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Shortcut for $res->headers->content_type_charset; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=head2 $res->cookies |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
Returns a reference to a hash containing cookies to be set. The keys of the |
397
|
|
|
|
|
|
|
hash are the cookies' names, and their corresponding values are hash |
398
|
|
|
|
|
|
|
references used to construct a L<CGI::Simple::Cookie> object. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
$c->response->cookies->{foo} = { value => '123' }; |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
The keys of the hash reference on the right correspond to the L<CGI::Simple::Cookie> |
403
|
|
|
|
|
|
|
parameters of the same name, except they are used without a leading dash. |
404
|
|
|
|
|
|
|
Possible parameters are: |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=over |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=item value |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=item expires |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=item domain |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item path |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=item secure |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=item httponly |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=back |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=head2 $res->header |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
Shortcut for $res->headers->header. |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=head2 $res->headers |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Returns an L<HTTP::Headers> object, which can be used to set headers. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
$c->response->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head2 $res->output |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
Alias for $res->body. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=head2 $res->redirect( $url, $status ) |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
Causes the response to redirect to the specified URL. The default status is |
439
|
|
|
|
|
|
|
C<302>. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
$c->response->redirect( 'http://slashdot.org' ); |
442
|
|
|
|
|
|
|
$c->response->redirect( 'http://slashdot.org', 307 ); |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
This is a convenience method that sets the Location header to the |
445
|
|
|
|
|
|
|
redirect destination, and then sets the response status. You will |
446
|
|
|
|
|
|
|
want to C< return > or C<< $c->detach() >> to interrupt the normal |
447
|
|
|
|
|
|
|
processing flow if you want the redirect to occur straight away. |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
B<Note:> do not give a relative URL as $url, i.e: one that is not fully |
450
|
|
|
|
|
|
|
qualified (= C<http://...>, etc.) or that starts with a slash |
451
|
|
|
|
|
|
|
(= C</path/here>). While it may work, it is not guaranteed to do the right |
452
|
|
|
|
|
|
|
thing and is not a standard behaviour. You may opt to use uri_for() or |
453
|
|
|
|
|
|
|
uri_for_action() instead. |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
B<Note:> If $url is an object that does ->as_string (such as L<URI>, which is |
456
|
|
|
|
|
|
|
what you get from ->uri_for) we automatically call that to stringify. This |
457
|
|
|
|
|
|
|
should ease the common case usage |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
return $c->res->redirect( $c->uri_for(...)); |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=cut |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
sub redirect { |
464
|
939
|
|
|
939
|
1
|
2117
|
my $self = shift; |
465
|
|
|
|
|
|
|
|
466
|
939
|
100
|
|
|
|
2990
|
if (@_) { |
467
|
14
|
|
|
|
|
43
|
my $location = shift; |
468
|
14
|
|
50
|
|
|
84
|
my $status = shift || 302; |
469
|
|
|
|
|
|
|
|
470
|
14
|
100
|
66
|
|
|
127
|
if(blessed($location) && $location->can('as_string')) { |
471
|
4
|
|
|
|
|
41
|
$location = $location->as_string; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
14
|
|
|
|
|
466
|
$self->location($location); |
475
|
14
|
|
|
|
|
63
|
$self->status($status); |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
939
|
|
|
|
|
27253
|
return $self->location; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head2 $res->location |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
Sets or returns the HTTP 'Location'. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=head2 $res->status |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
Sets or returns the HTTP status. |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
$c->response->status(404); |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
$res->code is an alias for this, to match HTTP::Response->code. |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=head2 $res->write( $data ) |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
Writes $data to the output stream. Calling this method will finalize your |
496
|
|
|
|
|
|
|
headers and send the headers and status code response to the client (so changing |
497
|
|
|
|
|
|
|
them afterwards is a waste... be sure to set your headers correctly first). |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
You may call this as often as you want throughout your response cycle. You may |
500
|
|
|
|
|
|
|
even set a 'body' afterward. So for example you might write your HTTP headers |
501
|
|
|
|
|
|
|
and the HEAD section of your document and then set the body from a template |
502
|
|
|
|
|
|
|
driven from a database. In some cases this can seem to the client as if you had |
503
|
|
|
|
|
|
|
a faster overall response (but note that unless your server support chunked |
504
|
|
|
|
|
|
|
body your content is likely to get queued anyway (L<Starman> and most other |
505
|
|
|
|
|
|
|
http 1.1 webservers support this). |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
If there is an encoding set, we encode each line of the response (the default |
508
|
|
|
|
|
|
|
encoding is UTF-8). |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=head2 $res->unencoded_write( $data ) |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
Works just like ->write but we don't apply any content encoding to C<$data>. Use |
513
|
|
|
|
|
|
|
this if you are already encoding the $data or the data is arriving from an encoded |
514
|
|
|
|
|
|
|
storage. |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
=head2 $res->write_fh |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
Returns an instance of L<Catalyst::Response::Writer>, which is a lightweight |
519
|
|
|
|
|
|
|
decorator over the PSGI C<$writer> object (see L<PSGI.pod\Delayed-Response-and-Streaming-Body>). |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
In addition to proxying the C<write> and C<close> method from the underlying PSGI |
522
|
|
|
|
|
|
|
writer, this proxy object knows any application wide encoding, and provides a method |
523
|
|
|
|
|
|
|
C<write_encoded> that will properly encode your written lines based upon your |
524
|
|
|
|
|
|
|
encoding settings. By default in L<Catalyst> responses are UTF-8 encoded and this |
525
|
|
|
|
|
|
|
is the encoding used if you respond via C<write_encoded>. If you want to handle |
526
|
|
|
|
|
|
|
encoding yourself, you can use the C<write> method directly. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
Encoding only applies to content types for which it matters. Currently the following |
529
|
|
|
|
|
|
|
content types are assumed to need encoding: text (including HTML), xml and javascript. |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
We provide access to this object so that you can properly close over it for use in |
532
|
|
|
|
|
|
|
asynchronous and nonblocking applications. For example (assuming you are using a supporting |
533
|
|
|
|
|
|
|
server, like L<Twiggy>: |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
package AsyncExample::Controller::Root; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
use Moose; |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
BEGIN { extends 'Catalyst::Controller' } |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub prepare_cb { |
542
|
|
|
|
|
|
|
my $write_fh = pop; |
543
|
|
|
|
|
|
|
return sub { |
544
|
|
|
|
|
|
|
my $message = shift; |
545
|
|
|
|
|
|
|
$write_fh->write("Finishing: $message\n"); |
546
|
|
|
|
|
|
|
$write_fh->close; |
547
|
|
|
|
|
|
|
}; |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
sub anyevent :Local :Args(0) { |
551
|
|
|
|
|
|
|
my ($self, $c) = @_; |
552
|
|
|
|
|
|
|
my $cb = $self->prepare_cb($c->res->write_fh); |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
my $watcher; |
555
|
|
|
|
|
|
|
$watcher = AnyEvent->timer( |
556
|
|
|
|
|
|
|
after => 5, |
557
|
|
|
|
|
|
|
cb => sub { |
558
|
|
|
|
|
|
|
$cb->(scalar localtime); |
559
|
|
|
|
|
|
|
undef $watcher; # cancel circular-ref |
560
|
|
|
|
|
|
|
}); |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
Like the 'write' method, calling this will finalize headers. Unlike 'write' when you |
564
|
|
|
|
|
|
|
can this it is assumed you are taking control of the response so the body is never |
565
|
|
|
|
|
|
|
finalized (there isn't one anyway) and you need to call the close method. |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head2 $res->print( @data ) |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
Prints @data to the output stream, separated by $,. This lets you pass |
570
|
|
|
|
|
|
|
the response object to functions that want to write to an L<IO::Handle>. |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=head2 $res->finalize_headers() |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
Writes headers to response if not already written |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
=head2 from_psgi_response |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Given a PSGI response (either three element ARRAY reference OR coderef expecting |
579
|
|
|
|
|
|
|
a $responder) set the response from it. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
Properly supports streaming and delayed response and / or async IO if running |
582
|
|
|
|
|
|
|
under an expected event loop. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
If passed an object, will expect that object to do a method C<as_psgi>. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
Example: |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
package MyApp::Web::Controller::Test; |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
use base 'Catalyst::Controller'; |
591
|
|
|
|
|
|
|
use Plack::App::Directory; |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" }) |
595
|
|
|
|
|
|
|
->to_app; |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub myaction :Local Args { |
598
|
|
|
|
|
|
|
my ($self, $c) = @_; |
599
|
|
|
|
|
|
|
$c->res->from_psgi_response($app->($c->req->env)); |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
sub streaming_body :Local { |
603
|
|
|
|
|
|
|
my ($self, $c) = @_; |
604
|
|
|
|
|
|
|
my $psgi_app = sub { |
605
|
|
|
|
|
|
|
my $respond = shift; |
606
|
|
|
|
|
|
|
my $writer = $respond->([200,["Content-Type" => "text/plain"]]); |
607
|
|
|
|
|
|
|
$writer->write("body"); |
608
|
|
|
|
|
|
|
$writer->close; |
609
|
|
|
|
|
|
|
}; |
610
|
|
|
|
|
|
|
$c->res->from_psgi_response($psgi_app); |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Please note this does not attempt to map or nest your PSGI application under |
614
|
|
|
|
|
|
|
the Controller and Action namespace or path. You may wish to review 'PSGI Helpers' |
615
|
|
|
|
|
|
|
under L<Catalyst::Utils> for help in properly nesting applications. |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
B<NOTE> If your external PSGI application returns a response that has a character |
618
|
|
|
|
|
|
|
set associated with the content type (such as "text/html; charset=UTF-8") we set |
619
|
|
|
|
|
|
|
$c->clear_encoding to remove any additional content type encoding processing later |
620
|
|
|
|
|
|
|
in the application (this is done to avoid double encoding issues). |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
B<NOTE> If your external PSGI application is streaming, we assume you completely |
623
|
|
|
|
|
|
|
handle the entire jobs (including closing the stream). This will also bypass |
624
|
|
|
|
|
|
|
the output finalization methods on Catalyst (such as 'finalize_body' which gets |
625
|
|
|
|
|
|
|
called but then skipped when it finds that output is already finished.) Its possible |
626
|
|
|
|
|
|
|
this might cause issue with some plugins that want to do 'things' during those |
627
|
|
|
|
|
|
|
finalization methods. Just understand what is happening. |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=head2 encodable_content_type |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
This is a regular expression used to determine of the current content type |
632
|
|
|
|
|
|
|
should be considered encodable. Currently we apply default encoding (usually |
633
|
|
|
|
|
|
|
UTF8) to text type contents. Here's the default regular expression: |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
This would match content types like: |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
text/plain |
638
|
|
|
|
|
|
|
text/html |
639
|
|
|
|
|
|
|
text/xml |
640
|
|
|
|
|
|
|
application/javascript |
641
|
|
|
|
|
|
|
application/xml |
642
|
|
|
|
|
|
|
application/vnd.user+xml |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
B<NOTE>: We don't encode JSON content type responses by default since most |
645
|
|
|
|
|
|
|
of the JSON serializers that are commonly used for this task will do so |
646
|
|
|
|
|
|
|
automatically and we don't want to double encode. If you are not using a |
647
|
|
|
|
|
|
|
tool like L<JSON> to produce JSON type content, (for example you are using |
648
|
|
|
|
|
|
|
a template system, or creating the strings manually) you will need to either |
649
|
|
|
|
|
|
|
encoding the body yourself: |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
$c->response->body( $c->encoding->encode( $body, $c->_encode_check ) ); |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
Or you can alter the regular expression using this attribute. |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=head2 encodable_response |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
Given a L<Catalyst::Response> return true if its one that can be encoded. |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
make sure there is an encoding set on the response |
660
|
|
|
|
|
|
|
make sure the content type is encodable |
661
|
|
|
|
|
|
|
make sure no content type charset has been already set to something different from the global encoding |
662
|
|
|
|
|
|
|
make sure no content encoding is present. |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
Note this does not inspect a body since we do allow automatic encoding on streaming |
665
|
|
|
|
|
|
|
type responses. |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=cut |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
sub encodable_response { |
670
|
961
|
|
|
961
|
1
|
2614
|
my ($self) = @_; |
671
|
961
|
100
|
|
|
|
29802
|
return 0 unless $self->_context; # Cases like returning a HTTP Exception response you don't have a context here... |
672
|
954
|
100
|
|
|
|
26417
|
return 0 unless $self->_context->encoding; |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# The response is considered to have a 'manual charset' when a charset is already set on |
675
|
|
|
|
|
|
|
# the content type of the response AND it is not the same as the one we set in encoding. |
676
|
|
|
|
|
|
|
# If there is no charset OR we are asking for the one which is the same as the current |
677
|
|
|
|
|
|
|
# required encoding, that is a flag that we want Catalyst to encode the response automatically. |
678
|
922
|
|
|
|
|
2699
|
my $has_manual_charset = 0; |
679
|
922
|
100
|
|
|
|
3473
|
if(my $charset = $self->content_type_charset) { |
680
|
72
|
100
|
|
|
|
12331
|
$has_manual_charset = (uc($charset) ne uc($self->_context->encoding->mime_name)) ? 1:0; |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# Content type is encodable if it matches the regular expression stored in this attribute |
684
|
922
|
100
|
|
|
|
43464
|
my $encodable_content_type = $self->content_type =~ m/${\$self->encodable_content_type}/ ? 1:0; |
|
922
|
|
|
|
|
50365
|
|
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
# The content encoding is allowed (for charset encoding) only if its empty or is set to identity |
687
|
922
|
100
|
66
|
|
|
4120
|
my $allowed_content_encoding = (!$self->content_encoding || $self->content_encoding eq 'identity') ? 1:0; |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
# The content type must be an encodable type, and there must be NO manual charset and also |
690
|
|
|
|
|
|
|
# the content encoding must be the allowed values; |
691
|
922
|
100
|
100
|
|
|
43150
|
if( |
|
|
|
100
|
|
|
|
|
692
|
|
|
|
|
|
|
$encodable_content_type and |
693
|
|
|
|
|
|
|
!$has_manual_charset and |
694
|
|
|
|
|
|
|
$allowed_content_encoding |
695
|
|
|
|
|
|
|
) { |
696
|
244
|
|
|
|
|
7366
|
return 1; |
697
|
|
|
|
|
|
|
} else { |
698
|
678
|
|
|
|
|
3381
|
return 0; |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=head2 DEMOLISH |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Ensures that the response is flushed and closed at the end of the |
705
|
|
|
|
|
|
|
request. |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=head2 meta |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
Provided by Moose |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=cut |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub print { |
714
|
3
|
|
|
3
|
1
|
6
|
my $self = shift; |
715
|
3
|
|
|
|
|
7
|
my $data = shift; |
716
|
|
|
|
|
|
|
|
717
|
3
|
50
|
|
|
|
22
|
defined $self->write($data) or return; |
718
|
|
|
|
|
|
|
|
719
|
3
|
|
|
|
|
11
|
for (@_) { |
720
|
3
|
50
|
|
|
|
12
|
defined $self->write($,) or return; |
721
|
3
|
50
|
|
|
|
10
|
defined $self->write($_) or return; |
722
|
|
|
|
|
|
|
} |
723
|
3
|
50
|
|
|
|
11
|
defined $self->write($\) or return; |
724
|
|
|
|
|
|
|
|
725
|
3
|
|
|
|
|
17
|
return 1; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=head1 AUTHORS |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
Catalyst Contributors, see Catalyst.pm |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=head1 COPYRIGHT |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
This library is free software. You can redistribute it and/or modify |
735
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=cut |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
1; |