File Coverage

blib/lib/Test2/Tools/HTTP/Tx.pm

Criterion	Covered	Total	%
statement	50	54	92.5
branch	4	6	66.6
condition	2	6	33.3
subroutine	16	17	94.1
pod	8	8	100.0
total	80	91	87.9

package Test2::Tools::HTTP::Tx;

use strict;
use warnings;
use 5.014;
use Test2::API ();
use Carp ();

# ABSTRACT: Object representing the last transaction for Test2::Tools::HTTP
our $VERSION = '0.12'; # VERSION


sub req { shift->{req} }
sub res { shift->{res} }
sub ok  { shift->{ok}  }
sub connection_error { shift->{connection_error} }
sub location { shift->{location} }

sub _note_or_diag
{
  my($self, $method) = @_;
  my $ctx = Test2::API::context();

  $ctx->$method($self->req->method . ' ' . $self->req->uri);
  $ctx->$method($self->req->headers->as_string);
  $ctx->$method($self->req->decoded_content || $self->req->content);
  if($self->res)
  {
    $ctx->$method($self->res->code . ' ' . $self->res->message);
    $ctx->$method($self->res->headers->as_string);
    $ctx->$method($self->res->decoded_content || $self->res->content);
  }
  $ctx->$method("ok = " . $self->ok);

  $ctx->release;
}


sub note
{
  my($self) = shift;
  my $ctx = Test2::API::context();
  $self->_note_or_diag('note');
  $ctx->release;
}


sub diag
{
  my($self) = shift;
  my $ctx = Test2::API::context();
  $self->_note_or_diag('diag');
  $ctx->release;
}


sub add_helper
{
  my(undef, $sig, $code) = @_;

  my($class, $name) = split /\./, $sig;

  my %class = (
    tx => 'Test2::Tools::HTTP::Tx',
    req => 'Test2::Tools::HTTP::Tx::Request',
    res => 'Test2::Tools::HTTP::Tx::Response',
  );

  $class = $class{lc $class} if $class{lc $class};

  Carp::croak("$class already can $name") if $class->can($name);

  no strict 'refs';
  *{"${class}::${name}"} = $code;
}

package Test2::Tools::HTTP::Tx::Request;

use parent 'HTTP::Request';

package Test2::Tools::HTTP::Tx::Response;

use parent 'HTTP::Response';

1;

__END__