File Coverage

blib/lib/AnyEvent/HTTP/Response.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	5	6	83.3
condition	3	4	75.0
subroutine	9	9	100.0
pod	5	5	100.0
total	63	65	96.9

# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
#
# This file is part of AnyEvent-HTTP-Message
#
# This software is copyright (c) 2012 by Randy Stauner.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;

package AnyEvent::HTTP::Response;
{
  $AnyEvent::HTTP::Response::VERSION = '0.302';
}
BEGIN {
  $AnyEvent::HTTP::Response::AUTHORITY = 'cpan:RWSTAUNER';
}
# ABSTRACT: HTTP Response object for AnyEvent::HTTP

use parent 'AnyEvent::HTTP::Message';


sub args {
  my ($self) = @_;
  return (
    $self->body,
    {
      %{ $self->headers },
      %{ $self->pseudo_headers },
    },
  );
}


sub parse_args {
  my $self = shift;
  $self->_error(
    q[expects two arguments: ($content_body, \%headers)]
  )
    unless @_ == 2;

  my $args  = {
    body    =>      $_[0],
  };

  my %headers = %{ $_[1] };
  my %pseudo;
  {
    my @pseudo = grep { /^[A-Z]/ } keys %headers;
    # remove the ae-http pseudo-headers (init-capped)
    @pseudo{ @pseudo } = delete @headers{ @pseudo };
  }
  @$args{qw(headers pseudo_headers)} = (\%headers, \%pseudo);

  return $args;
}


sub from_http_message {
  my ($self, $res) = @_;
  my $args = {
    body => $res->${\ ($res->can('decoded_content') || 'content') },
    pseudo_headers => {
      Status => $res->code,
      Reason => $res->message,
    },
    headers => $self->_hash_http_headers($res->headers),
  };
  if( my $proto = $res->protocol ){
    # regexp taken straight from AnyEvent::HTTP 2.13
    $args->{pseudo_headers}{HTTPVersion} = ($proto =~ /^HTTP\/0*([0-9\.]+)/)[0];
  }

  return $args;
}


sub pseudo_headers { $_[0]->{pseudo_headers} ||= {} }


sub to_http_message {
  my ($self) = @_;
  require HTTP::Response;

  my $res = HTTP::Response->new(
    @{ $self->pseudo_headers }{qw(Status Reason)},
    [ %{ $self->headers } ],
    $self->body
  );
  if( my $v = $self->pseudo_headers->{HTTPVersion} ){
    $res->protocol("HTTP/$v")
  }
  return $res;
}

1;

__END__