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