view release on metacpan or  search on metacpan

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

=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));

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

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