1package Dancer::Response;
2our $AUTHORITY = 'cpan:SUKRIA';
3#ABSTRACT: Response object for Dancer
4$Dancer::Response::VERSION = '1.3513';
5use strict;
6use warnings;
7use Carp;
8
9use base 'Dancer::Object';
10
11use Scalar::Util qw/blessed/;
12use Dancer::HTTP;
13use Dancer::MIME;
14use HTTP::Headers;
15use Dancer::SharedData;
16use Dancer::Exception qw(:all);
17use Dancer::Continuation::Halted;
18
19__PACKAGE__->attributes(qw/content pass streamed/);
20
21# constructor
22sub init {
23    my ( $self, %args ) = @_;
24    $self->attributes_defaults(
25        status  => 200,
26        content => '',
27        pass    => 0,
28        halted  => 0,
29        forward => '',
30        encoded => 0,
31    );
32    $self->{headers} = HTTP::Headers->new(@{ $args{headers} || [] });
33    Dancer::SharedData->response($self);
34}
35
36# helpers for the route handlers
37sub exists {
38    my $self = shift;
39    return length($self->content);
40}
41
42sub status {
43    my $self = shift;
44
45    if (scalar @_ > 0) {
46        my $status = shift;
47        my $numeric_status = Dancer::HTTP->status($status);
48        if ($numeric_status) {
49            return $self->{status} = $numeric_status;
50        } else {
51            carp "Unrecognised HTTP status $status";
52            return;
53        }
54    } else {
55        return $self->{status};
56    }
57}
58
59sub content_type {
60    my $self = shift;
61
62    if (scalar @_ > 0) {
63        my $mimetype = Dancer::MIME->instance();
64        $self->header('Content-Type' => $mimetype->name_or_type(shift));
65    } else {
66        return $self->header('Content-Type');
67    }
68}
69
70sub has_passed {
71    my $self = shift;
72    return $self->pass;
73}
74
75sub forward {
76    my ($self, $uri, $params, $opts) = @_;
77    $self->{forward} = { to_url  => $uri,
78                         params  => $params,
79                         options => $opts };
80}
81
82sub is_forwarded {
83    my $self = shift;
84    $self->{forward};
85}
86
87sub _already_encoded {
88    my $self = shift;
89    $self->{encoded};
90}
91
92sub halt {
93    my ($self, $content) = @_;
94
95    if ( blessed($content) && $content->isa('Dancer::Response') ) {
96        $content->{halted} = 1;
97        Dancer::SharedData->response($content);
98    }
99    else {
100        $self->content($content) if defined $content;
101        $self->{halted} = 1;
102    }
103}
104
105sub halted {
106    my $self = shift;
107    return $self->{halted}
108}
109
110sub header {
111    my $self   = shift;
112    my $header = shift;
113
114    if (@_) {
115        $self->{headers}->header( $header => @_ );
116    }
117    else {
118        return $self->{headers}->header($header);
119    }
120}
121
122sub push_header {
123    my $self   = shift;
124    my $header = shift;
125
126    if (@_) {
127        foreach my $h(@_) {
128            $self->{headers}->push_header( $header => $h );
129        }
130    }
131    else {
132        return $self->{headers}->header($header);
133    }
134}
135
136sub headers {
137    my $self = shift;
138    $self->{headers}->header(@_);
139}
140
141sub headers_to_array {
142    my $self = shift;
143
144    # Time to finalise cookie headers, now
145    $self->build_cookie_headers;
146
147    my $headers = [
148        map {
149            my $k = $_;
150            map {
151                my $v = $_;
152                $v =~ s/^(.+)\r?\n(.*)$/$1\r\n $2/;
153                ( $k => $v )
154            } $self->{headers}->header($_);
155          } $self->{headers}->header_field_names
156    ];
157
158    return $headers;
159}
160
161# Given a cookie name and object, add it to the cookies we're going to send.
162# Stores them in a hashref within the response object until the response is
163# being built, so that, if the same cookie is set multiple times, only the last
164# value given to it will appear in a Set-Cookie header.
165sub add_cookie {
166    my ($self, $name, $cookie) = @_;
167    if ($self->{_built_cookies}) {
168        die "Too late to set another cookie, headers already built";
169    }
170    $self->{_cookies}{$name} = $cookie;
171}
172
173
174# When the response is about to be rendered, that's when we build up the
175# Set-Cookie headers
176sub build_cookie_headers {
177    my $self = shift;
178    for my $name (keys %{ $self->{_cookies} }) {
179        my $header = $self->{_cookies}{$name}->to_header;
180        $self->push_header(
181            'Set-Cookie' => $header,
182        );
183    }
184    $self->{_built_cookies}++;
185}
1861;
187
188__END__
189
190=pod
191
192=encoding UTF-8
193
194=head1 NAME
195
196Dancer::Response - Response object for Dancer
197
198=head1 VERSION
199
200version 1.3513
201
202=head1 SYNOPSIS
203
204    # create a new response object
205    Dancer::Response->new(
206        status => 200,
207        content => 'this is my content'
208    );
209
210    Dancer::SharedData->response->status; # 200
211
212    # fetch current response object
213    my $response = Dancer::SharedData->response;
214
215    # fetch the current status
216    $response->status; # 200
217
218    # change the status
219    $response->status(500);
220
221=head1 PUBLIC API
222
223=head2 new
224
225    Dancer::Response->new(
226        status  => 200,
227        content => 'my content',
228        headers => ['X-Foo' => 'foo-value', 'X-Bar' => 'bar-value'],
229    );
230
231create and return a new Dancer::Response object
232
233=head2 current
234
235    my $response = Dancer::SharedData->response->current();
236
237return the current Dancer::Response object, and reset the object
238
239=head2 exists
240
241    if ($response->exists) {
242        ...
243    }
244
245test if the Dancer::Response object exists
246
247=head2 content
248
249    # get the content
250    my $content = $response->content;
251    my $content = Dancer::SharedData->response->content;
252
253    # set the content
254    $response->content('my new content');
255    Dancer::SharedData->response->content('my new content');
256
257set or get the content of the current response object
258
259=head2 status
260
261    # get the status
262    my $status = $response->status;
263    my $status = Dancer::SharedData->response->status;
264
265    # set the status
266    $response->status(201);
267    Dancer::SharedData->response->status(201);
268
269Set or get the status of the current response object.  The default status is 200.
270
271=head2 content_type
272
273    # get the status
274    my $ct = $response->content_type;
275    my $ct = Dancer::SharedData->response->content_type;
276
277    # set the status
278    $response->content_type('application/json');
279    Dancer::SharedData->response->content_type('application/json');
280
281Set or get the status of the current response object.
282
283=head2 pass
284
285    $response->pass;
286    Dancer::SharedData->response->pass;
287
288Set the pass value to one for this response.
289
290=head2 has_passed
291
292    if ($response->has_passed) {
293        ...
294    }
295
296    if (Dancer::SharedData->response->has_passed) {
297        ...
298    }
299
300Test if the pass value is set to true.
301
302=head2 halt($content)
303
304    Dancer::SharedData->response->halt();
305    $response->halt;
306
307Stops the processing of the current request.  See L<Dancer/halt>.
308
309=head2 halted
310
311    if (Dancer::SharedData->response->halted) {
312       ...
313    }
314
315    if ($response->halted) {
316        ...
317    }
318
319This flag will be true if the current response has been halted.
320
321=head2 header
322
323    # set the header
324    $response->header('X-Foo' => 'bar');
325    Dancer::SharedData->response->header('X-Foo' => 'bar');
326
327    # get the header
328    my $header = $response->header('X-Foo');
329    my $header = Dancer::SharedData->response->header('X-Foo');
330
331Get or set the value of a header.
332
333=head2 headers
334
335    $response->headers('X-Foo' => 'fff', 'X-Bar' => 'bbb');
336    Dancer::SharedData->response->headers('X-Foo' => 'fff', 'X-Bar' => 'bbb');
337
338Return the list of headers for the current response.
339
340=head2 headers_to_array
341
342    my $headers_psgi = $response->headers_to_array();
343    my $headers_psgi = Dancer::SharedData->response->headers_to_array();
344
345This method is called before returning a L<< PSGI >> response. It transforms the list of headers to an array reference.
346
347=head1 AUTHOR
348
349Dancer Core Developers
350
351=head1 COPYRIGHT AND LICENSE
352
353This software is copyright (c) 2010 by Alexis Sukrieh.
354
355This is free software; you can redistribute it and/or modify it under
356the same terms as the Perl 5 programming language system itself.
357
358=cut
359