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