view release on metacpan or  search on metacpan

lib/AnyEvent/Callback.pm  view on Meta::CPAN

            ...
            yet_another_watcher1 $cb->CB( sub {
                my $cb = pop;
                ...
                $cb->( 123 );   # upwards callback

            });
            yet_another_watcher2 $cb->CB( sub {
                my $cb = pop;
                ...

                $cb->error( 456 );  # on_error will be called

            });
        });
    }


=head1 METHODS

=head2 'CODE' (overloaded fake method)

    $cb->( ... );

You can use the object as usually B<CODEREF>.

=cut

use overload
    '&{}' => sub {
        my ($self) = shift;
        sub {
            $self->{called}++;
            carp "Repeated callback calling: $self->{called}"
                if $self->{called} > 1;
            carp "Calling result callback after error callback"
                if $self->{ecalled};
            $self->{cb}->(@_) if $self->{cb};
            delete $self->{cb};
            delete $self->{ecb};
            delete $self->{parent};
            return;
        };
    },
    bool => sub { 1 } # for 'if ($cb)'
;


=head2 CB

Creates new callback object that have binding on parent callback.

    my $new_cb = $cb->CB(sub { ... });   # the cb doesn't catch errors

    my $new_cb = CB(sub { ... }, sub { ... }); # the cb catches errors

    my $new_cb = $cb->CB(sub { ... }, sub { ... }); # the same

=cut

sub CB(&;&) {

    my $parent;
    my ($cb, $ecb) = @_;

    ($parent, $cb, $ecb) = @_ unless 'CODE' eq ref $cb;

    croak 'Callback must be CODEREF' unless 'CODE' eq ref $cb;
    croak 'Error callback must be CODEREF or undef'
        unless 'CODE' eq ref $ecb or !defined $ecb;

    # don't translate erorrs upwards if error callback if exists
    $parent = undef if $ecb;

    my $self = bless {
        cb      => $cb,
        ecb     => $ecb,
        parent  => $parent,
        called  => 0,
        ecalled => 0,
    } => __PACKAGE__;

    $self;
}

sub CBS {
    return AnyEvent::Callback::Stack->new;
}


=head2 error

Calls error callback. If the object has no registered error callbacks,
parent object's error callback will be called.

    $cb->error('WTF?');

=cut

sub error {
    my ($self, @error) = @_;

    $self->{ecalled}++;
    carp "Repeated error callback calling: $self->{ecalled}"
        if $self->{ecalled} > 1;
    carp "Calling error callback after result callback"
        if $self->{called};

    if ($self->{ecb}) {
        $self->{ecb}( @error );
        delete $self->{ecb};
        delete $self->{cb};
        delete $self->{parent};
        return;
    }

    delete $self->{ecb};
    delete $self->{cb};
    my $parent = delete $self->{parent};

    unless($parent) {