File Coverage

blib/lib/WWW/Chain.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	14	24	58.3
condition	1	3	33.3
subroutine	9	9	100.0
pod	0	4	0.0
total	79	96	82.2

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

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

has stash => (
	isa => HashRef,
	is => 'lazy',
);

sub _build_stash {{}}

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

has next_coderef => (
	#isa => CodeRef,
	is => 'rwp',
	clearer => 1,
);

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

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

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

sub BUILDARGS {
	my $self = shift;
	return $_[0] if (scalar @_ == 1 && ref $_[0] eq 'HASH');
	my ( $next_requests, $next_coderef, @args ) = $self->parse_chain(@_);
	return {
		next_requests => $next_requests,
		next_coderef => $next_coderef,
		request_count => scalar @{$next_requests},
		@args,
	};
}

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

sub parse_chain {
	my ( $self, @args ) = @_;
	my $coderef;
	my @requests;
	while (@args) {
		my $arg = shift @args;
		if ( $arg->$_isa('HTTP::Request') ) {
			push @requests, $arg;
		} elsif (ref $arg eq 'CODE') {
			$coderef = $arg;
			last;
		} elsif (ref $arg eq '') {
			die "".(ref $self)."->parse_chain '".$arg."' is not a known function" unless $self->can($arg);
			$coderef = $arg;
			last;
		} else {
			die "".(ref $self)."->parse_chain got unparseable element".(defined $arg ? " ".$arg : "" );
		}
	}
	die "".(ref $self)."->parse_chain found no HTTP::Request objects" unless @requests;
	return [@requests], $coderef, @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 { !$_->isa('HTTP::Response') } @responses;
	$self->clear_next_requests;
	my @result = $self->${\$self->next_coderef}(@responses);
	$self->clear_next_coderef;
	$self->_set_result_count($self->result_count + 1);
	if ( $result[0]->$_isa('HTTP::Request') ) {
		my ( $next_requests, $next_coderef, @args ) = $self->parse_chain(@result);
		die "".(ref $self)."->next_responses can't parse the result, more arguments after CodeRef" if @args;
		$self->_set_next_requests($next_requests);
		$self->_set_next_coderef($next_coderef);
		$self->_set_request_count($self->request_count + scalar @{$next_requests});
		return 0;
	}
	$self->_set_done(1);
	return $self->stash;
}

1;

__END__