[Summary view] [Print] [Text view]

   1  package Unattend::Promise;
   2  
   3  use warnings;
   4  use strict;
   5  use Carp;
   6  
   7  use overload
   8      'fallback' => 1;
   9  
  10  my $magic_str = "Unattend::Promise magic string";
  11  my $magic_ref = \$magic_str;
  12  
  13  # Create a sub which behaves exactly like our argument, but different
  14  # in one subtle way.
  15  sub _wrap ($) {
  16      my ($proc) = @_;
  17  
  18      return sub (@) {
  19          my @args = @_;
  20          if (exists $args[0] && ref $args[0] && $args[0] == $magic_ref) {
  21              # Special magic to let us retrieve or modify the proc.
  22              my $old_proc = $proc;
  23              exists $args[1]
  24                  and $proc = $args[1];
  25              return $old_proc;
  26          }
  27  
  28          # The usual case; do what the original proc does.
  29          return &$proc (@args);
  30      };
  31  }
  32  
  33  sub new {
  34      my ($proto, $proc) = @_;
  35      my $class = ref $proto || $proto;
  36  
  37      defined $proc && ref $proc eq 'CODE'
  38          or croak "Argument to Unattend::Promise->new not a sub... bailing";
  39  
  40      my $self = _wrap ($proc);
  41  
  42      return bless $self, $class;
  43  }
  44  
  45  sub force {
  46      my ($self) = @_;
  47  
  48      my $value = &$self ();
  49      &$self ($magic_ref, sub { return $value });
  50  
  51      return $value;
  52  }
  53  
  54  1;