Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

283 lines (203 sloc) 6.469 kB
package Plack::Response;
use strict;
use warnings;
our $VERSION = '0.9951';
$VERSION = eval $VERSION;
use Plack::Util::Accessor qw(body status);
use Carp ();
use Scalar::Util ();
use HTTP::Headers;
use URI::Escape ();
sub code { shift->status(@_) }
sub content { shift->body(@_) }
sub new {
my($class, $rc, $headers, $content) = @_;
my $self = bless {}, $class;
$self->status($rc) if defined $rc;
$self->headers($headers) if defined $headers;
$self->body($content) if defined $content;
$self;
}
sub headers {
my $self = shift;
if (@_) {
my $headers = shift;
if (ref $headers eq 'ARRAY') {
Carp::carp("Odd number of headers") if @$headers % 2 != 0;
$headers = HTTP::Headers->new(@$headers);
} elsif (ref $headers eq 'HASH') {
$headers = HTTP::Headers->new(%$headers);
}
return $self->{headers} = $headers;
} else {
return $self->{headers} ||= HTTP::Headers->new();
}
}
sub cookies {
my $self = shift;
if (@_) {
$self->{cookies} = shift;
} else {
return $self->{cookies} ||= +{ };
}
}
sub header { shift->headers->header(@_) } # shortcut
sub content_length {
shift->headers->content_length(@_);
}
sub content_type {
shift->headers->content_type(@_);
}
sub content_encoding {
shift->headers->content_encoding(@_);
}
sub location {
shift->headers->header('Location' => @_);
}
sub redirect {
my $self = shift;
if (@_) {
my $url = shift;
my $status = shift || 302;
$self->location($url);
$self->status($status);
}
return $self->location;
}
sub finalize {
my $self = shift;
Carp::croak "missing status" unless $self->status();
$self->_finalize_cookies();
return [
$self->status,
+[
map {
my $k = $_;
map { ( $k => $_ ) } $self->headers->header($_);
} $self->headers->header_field_names
],
$self->_body,
];
}
sub _body {
my $self = shift;
my $body = $self->body;
$body = [] unless defined $body;
if (!ref $body or Scalar::Util::blessed($body) && overload::Method($body, q("")) && !$body->can('getline')) {
return [ $body ];
} else {
return $body;
}
}
sub _finalize_cookies {
my $self = shift;
while (my($name, $val) = each %{$self->cookies}) {
my $cookie = $self->_bake_cookie($name, $val);
$self->headers->push_header( 'Set-Cookie' => $cookie );
}
}
sub _bake_cookie {
my($self, $name, $val) = @_;
return '' unless defined $val;
$val = { value => $val } unless ref $val eq 'HASH';
my @cookie = ( URI::Escape::uri_escape($name) . "=" . URI::Escape::uri_escape($val->{value}) );
push @cookie, "domain=" . $val->{domain} if $val->{domain};
push @cookie, "path=" . $val->{path} if $val->{path};
push @cookie, "expires=" . $self->_date($val->{expires}) if $val->{expires};
push @cookie, "secure" if $val->{secure};
push @cookie, "HttpOnly" if $val->{httponly};
return join "; ", @cookie;
}
my @MON = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
my @WDAY = qw( Sun Mon Tue Wed Thu Fri Sat );
sub _date {
my($self, $expires) = @_;
if ($expires =~ /^\d+$/) {
# all numbers -> epoch date
# (cookies use '-' as date separator, HTTP uses ' ')
my($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($expires);
$year += 1900;
return sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
$WDAY[$wday], $mday, $MON[$mon], $year, $hour, $min, $sec);
}
return $expires;
}
1;
__END__
=head1 NAME
Plack::Response - Portable HTTP Response object for PSGI response
=head1 SYNOPSIS
use Plack::Response;
sub psgi_handler {
my $env = shift;
my $res = Plack::Response->new(200);
$res->content_type('text/html');
$res->body("Hello World");
return $res->finalize;
}
=head1 DESCRIPTION
Plack::Response allows you a way to create PSGI response array ref through a simple API.
=head1 METHODS
=over 4
=item new
$res = Plack::Response->new;
$res = Plack::Response->new($status);
$res = Plack::Response->new($status, $headers);
$res = Plack::Response->new($status, $headers, $body);
Creates a new Plack::Response object.
=item status
$res->status(200);
$status = $res->status;
Sets and gets HTTP status code. C<code> is an alias.
=item headers
$headers = $res->headers;
$res->headers([ 'Content-Type' => 'text/html' ]);
$res->headers({ 'Content-Type' => 'text/html' });
$res->headers( HTTP::Headers->new );
Sets and gets HTTP headers of the response. Setter can take either an
array ref, a hash ref or L<HTTP::Headers> object containing a list of
headers.
=item body
$res->body($body_str);
$res->body([ "Hello", "World" ]);
$res->body($io);
Gets and sets HTTP response body. Setter can take either a string, an
array ref, or an IO::Handle-like object. C<content> is an alias.
=item header
$res->header('X-Foo' => 'bar');
my $val = $res->header('X-Foo');
Shortcut for C<< $res->headers->header >>.
=item content_type, content_length, content_encoding
$res->content_type('text/plain');
$res->content_length(123);
$res->content_encoding('gzip');
Shortcut for the equivalent get/set methods in C<< $res->headers >>.
=item redirect
$res->redirect($url);
$res->redirect($url, 301);
Sets redirect URL with an optional status code, which defaults to 302.
=item location
Gets and sets C<Location> header.
=item cookies
$res->cookies->{foo} = 123;
$res->cookies->{foo} = { value => '123' };
Returns a hash reference containing cookies to be set in the
response. The keys of the hash are the cookies' names, and their
corresponding values are a plain string (for C<value> with everything
else defaults) or a hash reference that can contain keys such as
C<value>, C<domain>, C<expires>, C<path>, C<httponly>, C<secure>.
C<expires> can take a string or an integer (as an epoch time) and
B<does not> convert string formats such as C<+3M>.
$res->cookies->{foo} = {
value => 'test',
path => "/",
domain => '.example.com',
expires => time + 24 * 60 * 60,
};
=back
=head1 AUTHOR
Tokuhiro Matsuno
Tatsuhiko Miyagawa
=head1 SEE ALSO
L<Plack::Request>
=cut
Jump to Line
Something went wrong with that request. Please try again.