File Coverage

blib/lib/Plack/Response.pm

Criterion	Covered	Total	%
statement	83	85	97.6
branch	21	24	87.5
condition	14	16	87.5
subroutine	23	25	92.0
pod	11	13	84.6
total	152	163	93.2

package Plack::Response;
use strict;
use warnings;
our $VERSION = '1.0054';

use Plack::Util::Accessor qw(body status);
use Carp ();
use Cookie::Baker ();
use Scalar::Util ();
use HTTP::Headers::Fast;
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::Fast->new(@$headers);
        } elsif (ref $headers eq 'HASH') {
            $headers = HTTP::Headers::Fast->new(%$headers);
        }
        return $self->{headers} = $headers;
    } else {
        return $self->{headers} ||= HTTP::Headers::Fast->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 {
    my $self = shift;
    return $self->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();

    my $headers = $self->headers;
    my @headers;
    $headers->scan(sub{
        my ($k,$v) = @_;
        $v =~ s/\015\012[\040|\011]+/chr(32)/ge; # replace LWS with a single SP
        $v =~ s/\015|\012//g; # remove CR and LF since the char is invalid here
        push @headers, $k, $v;
    });

    $self->_finalize_cookies(\@headers);

    return [
        $self->status,
        \@headers,
        $self->_body,
    ];
}

sub to_app {
    my $self = shift;
    return sub { $self->finalize };
}


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, $headers) = @_;

    foreach my $name ( keys %{ $self->cookies } ) {
        my $val = $self->cookies->{$name};

        my $cookie = Cookie::Baker::bake_cookie( $name, $val );
        push @$headers, 'Set-Cookie' => $cookie;
    }
}

1;
__END__