view release on metacpan or  search on metacpan

lib/Future/PP.pm  view on Meta::CPAN

   CB_RESULT => 1<<4, # Pass result/failure as a list

   CB_SEQ_ONDONE => 1<<5, # Sequencing on success (->then)
   CB_SEQ_ONFAIL => 1<<6, # Sequencing on failure (->else)

   CB_SEQ_IMDONE => 1<<7, # $code is in fact immediate ->done result
   CB_SEQ_IMFAIL => 1<<8, # $code is in fact immediate ->fail result

   CB_SEQ_STRICT => 1<<9, # Complain if $code didn't return a Future
};

use constant CB_ALWAYS => CB_DONE|CB_FAIL|CB_CANCEL;

sub _shortmess
{
   my $at = Carp::shortmess( $_[0] );
   chomp $at; $at =~ s/\.$//;
   return $at;
}

sub _callable
{
   my ( $cb ) = @_;
   defined $cb and ( reftype($cb) eq 'CODE' || overload::Method($cb, '&{}') );
}

sub new
{
   my $proto = shift;
   return bless {
      ready     => 0,
      callbacks => [], # [] = [$type, ...]
      ( DEBUG ?
         ( do { my $at = Carp::shortmess( "constructed" );
                chomp $at; $at =~ s/\.$//;
                constructed_at => $at } )
         : () ),
      ( $Future::TIMES ?
         ( btime => [ gettimeofday ] )
         : () ),
   }, ( ref $proto || $proto );
}

sub __selfstr
{
   my $self = shift;
   my $str = "$self";
   $str .= " (\"$self->{label}\")" if defined $self->{label};
   $str .= " ($self->{constructed_at})" if defined $self->{constructed_at};
   return $str;
}

my $GLOBAL_END;
END { $GLOBAL_END = 1; }

sub DESTROY_debug {
   my $self = shift;
   return if $GLOBAL_END;
   return if $self->{ready} and ( $self->{reported} or !$self->{failure} );

   my $lost_at = join " line ", (caller)[1,2];
   # We can't actually know the real line where the last reference was lost; 
   # a variable set to 'undef' or close of scope, because caller can't see it;
   # the current op has already been updated. The best we can do is indicate
   # 'near'.

   if( $self->{ready} and $self->{failure} ) {
      warn "${\$self->__selfstr} was lost near $lost_at with an unreported failure of: " .
         $self->{failure}[0] . "\n";
   }
   elsif( !$self->{ready} ) {
      warn "${\$self->__selfstr} was lost near $lost_at before it was ready.\n";
   }
}
*DESTROY = \&DESTROY_debug if DEBUG;

sub is_ready
{
   my $self = shift;
   return $self->{ready};
}

sub is_done
{
   my $self = shift;
   return $self->{ready} && !$self->{failure} && !$self->{cancelled};
}

sub is_failed
{
   my $self = shift;
   return $self->{ready} && !!$self->{failure}; # boolify
}

sub is_cancelled
{
   my $self = shift;
   return $self->{cancelled};
}

sub state
{
   my $self = shift;
   return !$self->{ready}     ? "pending" :
           DEBUG              ? $self->{ready_at} :
           $self->{failure}   ? "failed" :
           $self->{cancelled} ? "cancelled" :
                                "done";
}

sub _mark_ready
{
   my $self = shift;
   $self->{ready} = 1;
   $self->{ready_at} = _shortmess $_[0] if DEBUG;

   if( $Future::TIMES ) {
      $self->{rtime} = [ gettimeofday ];
   }

   delete $self->{on_cancel};