res results from the CPAN

AE-AdHoc

view release on metacpan or search on metacpan

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44 },
"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"

META.yml view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26 ---
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

README view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28 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

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44 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

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73 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

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124 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

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151                 ? 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

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291  
=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

340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360  
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

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413 =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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40 #!/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

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30 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

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27 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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25 #!/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 2.080 seconds using v1.01-cache-2.11-cpan-9b1e4054eb1 )