File Coverage

blib/lib/AnyEvent/HTTP/Request.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	7	8	87.5
condition	1	2	50.0
subroutine	15	15	100.0
pod	11	11	100.0
total	82	84	97.6

# 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::Request;
{
  $AnyEvent::HTTP::Request::VERSION = '0.302';
}
BEGIN {
  $AnyEvent::HTTP::Request::AUTHORITY = 'cpan:RWSTAUNER';
}
# ABSTRACT: HTTP Request object for AnyEvent::HTTP

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


sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);

  $self->{method} = uc $self->{method};

  return $self;
}


sub parse_args {
  my $self = shift;

  $self->_error(
    q[expects an odd number of arguments:],
    q[($method, $uri, (key => value, ...)*, \&callback)]
  )
    unless @_ & 1; ## no critic BitwiseOperators

  my $args = {
    method => shift,
    uri    => shift,
    cb     => pop,
    params => { @_ },
  };

  # remove these from params
  $args->{$_} = delete $args->{params}{$_}
    for qw( body headers );

  return $args;
}


sub from_http_message {
  my ($self, $req, $extra) = @_;
  my $args = {
    method  => $req->method,
    uri     => $req->uri,
    headers => $self->_hash_http_headers($req->headers),
    body    => $req->content,
    (ref($extra) eq 'HASH' ? %$extra : ()),
  };

  # rt-85665: AE:H will provide it's own content-length.
  # If you provide your own it may persist incorrectly across redirects.
  delete $args->{headers}{$_}
    for qw( content-length );

  return $args;
}


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


sub method  { $_[0]->{method} }
sub uri     { $_[0]->{uri}    }
sub cb      {
  my $self = shift;
  $self->_error(
    q[cb() is a read-only accessor (for consistency and to avoid confusion).],
    q[To execute the callback dereference it or use respond_with().]
  )
    if @_;
  return $self->{cb};
}
sub params  { $_[0]->{params} ||= {} }


sub respond_with {
  my $self = shift;
  my ($res) = @_; # don't shift
  require AnyEvent::HTTP::Response;
  $res =  AnyEvent::HTTP::Response->new(@_)
    unless do { local $@; eval { $res->isa('AnyEvent::HTTP::Response') } };
  return $self->cb->($res->args);
}


sub send {
  my ($self) = @_;
  require AnyEvent::HTTP;
  # circumvent the sub's prototype
  &AnyEvent::HTTP::http_request( $self->args );
}


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

  my $res = HTTP::Request->new(
    $self->method,
    $self->uri,
    [ %{ $self->headers } ],
    $self->body
  );
  return $res;
}

1;

__END__