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