File Coverage

blib/lib/WWW/Chain.pm

Criterion	Covered	Total	%
statement	69	70	98.5
branch	20	34	58.8
condition	1	3	33.3
subroutine	13	13	100.0
pod	0	7	0.0
total	103	127	81.1

package WWW::Chain;
our $VERSION = '0.101';
our $AUTHORITY = 'cpan:GETTY';
# ABSTRACT: A web request chain

use Moo;
use MooX::Types::MooseLike::Base qw(:all);
use Safe::Isa;
use WWW::Chain::UA::LWP;
use Exporter 'import';

our @EXPORT = qw( www_chain );

has stash => (
  isa => HashRef,
  is => 'lazy',
);
sub _build_stash {{}}

has next_requests => (
  isa => ArrayRef,
  is => 'rwp',
  clearer => 1,
);

has next_step => (
  isa => AnyOf[Str, CodeRef],
  is => 'rwp',
  clearer => 1,
);

has done => (
  isa => Bool,
  is => 'rwp',
  lazy => 1,
  default => sub { 0 },
);

has request_count => (
  isa => Num,
  is => 'rwp',
  lazy => 1,
  default => sub { 0 },
);

has result_count => (
  isa => Num,
  is => 'rwp',
  lazy => 1,
  default => sub { 0 },
);

sub www_chain {
  my ( @args ) = @_;
  my ( $next_requests, $next_step, @others ) = __PACKAGE__->parse_chain(@args);
  die __PACKAGE__." can only use coderef as next step" unless !$next_step or ref $next_step eq 'CODE';
  return WWW::Chain->new(
    next_requests => $next_requests,
    next_step => $next_step,
    request_count => scalar @{$next_requests},
    @others,
  );
}

sub request_with_lwp {
  my ( $self ) = @_;
  return WWW::Chain::UA::LWP->new->request_chain($self);
}

sub is_response { $_[1]->$_isa('HTTP::Response') }
sub is_request { $_[1]->$_isa('HTTP::Request') }

sub parse_chain {
  my ( $self, @args ) = @_;
  my $step;
  my @requests;
  while (@args) {
    my $arg = shift @args;
    if ( $self->is_request($arg) ) {
      push @requests, $arg;
    } elsif (ref $arg eq '') {
      die "".(ref $self)."->parse_chain '".$arg."' is not a known function" unless $self->can($arg);
      $step = $arg;
      last;
    } elsif (ref $arg eq 'CODE') {
      $step = $arg;
      last;
    } else {
      die __PACKAGE__."->parse_chain got unparseable element".(defined $arg ? " ".$arg : "" );
    }
  }
  die __PACKAGE__."->parse_chain found no HTTP::Request objects" unless @requests;
  return \@requests, $step, @args;
}

sub next_responses {
  my ( $self, @responses ) = @_;
  die "".(ref $self)."->next_responses can't be called on chain which is done." if $self->done;
  my $amount = scalar @{$self->next_requests};
  die "".(ref $self)."->next_responses would need ".$amount." HTTP::Response objects to proceed"
    unless scalar @responses == $amount;
  die "".(ref $self)."->next_responses only takes HTTP::Response objects"
    if grep { !$self->is_response($_) } @responses;
  $self->clear_next_requests;
  my @result = $self->${\$self->next_step}(@responses);
  $self->clear_next_step;
  $self->_set_result_count($self->result_count + 1);
  # If the first result is a request again, then we need to parse_chain again.
  if ( $self->is_request($result[0]) ) {
    my ( $next_requests, $next_step, @others ) = $self->parse_chain(@result);
    die "".(ref $self)."->next_responses can't parse the result, more arguments after next step" if @others;
    $self->_set_next_requests($next_requests);
    $self->_set_next_step($next_step);
    $self->_set_request_count($self->request_count + scalar @{$next_requests});
    return 0;
  }
  $self->_set_done(1);
  return $self->stash;
}

sub BUILD {
  my ( $self ) = @_;
  unless ($self->next_requests) {
    die "".(ref $self)." has no start_chain function and no requests supplied on build" unless $self->can('start_chain');
    my ( $next_requests, $next_step, @others ) = $self->parse_chain($self->start_chain);
    die "".(ref $self)." parse_chain can't parse the start_chain return, more arguments after next step" if scalar @others > 0;
    die "".(ref $self)." has no requests from start_chain" unless scalar @{$next_requests} > 0;
    $self->_set_next_step($next_step) if $next_step;
    $self->_set_next_requests($next_requests);
  }
}

1;

__END__