AE-AdHoc

 view release on metacpan or  search on metacpan

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

This module is NOT for building other modules, it's for running them with
minimal typing.

=head1 SYNOPSIS

Suppose we have a subroutine named C<do_stuff( @args, $subref )>
that is designed to run under AnyEvent. As do_stuff may have to wait for
some external events to happen, it does not return a value right away.
Instead, it will call C<$subref-E<gt>( $results )> when stuff is done.

Now we need to test do_stuff, so we set up an event loop. We also need a timer,
because a test that runs forever is annoying. So the script goes like this:

    use AnyEvent;

    # set up event loop
    my $cv = AnyEvent->condvar;
    my $timer = AnyEvent->timer(
        after => 10, cb => sub { $cv->croak("Timeout"); }
    );

    do_stuff( @args, sub{ $cv->send(shift); } );

    # run event loop, get rid of timer
    my $result = $cv->recv();
    undef $timer;

    # finally
    analyze_results( $result );

Now, the same with AE::AdHoc:

    use AE::AdHoc;

    my $result = ae_recv {
         do_stuff( @args, ae_send );

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

		if (!$timeout or !looks_like_number($timeout));

	# find out where we are
	$iter++;
	my @caller = caller(0);
	local $where = "ae_recv[$iter] at $caller[1]:$caller[2]";

	my $on_timeout = $opt{soft_timeout}
		? sub { $cv->send }
		: sub { $cv->croak("Timeout after $timeout seconds"); };
	my $timer;
	$timeout > 0 and $timer = AnyEvent->timer( after => $timeout,
		cb => $on_timeout,
	);
	_clear_goals();
	$code->();
	return $cv->recv;
	# on exit, $timer is autodestroyed
	# on exit, $cv is restored => destroyed
};

=head2 ae_send ( [@fixed_args] )

Create callback for normal event loop ending.

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)>.

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

=cut

sub goals { return \%goals; };
sub results { return \%results; };

=head1 ADDITIONAL ROUTINES

=head2 ae_action { CODE } %options

Perform CODE after entering the event loop via ae_recv
(a timer is used internally).

CODE will NOT run after current event loop is terminated (see ae_recv).

Options may include:

=over

=item * after - delay before code execution (in seconds, may be fractional)

=item * interval - delay between code executions (in seconds, may be fractional)

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

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

	$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

t/10-basic.t  view on Meta::CPAN

} "plain ae_send is fine";

throws_ok {
	ae_send;
} qr(outside), "outside = no go";

throws_ok {
	ae_begin;
} qr(outside), "outside = no go";

my $timer;
throws_ok {
	ae_recv {
		$timer = AnyEvent->timer( after => 0.1, cb => ae_send );
		note "timer ref = $timer";
	} 0.01;
} qr(Timeout), "Start rotten timer test";

# check that later-on callback generates a warning
{
	my @warn;
	local $SIG{__WARN__} = sub { push @warn, @_ };
	throws_ok {
		ae_recv { ; } 0.2;
	} qr(Timeout), "Rotten timer didn't spoil later tests:";
	is (scalar @warn, 1, " - 1 warning issued");
	like ($warn[0], qr(Leftover), " - It was about 'Leftover': $warn[0]");
	ok (ref $timer, " - Rotten timer still alive at this point (but harmless): $timer");

};

t/11-begin-end.t  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use Test::More;
use Test::Exception;

use AE::AdHoc;

my @timers;

plan tests => 5;

lives_ok {
	my $timer;
	ae_recv {
		ae_begin;
		$timer = AnyEvent->timer( after => 0.01, cb => ae_end );
	} 1;
} "A simple begin/end example works";

throws_ok {
	my $timer;
	ae_recv {
		ae_begin;
		ae_begin;
		$timer = AnyEvent->timer( after => 0.01, cb => ae_end );
	} 0.02;
} qr(Timeout), "A simple example with extra begin dies";

my @trace;
my $val;

lives_ok {
	ae_recv {
		my $tm;
		my $iter;
		my $attimer;
		$attimer = sub {
			push @trace, ++$iter;
			ae_end->();
			$tm = AE::timer 0.01, 0, $attimer;
		};
		$tm = AE::timer 0.01, 0, $attimer;
		ae_begin( sub { ae_send->(++$val) } ) for (1,2);
	} 1;
} "More complex example lives";

is ($val, 1, "Begin's callback executed once");
is_deeply(\@trace, [1, 2], "end->() executed twice");

t/15-goals.t  view on Meta::CPAN

use AE::AdHoc;

my $result;

throws_ok {
	ae_goal("foo");
} qr(outside), "no ae_recv = no go";
note $@;

# We use sub {} in timers here because timer passes random args to its
# callback. See L<::AnyEvent> timer section.

lives_ok {
	my ($t1, $t2);
	$result = ae_recv {
		$t1 = AnyEvent->timer( after => 0,
			cb => sub { ae_goal("task1")->() }
		);
		$t2 = AnyEvent->timer( after => 0,
			cb => sub { ae_goal("task2", "fixed")->() }
		);
	} 1;
} "No timeout - goals complete";

note "Got: ".Dumper($result);

is_deeply ($result,
	{ task1 => [], task2 => [ "fixed" ]},
	"Results as expected (sans timer callback args)"
);
is_deeply (AE::AdHoc->results(), $result, "AE::AdHoc::results consistent");
is_deeply (AE::AdHoc->goals(), {}, "AE::AdHoc::goals is empty (all complete)");

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

#!/usr/bin/perl -w

use strict;
use Test::More tests => 3;
use Data::Dumper;

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

my $timer;
ae_recv {
	$timer = AnyEvent->timer( after => 0, cb => ae_goal("pollute") );
	ae_send->("return right now");
} 0.1;

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";