File Coverage

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

Criterion	Covered	Total	%
statement	61	67	91.0
branch	12	16	75.0
condition	1	3	33.3
subroutine	18	18	100.0
pod	5	5	100.0
total	97	109	88.9

package Test2::Tools::HTTP::UA;

use strict;
use warnings;
use 5.014;
use Carp ();
use File::Spec ();
use Test2::Tools::HTTP::Apps;

# ABSTRACT: User agent wrapper for Test2::Tools::HTTP
our $VERSION = '0.12'; # VERSION


sub _init
{
  foreach my $inc (@INC)
  {
    my $dir = File::Spec->catdir($inc, 'Test2/Tools/HTTP/UA');
    next unless -d $dir;
    my $dh;
    opendir $dh, $dir;
    my @list = sort grep !/^\./, grep /\.pm$/, readdir $dh;
    closedir $dh;
    foreach my $pm (@list)
    {
      eval { require "Test2/Tools/HTTP/UA/$pm"; };
      if(my $error = $@)
      {
        warn $error;
      }
    }
  }
}

my %classes;
my %instance;

sub new
{
  my($class, $ua) = @_;

  if($class eq __PACKAGE__)
  {
    _init();
    my $class;

    if(ref($ua) eq '' && defined $ua)
    {
      ($class) = @{ $classes{$ua} };
    }
    else
    {
      foreach my $try (keys %instance)
      {
        if(eval { $ua->isa($try) })
        {
          ($class) = @{ $instance{$try} };
        }
      }
    }

    if(defined $class)
    {
      return $class->new($ua);
    }
    else
    {
      Carp::croak("user agent @{[ ref $ua ]} not supported ");
    }
  }

  bless {
    ua   => $ua,
  }, $class;
}


sub ua
{
  shift->{ua};
}


sub apps
{
  Test2::Tools::HTTP::Apps->new;
}


sub error
{
  my(undef, $message, $res) = @_;
  my $error = bless { message => $message, res => $res }, 'Test2::Tools::HTTP::UA::Error';
  die $error;
}


sub register
{
  my(undef, $class, $type) = @_;
  my $caller = caller;
  if($type eq 'class')
  {
    push @{ $classes{$class} }, $caller;
  }
  elsif($type eq 'instance')
  {
    push @{ $instance{$class} }, $caller;
  }
  else
  {
    Carp::croak("unknown type for $class: $type");
  }
}

package Test2::Tools::HTTP::UA::Error;

use overload
  '""' => sub { shift->as_string },
  bool => sub { 1 }, fallback => 1;

sub message { shift->{message} }
sub res { shift->{res} }
sub as_string { shift->message }

1;

__END__