lib/Object/Remote/Future.pm

   1 package Object::Remote::Future;
   2
   3 use strict;
   4 use warnings;
   5 use base qw(Exporter);
   6
   7 use Object::Remote::Logging qw( :log );
   8
   9 use CPS::Future;
  10
  11 our @EXPORT = qw(future await_future await_all);
  12
  13 sub future (&;$) {
  14   my $f = $_[0]->(CPS::Future->new);
  15   return $f if ((caller(1+($_[1]||0))||'') eq 'start');
  16   await_future($f);
  17 }
  18
  19 our @await;
  20
  21 sub await_future {
  22   my $f = shift;
  23   return $f if $f->is_ready;
  24   require Object::Remote;
  25   my $loop = Object::Remote->current_loop;
  26   {
  27     local @await = (@await, $f);
  28     $f->on_ready(sub {
  29       $loop->stop if $f == $await[-1]
  30     });
  31     $loop->run;
  32   }
  33   if (@await and $await[-1]->is_ready) {
  34     $loop->stop;
  35   }
  36   return wantarray ? $f->get : ($f->get)[0];
  37 }
  38
  39 sub await_all {
  40   await_future(CPS::Future->wait_all(@_));
  41   map $_->get, @_;
  42 }
  43
  44 package start;
  45
  46 our $start = sub { my ($obj, $call) = (shift, shift); $obj->$call(@_); };
  47
  48 sub AUTOLOAD {
  49   my $invocant = shift;
  50   my ($method) = our $AUTOLOAD =~ /^start::(.+)$/;
  51   my $res;
  52   unless (eval { $res = $invocant->$method(@_); 1 }) {
  53     my $f = CPS::Future->new;
  54     $f->fail($@);
  55     return $f;
  56   }
  57   unless (Scalar::Util::blessed($res) and $res->isa('CPS::Future')) {
  58     my $f = CPS::Future->new;
  59     $f->done($res);
  60     return $f;
  61   }
  62   return $res;
  63 }
  64
  65 package maybe;
  66
  67 sub start {
  68   my ($obj, $call) = (shift, shift);
  69   if ((caller(1)||'') eq 'start') {
  70     $obj->$start::start($call => @_);
  71   } else {
  72     $obj->$call(@_);
  73   }
  74 }
  75
  76 package maybe::start;
  77
  78 sub AUTOLOAD {
  79   my $invocant = shift;
  80   my ($method) = our $AUTOLOAD =~ /^maybe::start::(.+)$/;
  81   $method = "start::${method}" if ((caller(1)||'') eq 'start');
  82   $invocant->$method(@_);
  83 }
  84
  85 package then;
  86
  87 sub AUTOLOAD {
  88   my $invocant = shift;
  89   my ($method) = our $AUTOLOAD =~ /^then::(.+)$/;
  90   my @args = @_;
  91   # Need two copies since if we're called on an already complete future
  92   # $f will be freed immediately
  93   my $ret = my $f = CPS::Future->new;
  94   $invocant->on_fail(sub { $f->fail(@_); undef($f); });
  95   $invocant->on_done(sub {
  96     my ($obj) = @_;
  97     my $next = $obj->${\"start::${method}"}(@args);
  98     $next->on_done(sub { $f->done(@_); undef($f); });
  99     $next->on_fail(sub { $f->fail(@_); undef($f); });
 100   });
 101   return $ret;
 102 }
 103
 104 1;
 105
 106 =head1 NAME
 107
 108 Object::Remote::Future - Asynchronous calling for L<Object::Remote>
 109
 110 =head1 LAME
 111
 112 Shipping prioritised over writing this part up. Blame mst.
 113
 114 =cut