File Coverage

blib/lib/Dancer/Response.pm

Criterion	Covered	Total	%
statement	98	102	96.0
branch	14	18	77.7
condition	2	3	66.6
subroutine	27	27	100.0
pod	10	15	66.6
total	151	165	91.5

package Dancer::Response;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: Response object for Dancer
$Dancer::Response::VERSION = '1.3514_04'; # TRIAL
$Dancer::Response::VERSION = '1.351404';
use strict;
use warnings;
use Carp;

use base 'Dancer::Object';

use Scalar::Util qw/blessed/;
use Dancer::HTTP;
use Dancer::MIME;
use HTTP::Headers;
use Dancer::SharedData;
use Dancer::Exception qw(:all);
use Dancer::Continuation::Halted;

__PACKAGE__->attributes(qw/content pass streamed/);

# constructor
sub init {
    my ( $self, %args ) = @_;
    $self->attributes_defaults(
        status  => 200,
        content => '',
        pass    => 0,
        halted  => 0,
        forward => '',
        encoded => 0,
    );
    $self->{headers} = HTTP::Headers->new(@{ $args{headers} || [] });
    Dancer::SharedData->response($self);
}

# helpers for the route handlers
sub exists {
    my $self = shift;
    return length($self->content);
}

sub status {
    my $self = shift;

    if (scalar @_ > 0) {
        my $status = shift;
        my $numeric_status = Dancer::HTTP->status($status);
        if ($numeric_status) {
            return $self->{status} = $numeric_status;
        } else {
            carp "Unrecognised HTTP status $status";
            return;
        }
    } else {
        return $self->{status};
    }
}

sub content_type {
    my $self = shift;

    if (scalar @_ > 0) {
        my $mimetype = Dancer::MIME->instance();
        $self->header('Content-Type' => $mimetype->name_or_type(shift));
    } else {
        return $self->header('Content-Type');
    }
}

sub has_passed {
    my $self = shift;
    return $self->pass;
}

sub forward {
    my ($self, $uri, $params, $opts) = @_;
    $self->{forward} = { to_url  => $uri,
                         params  => $params,
                         options => $opts };
}

sub is_forwarded {
    my $self = shift;
    $self->{forward};
}

sub _already_encoded {
    my $self = shift;
    $self->{encoded};
}

sub halt {
    my ($self, $content) = @_;

    if ( blessed($content) && $content->isa('Dancer::Response') ) {
        $content->{halted} = 1;
        Dancer::SharedData->response($content);
    }
    else {
        $self->content($content) if defined $content;
        $self->{halted} = 1;
    }
}

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

sub header {
    my $self   = shift;
    my $header = shift;

    if (@_) {
        $self->{headers}->header( $header => @_ );
    }
    else {
        return $self->{headers}->header($header);
    }
}

sub push_header {
    my $self   = shift;
    my $header = shift;

    if (@_) {
        foreach my $h(@_) {
            $self->{headers}->push_header( $header => $h );
        }
    }
    else {
        return $self->{headers}->header($header);
    }
}

sub headers {
    my $self = shift;
    $self->{headers}->header(@_);
}

sub headers_to_array {
    my $self = shift;

    # Time to finalise cookie headers, now
    $self->build_cookie_headers;

    my $headers = [
        map {
            my $k = $_;
            map {
                my $v = $_;
                $v =~ s/^(.+)\r?\n(.*)$/$1\r\n $2/;
                ( $k => $v )
            } $self->{headers}->header($_);
          } $self->{headers}->header_field_names
    ];

    return $headers;
}

# Given a cookie name and object, add it to the cookies we're going to send.
# Stores them in a hashref within the response object until the response is
# being built, so that, if the same cookie is set multiple times, only the last
# value given to it will appear in a Set-Cookie header.
sub add_cookie {
    my ($self, $name, $cookie) = @_;
    if ($self->{_built_cookies}) {
        die "Too late to set another cookie, headers already built";
    }
    $self->{_cookies}{$name} = $cookie;
}


# When the response is about to be rendered, that's when we build up the
# Set-Cookie headers
sub build_cookie_headers {
    my $self = shift;
    for my $name (keys %{ $self->{_cookies} }) {
        my $header = $self->{_cookies}{$name}->to_header;
        $self->push_header(
            'Set-Cookie' => $header,
        );
    }
    $self->{_built_cookies}++;
}
1;

__END__