File Coverage

blib/lib/Promises.pm

Criterion	Covered	Total	%
statement	44	54	81.4
branch	11	18	61.1
condition	3	5	60.0
subroutine	14	16	87.5
pod	5	5	100.0
total	77	98	78.5

package Promises;
our $AUTHORITY = 'cpan:YANICK';
$Promises::VERSION = '1.02';
# ABSTRACT: An implementation of Promises in Perl

use strict;
use warnings;

use Promises::Deferred;
our $Backend = 'Promises::Deferred';

our $WARN_ON_UNHANDLED_REJECT = 0;

use Sub::Exporter -setup => {

    collectors => [
        'backend' => \'_set_backend',
        'warn_on_unhandled_reject' => \'_set_warn_on_unhandled_reject',
    ],
    exports    => [qw[
        deferred resolved rejected
        collect collect_hash
    ]]
};

sub _set_warn_on_unhandled_reject {
    my( undef, $arg ) = @_;

    if( $WARN_ON_UNHANDLED_REJECT = $arg->[0] ) {
        # only brings the big guns if asked for

        *Promises::Deferred::DESTROY = sub {

            return unless $WARN_ON_UNHANDLED_REJECT;

            my $self = shift;

            return unless
                $self->is_rejected and not $self->{_reject_was_handled};

            require Data::Dumper;

            my $dump =
                Data::Dumper->new([$self->result])->Terse(1)->Dump;

            chomp $dump;
            $dump =~ s/\n\s*/ /g;

            warn "Promise's rejection ", $dump,
                " was not handled",
                ($self->{_caller} ? ( ' at ', join ' line ', @{$self->{_caller}} ) : ()) , "\n";
        };
    }
}

sub _set_backend {
    my ( undef, $arg ) = @_;
    my $backend = $arg->[0] or return;

    unless ( $backend =~ s/^\+// ) {
        $backend = 'Promises::Deferred::' . $backend;
    }
    require Module::Runtime;
    $Backend = Module::Runtime::use_module($backend) || return;
    return 1;

}

sub deferred(;&) {
    my $promise = $Backend->new;

    if ( my $code = shift ) {
        $promise->resolve;
        return $promise->then(sub{
            $code->($promise);
        });
    }

    return $promise;
}

sub resolved { deferred->resolve(@_) }
sub rejected { deferred->reject(@_)  }

sub collect_hash {
    collect(@_)->then( sub {
    map {
        my @values = @$_;
        die "'collect_hash' promise returned more than one value: [@{[ join ', ', @values ]} ]\n"
            if @values > 1;

        @values == 1 ? $values[0] : undef;
    } @_ })
}

sub collect {
    my @promises = @_;

    my $all_done = resolved();

    for my $p ( @promises ) {
        my @results;
        $all_done = $all_done->then( sub {
            @results = @_;
            return $p;
        } )->then(sub{ ( @results, [ @_ ] ) } );
    }

    return $all_done;
}

1;

__END__