File Coverage

blib/lib/AnyEvent/Delay/Simple.pm

Criterion	Covered	Total	%
statement	129	130	99.2
branch	47	52	90.3
condition	2	3	66.6
subroutine	18	18	100.0
pod	2	2	100.0
total	198	205	96.5

package AnyEvent::Delay::Simple;

use strict;
use warnings;

use AnyEvent ();
use Scalar::Util qw(blessed);

use parent qw(Exporter);


our $VERSION = '0.06';


our @EXPORT    = qw(delay);
our @EXPORT_OK = qw(easy_delay);


sub import {
	my ($class, @args) = @_;

	my (@ae, @up);

	foreach (@args) {
		if ($_ && /^AE::(.+)?/) {
			push(@ae, $1);
		}
		else {
			push(@up, $_);
		}
	}
	if (@ae) {
		$class->export('AE', @ae);
	}
	if (@up) {
		$class->export_to_level(1, undef, @up);
	}
}

sub delay {
	my ($obj, $fin);

	if (blessed($_[0])) {
		$obj = shift();
	}
	$fin = pop();

	return unless $fin;

	my ($subs, $err);

	if (ref($_[0]) eq 'ARRAY') {
		$subs = shift();
		$err  = pop();
	}
	else {
		$err  = pop();
		$subs = \@_;
	}

	my $cv = AE::cv;

	$cv->begin();
	$cv->cb(sub {
		_delay_step($obj, [$fin], undef, [$cv->recv()], $cv);
	});
	_delay_step($obj, $subs, $err, $cv);
	$cv->end();

	return;
}

sub _delay_step {
	my $cv = pop();
	my ($obj, $subs, $err, $args) = @_;

	my $sub = shift(@$subs);

	unless (defined($args)) {
		$args = [];
	}
	unless ($sub) {
		$cv->send(@$args);

		return;
	}

	$cv->begin();
	AE::postpone {
		my @res;
		my $xcv = AE::cv;

		$xcv->begin();
		if ($err) {
			eval {
				$sub->($obj ? $obj : (), @$args, $xcv);
			};
			if ($@) {
				_delay_err($obj, $err, $@, $cv);
				undef($xcv);
			}
			else {
				_delay_step_ex($obj, $subs, $err, $xcv, $cv);
			}
		}
		else {
			$sub->($obj ? $obj : (), @$args, $xcv);
			_delay_step_ex($obj, $subs, $err, $xcv, $cv);
		}
	};

	return;
}

sub _delay_step_ex {
	my ($obj, $subs, $err, $xcv, $cv) = @_;

	my $cb = $xcv->cb();

	$xcv->cb(sub {
		if ($cb) {
			if ($err) {
				eval {
					$cb->();
				};
				if ($@) {
					_delay_err($obj, $err, $@, $cv);

					return;
				}
			}
			else {
				$cb->();
			}
		}
		_delay_step($obj, $subs, $err, [$xcv->recv()], $cv);
		$cv->end();
	});
	$xcv->end();

	return;
}

sub _delay_err {
	my ($obj, $err, $msg, $cv) = @_;

	AE::log error => $msg;

	$cv->cb(sub {
		_delay_step($obj, [$err], undef, [$msg], $cv);
	});
	$cv->end();

	return;
}

sub easy_delay {
	my ($obj, $fin);

	if (blessed($_[0])) {
		$obj = shift();
	}
	$fin = pop();

	return unless $fin;

	my ($subs, $err);

	if (ref($_[0]) eq 'ARRAY') {
		$subs = shift();
		$err  = pop();
	}
	else {
		$err  = pop();
		$subs = \@_;
	}

	my $cv = AE::cv;

	$cv->begin();
	$cv->cb(sub {
		$fin->($obj ? $obj : (), $cv->recv());
	});
	_easy_delay_step($obj, $subs, $err, $cv);
	$cv->end();

	return;
}

sub _easy_delay_step {
	my ($cv) = pop();
	my ($obj, $subs, $err, $args) = @_;

	my $sub = shift(@$subs);

	unless (defined($args)) {
		$args = [];
	}
	unless ($sub) {
		$cv->send(@$args);

		return;
	}

	$cv->begin();
	AE::postpone {
		my @res;

		if ($err) {
			eval {
				@res = $sub->($obj ? $obj : (), @$args);
			};
			if ($@) {
				my $msg = $@;

				AE::log error => $msg;

				$cv->cb(sub {
					$err->($obj ? $obj : (), $msg);
				});
				$cv->send(@$args);
			}
			else {
				_easy_delay_step($obj, $subs, $err, \@res, $cv);
			}
		}
		else {
			@res = $sub->($obj ? $obj : (), @$args);
			_easy_delay_step($obj, $subs, $err, \@res, $cv);
		}
		$cv->end();
	};

	return;
}


1;


__END__