AE-AdHoc
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
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
* API: Make empty/zero $timeout illegal.
0.0203 Tue Aug 14 2012
* Fixed empty $timeout undef warning.
* Minor code cleanup.
0.02 Sat Aug 11 2012
First version, released on an unsuspecting world.
- ae_recv, ae_send and ae_croak wotk and pass most basic tests
{
"abstract" : "Simplified interface for tests/examples of AnyEvent-related code.",
"author" : [
"Konstantin S. Uvarin <khedin@gmail.com>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112621",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"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
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'AE::AdHoc',
AUTHOR => q{Konstantin S. Uvarin <khedin@gmail.com>},
VERSION_FROM => 'lib/AE/AdHoc.pm',
ABSTRACT_FROM => 'lib/AE/AdHoc.pm',
($ExtUtils::MakeMaker::VERSION >= 6.3002
? ('LICENSE'=> 'perl')
: ()),
PL_FILES => {},
PREREQ_PM => {
'Test::More' => 0,
'Test::Exception' => 0,
'AnyEvent' => 0,
'AnyEvent::Strict' => 0,
'Scalar::Util' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'AE-AdHoc-*' },
);
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
make install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the
perldoc command.
perldoc AE::AdHoc
You can also look for information at:
RT, CPAN's request tracker
http://rt.cpan.org/NoAuth/Bugs.html?Dist=AE-AdHoc
AnnoCPAN, Annotated CPAN documentation
http://annocpan.org/dist/AE-AdHoc
CPAN Ratings
http://cpanratings.perl.org/d/AE-AdHoc
Search CPAN
http://search.cpan.org/dist/AE-AdHoc/
LICENSE AND COPYRIGHT
Copyright (C) 2012 Konstantin S. Uvarin
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
examples/port-probe-multi.pl view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use AE::AdHoc;
use AnyEvent::Socket;
use Getopt::Long;
my $timeout = 1;
GetOptions (
"timeout=s" => \$timeout,
"help" => \&usage,
) or usage();
my @probe = map {
/^(.*):(\d+)$/ or die "Expecting host:port. See $0 --help\n"; [$1, $2, $_];
} @ARGV;
usage() unless @probe;
# Real work
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 {
print <<"USAGE";
Probe tcp connection to several hosts at once
Usage: $0 [ options ] host:port host:port ...
Options may include:
--timeout <seconds> - may be fractional as well
--help - this message
USAGE
exit 1;
};
examples/port-probe.pl view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use AE::AdHoc;
use AnyEvent::Socket;
use Getopt::Long;
my $timeout = 1;
GetOptions (
"timeout=s" => \$timeout,
"help" => \&usage,
) or usage();
my @probe = map {
/^(.*):(\d+)$/ or die "Expecting host:port. See $0 --help\n"; [$1, $2, $_];
} @ARGV;
usage() unless @probe;
# Real work
my $alive = ae_recv {
tcp_connect $_->[0], $_->[1], ae_send("$_->[0]:$_->[1]") for @probe;
} $timeout;
print "Connect to $alive succeeded!\n";
# /Real work
sub usage {
print <<"USAGE";
Probe tcp connection to several hosts at once
Usage: $0 [ options ] host:port host:port ...
Options may include:
--timeout <seconds> - may be fractional as well
--help - this message
USAGE
exit 1;
};
lib/AE/AdHoc.pm view on Meta::CPAN
=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>.
t/10-basic.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 9;
use Test::Exception;
use AE::AdHoc;
throws_ok {
ae_recv { ; } 0.01;
} qr(Timeout), "empty body => reach timeout => die";
lives_and {
is ((ae_recv { ae_send->(137); } 0.01), 137 );
} "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
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/12-nested-dies.t view on Meta::CPAN
use strict;
use Test::More;
use Test::Exception;
use AE::AdHoc;
$AE::AdHoc::warnings = 0;
plan tests => 1;
throws_ok {
ae_recv {
ae_recv {
} 1;
} 2;
} qr(nested)i, "Nested calls not allowed";
t/13-null-timeout.t view on Meta::CPAN
use Test::Exception;
use AE::AdHoc;
my @warn;
$SIG{__WARN__} = sub { push @warn, shift };
plan tests => 4;
throws_ok {
ae_recv{ };
} qr(timeout.*non-?zero), "No timeout = no go";
throws_ok {
ae_recv{ } "foo";
} qr(timeout.*non-?zero), "Non-numeric timeout = no go";
throws_ok {
ae_recv{ } 0.01;
} qr(^Timeout after), "Timeout with empty body";
is (scalar @warn, 0, "no warnings");
note "warning: $_" for @warn;
t/14-xargs.t view on Meta::CPAN
use strict;
use Test::More tests => 5;
use Test::Exception;
use AE::AdHoc;
my @list;
my $scalar;
@list = ae_recv {
ae_send(1..5)->(6..10);
} 0.01;
is_deeply (\@list, [1..10], "Extra args in list context");
$scalar = ae_recv {
ae_send(1..5)->(6..10);
} 0.01;
is ($scalar, 1, "Extra args in scalar context");
$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/15-goals.t view on Meta::CPAN
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
#!/usr/bin/perl -w
use strict;
use Test::More tests => 8;
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
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";
t/19-soft-timeout.t view on Meta::CPAN
#!/usr/bin/perl -w
use strict;
use Test::More tests => 2;
use Test::Exception;
use AE::AdHoc;
lives_ok {
ae_recv { } soft_timeout => 0.1
} "soft timeout";
throws_ok {
ae_recv { } timeout => 0.1
} qr(Timeout.*seconds), "hard timeout in options";
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");
t/boilerplate.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More tests => 3;
sub not_in_file_ok {
my ($filename, %regex) = @_;
open( my $fh, '<', $filename )
or die "couldn't open $filename for reading: $!";
my %violated;
while (my $line = <$fh>) {
while (my ($desc, $regex) = each %regex) {
if ($line =~ $regex) {
push @{$violated{$desc}||=[]}, $.;
}
}
}
if (%violated) {
fail("$filename contains boilerplate text");
diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
} else {
pass("$filename contains no boilerplate text");
}
}
sub module_boilerplate_ok {
my ($module) = @_;
not_in_file_ok($module =>
'the great new $MODULENAME' => qr/ - The great new /,
'boilerplate description' => qr/Quick summary of what the module/,
'stub function definition' => qr/function[12]/,
);
}
TODO: {
# local $TODO = "Need to replace the boilerplate text";
not_in_file_ok(README =>
"The README is used..." => qr/The README is used/,
"'version information here'" => qr/to provide version information/,
);
not_in_file_ok(Changes =>
"placeholder date/time" => qr(Date/time)
);
module_boilerplate_ok('lib/AE/AdHoc.pm');
}
t/manifest.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More;
unless ( $ENV{RELEASE_TESTING} ) {
plan( skip_all => "Author tests not required for installation" );
}
eval "use Test::CheckManifest 0.9";
plan skip_all => "Test::CheckManifest 0.9 required" if $@;
ok_manifest();
t/pod-coverage.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
if $@;
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
all_pod_coverage_ok();
view release on metacpan - search on metacpan
( run in 0.845 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )