view release on metacpan or  search on metacpan

lib/Async/Chain.pm  view on Meta::CPAN

=head1 RATIONALE

A asynchronous code often have deep nested callbacks, therefore it is tangled
and hard to change. This module help to converta a code like following to some
more readable form. Also, with C<chain> you can easily skip some unneeded steps
in this thread. For example jump to log step after the first failed query in
the chain.

without chain:

    sub f {
        ...
        some_anync_call @args, cb => sub {
            ...
            some_other_anync_call @args, cb => sub {
            ...
                ...
                    ...
                        yet_another_anync_call @args, cb => sub {
                            ...
                        }
            }
        }
    }

using chain:

    chain
        sub {
            my next = shift;
            ...
            some_anync_call @args, cb => sub { $next->(@arg) }
        },
        sub {
            my next = shift;
            ...
            some_other_anync_call @args, cb => sub { $next->(@arg) }
        },
        sub {
            my next = shift;
            ...
        },
        ...
        sub {
            ...
            yet_another_anync_call @args, cb => sub { $next->(@arg) }
        },
        sub {
            ...
        };

If you don't need to skip or hitch links, you can use 'kseq' function from CPS
module, that slightly faster.

=head1 SUBROUTINES/METHODS

=cut

# Internal method called by use function
sub import {
	$caller = (caller())[0];
	*{$caller . "::chain"} = \&chain;
}

# Internal method used for reduction to code.
sub _to_code {
	my $self = shift;
	return sub {
		my $cb = shift @{$self} or
			return sub { };
		$cb->[1]->($self, @_);
		();
	}
}

=head2 new

The Asyn::Chain object constructor. Arguments are list of subroutine optionaly
leaded by mark.

=cut

sub new {
	my $class = shift; $class = ref $class ? ref $class : $class;
	my $self = [ ];
	# FIXME: check args type
	while (scalar @_) {
		if (ref $_[0]) {
			push @$self, [ '', shift ];
		} else {
			push @$self, [ shift, shift ];
		}
	}
	bless $self, $class;
}

=head2 chain

Only one exported subroutine. Create and call Anync::Chain object. Return empty
list.

=cut

sub chain(@) {
	my $self = __PACKAGE__->new(@_);
	$self->();
	();
}

=head2 skip

Skip one or more subroutine. Skipe one if no argument given. Return
Anync::Chain object.

=cut

sub skip {
	my ($self, $skip) = @_;
	$skip = ($skip and $skip > 0) ? $skip : 1;
	while($skip) {
		shift @{$self}; --$skip;