AE-AdHoc
view release on metacpan or search on metacpan
},
"name" : "AE-AdHoc",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : 0
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : 0
}
},
"runtime" : {
"requires" : {
"AnyEvent" : 0,
"AnyEvent::Strict" : 0,
"Scalar::Util" : 0,
"Test::Exception" : 0,
"Test::More" : 0
}
}
},
"release_status" : "stable",
"version" : "0.0805"
---
abstract: 'Simplified interface for tests/examples of AnyEvent-related code.'
author:
- 'Konstantin S. Uvarin <khedin@gmail.com>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112621'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: AE-AdHoc
no_index:
directory:
- t
- inc
requires:
AnyEvent: 0
AnyEvent::Strict: 0
Scalar::Util: 0
Test::Exception: 0
Test::More: 0
version: 0.0805
AE-AdHoc
AE::AdHoc is a simple interface around AnyEvent intended for tests, examples,
and hastily written scripts.
It boils down to:
use AE::AdHoc;
my $result = ae_recv {
do_something ( # the code under test
on_success => ae_send, # callback - all done, stop event loop
on_failure => ae_croak, # callback - something happened, abort event loop
);
} 10; # timeout - fail test if it takes too long
# later
is ($result, $excepted_result, "...");
This module is under development for now.
INSTALLATION
To install this module, run the following commands:
perl Makefile.PL
make
make test
examples/port-probe-multi.pl view on Meta::CPAN
eval {
ae_recv {
tcp_connect $_->[0], $_->[1], ae_goal("$_->[0]:$_->[1]") for @probe;
} $timeout;
};
die $@ if $@ and $@ !~ /^Timeout/;
my @offline = sort keys %{ AE::AdHoc->goals };
my (@alive, @reject);
my $results = AE::AdHoc->results;
foreach (keys %$results) {
# tcp_connect will not feed any args if connect failed
ref $results->{$_}->[0]
? push @alive, $_
: push @reject, $_;
};
print "Connected: @alive\n" if @alive;
print "Rejected: @reject\n" if @reject;
print "Timed out: @offline\n" if @offline;
# /Real work
sub usage {
lib/AE/AdHoc.pm view on Meta::CPAN
or simply "condvar", is. See L<Anyevent::Intro>.
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 );
} 10; # timeout
analyze_results( $result );
=head1 EXPORT
Functions C<ae_recv>, C<ae_send>, C<ae_croak>, C<ae_begin>, C<ae_end>, and
C<ae_goal> are exported by default.
=head1 SUBROUTINES
B<Note>: Anywhere below, C<$cv> means L<AnyEvent>'s conditional variable
responsible for current event loop. See C<condvar> section of L<AnyEvent>.
=cut
our $VERSION = '0.0805';
use Carp;
use AnyEvent::Strict;
use Scalar::Util qw(weaken looks_like_number);
use Exporter;
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;
# check we're not in event loop before dying
$cv and _croak("Nested calls to ae_recv are not allowed");
local $cv = AnyEvent->condvar;
croak "Parameter timeout must be a nonzero real number"
if (!$timeout or !looks_like_number($timeout));
lib/AE/AdHoc.pm view on Meta::CPAN
? 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
=head2 ae_goal( "name", @fixed_args )
Create a named callback.
When callback is created, a "goal" is set.
When such callback is called, anything passed to it is saved in a special hash
as array reference (prepended with @fixed_args, if any).
When all goals are completed, the hash of results is returned by C<ae_recv>.
If ae_send is called at some point, the list of incomplete and complete goals
is still available via C<goals> and C<results> calls.
The goals and results are reset every time upon entering ae_recv.
=cut
my %goals;
my %results;
sub _clear_goals { %goals = (); %results = (); };
sub ae_goal {
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.
=head2 AE::AdHoc->results
Return results of completed goals as hash ref.
=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).
lib/AE/AdHoc.pm view on Meta::CPAN
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 {
lib/AE/AdHoc.pm view on Meta::CPAN
=cut
=head1 AUTHOR
Konstantin S. Uvarin, C<< <khedin at gmail.com> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-ae-adhoc at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AE-AdHoc>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc AE::AdHoc
You can also look for information at:
t/15-goals.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 5;
use Test::Exception;
use AnyEvent::Strict;
use Data::Dumper;
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/16-goals2.t view on Meta::CPAN
use Test::Exception;
use AE::AdHoc;
throws_ok {
ae_recv {
ae_goal("never");
ae_goal("always")->();
} 0.1;
} qr(^Timeout), "Goals not done, sorry";
is_deeply( AE::AdHoc->results, { always => [] }, "1 goal done");
is_deeply( AE::AdHoc->goals, { never => 1 }, "1 goal left");
ae_recv { ae_send->(137) } 0.1;
is_deeply( AE::AdHoc->results, { }, "results cleared");
is_deeply( AE::AdHoc->goals, { }, "goals cleared");
throws_ok {
ae_recv {
ae_goal("never") for 1..3;
ae_goal("always")->($_) for 1..3;
} 0.1;
} qr(^Timeout), "Goals not done, sorry";
is_deeply( AE::AdHoc->results, { always => [1] }, "only first goal callback counts");
is_deeply( AE::AdHoc->goals, { never => 3 }, "1 goal left, but 3 times");
t/17-goals-leftover.t view on Meta::CPAN
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";
t/20-ae_action.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 5;
use Test::Exception;
use AE::AdHoc;
my @res;
ae_recv {
ae_action { push @res, @_ } after=>0.03, interval =>0.1;
} soft_timeout=>0.2;
is_deeply (\@res, [ 0, 1 ], "Timer fired twice");
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");
( run in 0.312 second using v1.01-cache-2.11-cpan-9b1e4054eb1 )