view release on metacpan or  search on metacpan

lib/AnyEvent/Promises/Deferred.pm  view on Meta::CPAN

    my $this = shift;
    return $this->{state} == 1? @{$this->{value}}: ();
}

sub _promise_reason {
    my $this = shift;
    return $this->{state} == 2? $this->{reason}: undef;
}

# Promise is a mere handle defined here
{
    my $promise_class = __PACKAGE__ . '::_promise';

    sub promise {
        my $this = shift;

        return bless( \$this, $promise_class );
    }

    for my $method (
        qw(then state is_pending is_fulfilled is_rejected value
        values reason done sync)
        )
    {
        my $d_method = '_promise_' . $method;
        no strict 'refs';
        *{ join '::', $promise_class, $method } = sub {
            my $deferred = ${ shift() };
            return $deferred->$d_method(@_);
        };
    }
}


sub _promise_done {
    my $this = shift;

    $this->deferred->then(
        undef,
        sub {
            my $err = shift;
            die $err;
        }
    );
}


sub _promise_then {
    my $this = shift;

    my $d = ref($this)->new;
    if ( my $then = $this->{then} ) {
        push @$then, [ $d, @_ ];
    }
    else {
        $this->_do_then( $d, @_ );
    }
    return $d->promise;
}

# runs the promise synchronously
sub _promise_sync {
    my $this = shift;
    my $timeout = shift || 5;

    my $cv      = AE::cv;
    my $tm      = AE::timer $timeout, 0, sub { $cv->send("TIMEOUT\n") };
    $this->_promise_then( sub { $cv->send( undef, @_ ); }, sub { $cv->send(@_) } );
    my ( $error, @res ) = $cv->recv;

    die $error if $error;
    return wantarray? @res: $res[0];
}

# can be used with AnyEvent < 6 having no postpone 
my $postpone;
if (defined &AE::postpone){
    $postpone = \&AE::postpone;
}
else {
    my $POSTPONE_W;
    my @POSTPONE;

    my $postpone_exec = sub {
        undef $POSTPONE_W;

        &{ shift @POSTPONE } while @POSTPONE;
    };

    $postpone = sub {
        push @POSTPONE, shift;
        $POSTPONE_W ||= AE::timer( 0, 0, $postpone_exec );
        ();
    };
};

sub _do_then {
    my ( $this, $d, $on_fulfill, $on_reject ) = @_;

    my $rejected = $this->{state} == 2;
    my ( $value, $reason ) = @$this{qw(value reason)};
    if ( my $f = $rejected ? $on_reject : $on_fulfill ) {
        $postpone->(sub {
            my @values = eval { $f->( $rejected ? $reason : @$value ) };
            if ( my $err = $@ ) {
                $d->reject($err);
            }
            elsif (@values == 1
                && blessed( $values[0] )
                && $values[0]->can('then') )
            {
                $values[0]->then(
                    sub { $d->resolve(@_); return; },
                    sub { $d->reject(@_);  return; }
                );
            }
            else {
                $d->resolve(@values);
            }
        });
    }