view release on metacpan or  search on metacpan

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

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

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

These subroutines provide ability to wait for several events to complete.

The AnyEvent's condition variable has a counter that is incremented by
C<begin()> and decreased by C<end()>. Optionally, the C<begin()> function
may also set a callback.

Whenever the counter reaches zero, either that callback or just C<send()> is
executed on the condvar.

B<Note>: If you do provide callback and want the event loop to stop there,
consider putting C<ae_send-E<gt>( ... )> somewhere inside the callback.

B<Note>: C<ae_begin()> acts at once, and does NOT return a closure. ae_end,
however, returns a subroutine reference just like C<ae_send>/C<ae_croak> do.

See begin/end section in L<AnyEvent>.

=cut

# set prototypes
sub ae_send (@); ## no critic
sub ae_croak (;$); ## no critic
sub ae_end (); ## no critic

# define ae_send, ae_croak and ae_end at once
foreach my $action (qw(send croak end)) {
	my $name = "ae_$action";
	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
	croak("ae_begin called outside ae_recv") unless $cv;

	$cv->begin(@_);
};


=head1 ADVANCED MULTIPLE GOAL INTERFACE

=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