AE-AdHoc

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for AE-AdHoc

0.08	Sat Oct 27 2012
        * API: Add ae_action { CODE } for delayed execution.
		* API: Add timeout and soft_timeout options to ae_recv.

0.07    Sun Sep 16 2012
        * API: Add magic variables for error handling
        * FIX: Fix ae_goal, add verbose error messages for leftover callbacks

0.05    Sun Sep 09 2012
        * API: Add multiple goal interface (ae_goal)

0.04    Sun Sep 09 2012
        * API: Add arglist support to callbacks: ae_recv { ae_send->(1..5) };
        * API: Add extra arguments to callback: ae_recv { ae_send(1..5) };
        * Example added (port-probe.pl)

0.03    Thu Sep 06 2012

lib/AE/AdHoc.pm  view on Meta::CPAN

Run CODE block, enter event loop and wait for $timeout seconds for callbacks
set up in CODE to fire, then die. Return whatever was sent via C<ae_send>.

$timeout must be a nonzero real number. Negative value means "run forever".
$timeout=0 would be ambigous, so it's excluded.

Options may include:

=over

=item * timeout - override the $timeout parameter (one timeout MUST be present).

=item * soft_timeout - Override $timeout, and don't die,
but return undef instead.

=back

Other functions in this module would die if called outside of C<ae_recv>.

=cut

# $cv is our so that it can be localized and act as a lock
our $cv;

# These are for error pretty-printing.
my $iter; # ++ every time
our $where; # "$file:$line[$iter]"

sub ae_recv (&@) { ## no critic
	my $code = shift;
	my $timeout = @_ % 2 && shift; # load bare timeout if present
	my %opt = @_;

	$timeout = $opt{timeout} || $opt{soft_timeout} || $timeout;

lib/AE/AdHoc.pm  view on Meta::CPAN

Returns a sub that feeds its arguments to C<$cv-E<gt>send()>. Arguments given to
the function itself are prepended, as in
C<$cv-E<gt>send(@fixed_args, @callback_args)>.

B<NOTE> that ae_recv will return all sent data "as is" in list context, and
only first argument in scalar context.

May be called as ae_send->( ... ) if you want to stop event loop immediately
(i.e. in a handcrafted callback).

=head2 ae_croak ( [$fixed_error] )

Create callback for event loop termination.

Returns a sub that feeds its first argument to $cv->croak(). If argument is
given, it will be used instead.

=head2 ae_begin ( [ sub { ... } ] )

=head2 ae_end

lib/AE/AdHoc.pm  view on Meta::CPAN

	my $code = sub {
		my @args = @_;

		croak("$name called outside ae_recv") unless $cv;
		my $myiter = $iter; # remember where cb was created

		my @caller = caller(0);
		my $exact = "$name at $caller[1]:$caller[2] from $where";

		return sub {
			return _error( "Leftover $exact called outside ae_recv" )
				unless $cv;
			return _error( "Leftover $exact called in $where")
				unless $iter == $myiter;
			$cv->$action(@args, @_);
		}; # end closure
	}; # end generated sub
	no strict 'refs'; ## no critic
	no warnings 'prototype'; ## no critic
	*{$name} = $code;
};

sub ae_begin(@) { ## no critic

lib/AE/AdHoc.pm  view on Meta::CPAN

	my ($name, @fixed_args) = @_;

	croak "ae_goal called outside ae_recv" unless $cv;
	my $myiter = $iter;

	my @caller = caller(0);
	my $exact = "ae_goal('$name') at $caller[1]:$caller[2] from $where";

	$goals{$name}++ unless $results{$name};
	return sub {
		return _error( "Leftover $exact called outside ae_recv" )
			unless $cv;
		return _error( "Leftover $exact called in $where")
			unless $iter == $myiter;
		$results{$name} ||= [ @fixed_args, @_ ];
		delete $goals{$name};
		$cv->send(\%results) unless %goals;
	};
};

=head2 AE::AdHoc->goals

Return goals not yet achieved as hash ref.

lib/AE/AdHoc.pm  view on Meta::CPAN

	$opt{after} ||= 0;

	my $count = $opt{count};
	my $inf = !$count;
	my $n = 0;

	my $timer;
	my $cb = sub {
		if (!$cv) {
			undef $timer;
			return _error( "Leftover $exact called outside ae_recv" );
		};
		$myiter == $iter or undef $timer;
		$inf or $count-->0 or undef $timer;
		$timer and $code->($n++);
	};
	$timer = AnyEvent->timer(
		after=>$opt{after}, interval=>$opt{interval}, cb=>$cb);
	return;
};

=head1 ERROR HANDLING

Dying within event loop is a bad idea, so we issue B<warnings> and write
errors to magic variables. It is up to the user to check these variables.

=over

=item * C<$AE::AdHoc::errstr> - last error (as in L<::DBI>).

=item * C<@AE::AdHoc::errors> - all errors.

=item * C<$AE::AdHoc::warnings> - set this to false to suppress warnings.

=back

=cut

our @errors;
our $errstr;
our $warnings = 1; # by default, complain loudly

sub _error {
	$errstr = shift;
	push @errors, $errstr;
	carp __PACKAGE__.": ERROR: $errstr" if $warnings;
	return;
};
sub _croak {
	_error(@_);
	croak shift;
};

=head1 CAVEATS

This module is still under heavy development, and is subject to change.
Feature/change requests are accepted.

=head2 Callback confinement

t/14-xargs.t  view on Meta::CPAN

$scalar = ae_recv {
	ae_send->(6..10);
} 0.01;

is ($scalar, 6, "Multiple args in scalar context");

# Error handling

throws_ok {
	ae_recv {
		ae_croak("bump bump")->("real error");
	} 0.01;
} qr(^bump bump), "Extra args in croak";

unlike ($@, qr(real error), "Sorry, no real error for you");

t/17-goals-leftover.t  view on Meta::CPAN

my $timer2;
ae_recv {
	$timer2 = AnyEvent->timer( after => 0.1, cb => ae_goal("clean") );
} 0.2;

my @keys = sort keys %{ AE::AdHoc->results };
is_deeply( \@keys, ["clean"], "AE results are clean" );
note "Results: ".Dumper( AE::AdHoc->results );

is (scalar @AE::AdHoc::errors, 1, "Exactly 1 error");
like ($AE::AdHoc::errstr, qr(^Leftover.*ae_goal), "Leftover error present");
note "Error was: $AE::AdHoc::errstr";

t/18-all-leftover.t  view on Meta::CPAN

use Test::More tests => 5;
use Test::Exception;

use AE::AdHoc;
$AE::AdHoc::warnings = 0;

my $sub;

ae_recv { $sub = ae_send; ae_send->("stop now"); } 0.01;
lives_ok { $sub->() } "Don't die if event loop MAY exist";
like ($AE::AdHoc::errstr, qr(Leftover.*outside), "Error was catched");
note $AE::AdHoc::errstr;

ae_recv { $sub = ae_goal("foo"); ae_send->("stop now"); } 0.01;
lives_ok { $sub->() } "Don't die if event loop MAY exist";
like ($AE::AdHoc::errstr, qr(Leftover.*outside), "Error was catched");
note $AE::AdHoc::errstr;

is (scalar @AE::AdHoc::errors, 2, "Exactly two errors");

t/20-ae_action.t  view on Meta::CPAN

my $x;
ae_recv {
	ae_action { $x++ };
	ok (!$x, "Action didn't work yet");
} soft_timeout=>0.2;

is ($x, 1, "Action w/o parameters works (finally)");
is_deeply (\@res, [ 0, 1 ], "Timer *still* fired twice");

is_deeply (\@AE::AdHoc::errors, [], "No errors in this test");