local-lib5/lib/perl5/Context/Preserve.pm

   1 package Context::Preserve;
   2 use strict;
   3 use warnings;
   4 use Carp;
   5
   6 use base 'Exporter';
   7 our @EXPORT = qw(preserve_context);
   8
   9 our $VERSION = '0.01';
  10
  11 sub preserve_context(&@) {
  12     my $orig = shift;
  13     my %args = @_;
  14
  15     my $replace = $args{replace};
  16     my $after   = $args{after};
  17
  18     croak 'need an "after" or "replace" coderef'
  19       unless $replace || $after;
  20
  21     if(!defined wantarray){
  22         $orig->();
  23         if($after){
  24             $after->();
  25         }
  26         else {
  27             $replace->();
  28         }
  29         return;
  30     }
  31     elsif(wantarray){
  32         my @result  = $orig->();
  33         if($after){
  34             my @ignored = $after->(@result);
  35         }
  36         else {
  37             @result = $replace->(@result);
  38         }
  39         return @result;
  40     }
  41     else {
  42         my $result  = $orig->();
  43         if($after){
  44             my $ignored = $after->($result);
  45         }
  46         else {
  47             $result = $replace->($result);
  48         }
  49         return $result;
  50     }
  51 }
  52
  53 1;
  54 __END__
  55
  56 =head1 NAME
  57
  58 Context::Preserve - run code after a subroutine call, preserving the context the subroutine would have seen if it were the last statement in the caller
  59
  60 =head1 SYNOPSIS
  61
  62 Have you ever written this?
  63
  64     my ($result, @result);
  65
  66     # run a sub in the correct context
  67     if(!defined wantarray){
  68         some::code();
  69     }
  70     elsif(wantarray){
  71         @result = some::code();
  72     }
  73     else {
  74         $result = some::code();
  75     }
  76
  77     # do something after some::code
  78     $_ += 42 for (@result, $result);
  79
  80     # finally return the correct value
  81     if(!defined wantarray){
  82         return;
  83     }
  84     elsif(wantarray){
  85         return @result;
  86     }
  87     else {
  88         return $result;
  89     }
  90
  91 Now you can just write this instead:
  92
  93   use Context::Preserve;
  94
  95   return preserve_context { some::code() }
  96              after => sub { $_ += 42 for @_ };
  97
  98 =head1 DESCRIPTION
  99
 100 Sometimes you need to call a function, get the results, act on the
 101 results, then return the result of the function.  This is painful
 102 because of contexts; the original function can behave different if
 103 it's called in void, scalar, or list context.  You can ignore the
 104 various cases and just pick one, but that's fragile.  To do things
 105 right, you need to see which case you're being called in, and then
 106 call the function in that context.  This results in 3 code paths,
 107 which is a pain to type in (and maintain).
 108
 109 This module automates the process.  You provide a coderef that is the
 110 "original function", and another coderef to run after the original
 111 runs.  You can modify the return value (aliased to @_) here, and do
 112 whatever else you need to do.  C<wantarray> is correct inside both
 113 coderefs; in "after", though, the return value is ignored and the
 114 value C<wantarray> returns is related to the context that the original
 115 function was called in.
 116
 117 =head1 EXPORT
 118
 119 C<preserve_context>
 120
 121 =head1 FUNCTIONS
 122
 123 =head2 preserve_context { original } [after|replace] => sub { after }
 124
 125 Invokes C<original> in the same context as C<preserve_context> was
 126 called in, save the results, runs C<after> in the same context, then
 127 returns the result of C<original> (or C<after> if C<replace> is used).
 128
 129 If the second argument is C<after>, then you can modify C<@_> to
 130 affect the return value.  C<after>'s return value is ignored.
 131
 132 If the second argument is C<replace>, then modifying C<@_> doesn't do
 133 anything.  The return value of C<after> is returned from
 134 C<preserve_context> instead.
 135
 136 Run C<preserve_context> like this:
 137
 138   sub whatever {
 139       ...
 140       return preserve_context { orginal_function() }
 141                  after => sub { modify @_          };
 142   }
 143
 144   or
 145
 146   sub whatever {
 147       ...
 148       return preserve_context   { orginal_function() }
 149                  replace => sub { return @new_return };
 150   }
 151
 152
 153 Note that there's no comma between the first block and the C<< after
 154 => >> part.  This is how perl parses functions with the C<(&@)>
 155 prototype.  The alternative is to say:
 156
 157       preserve_context(sub { original }, after => sub { after });
 158
 159 You can pick the one you like, but I think the first version is much
 160 prettier.
 161
 162 =head1 AUTHOR AND COPYRIGHT
 163
 164 Jonathan Rockway C<< <jrockway@cpan.org> >>
 165
 166 Copyright (c) 2008 Infinity Interactive.  You may redistribute this
 167 module under the same terms as Perl itself.
 168
 169