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