1package Context::Preserve; 2use strict; 3use warnings; 4use Carp; 5 6use base 'Exporter'; 7our @EXPORT = qw(preserve_context); 8 9our $VERSION = '0.01'; 10 11sub 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 531; 54__END__ 55 56=head1 NAME 57 58Context::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 62Have 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 91Now 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 100Sometimes you need to call a function, get the results, act on the 101results, then return the result of the function. This is painful 102because of contexts; the original function can behave different if 103it's called in void, scalar, or list context. You can ignore the 104various cases and just pick one, but that's fragile. To do things 105right, you need to see which case you're being called in, and then 106call the function in that context. This results in 3 code paths, 107which is a pain to type in (and maintain). 108 109This module automates the process. You provide a coderef that is the 110"original function", and another coderef to run after the original 111runs. You can modify the return value (aliased to @_) here, and do 112whatever else you need to do. C<wantarray> is correct inside both 113coderefs; in "after", though, the return value is ignored and the 114value C<wantarray> returns is related to the context that the original 115function was called in. 116 117=head1 EXPORT 118 119C<preserve_context> 120 121=head1 FUNCTIONS 122 123=head2 preserve_context { original } [after|replace] => sub { after } 124 125Invokes C<original> in the same context as C<preserve_context> was 126called in, save the results, runs C<after> in the same context, then 127returns the result of C<original> (or C<after> if C<replace> is used). 128 129If the second argument is C<after>, then you can modify C<@_> to 130affect the return value. C<after>'s return value is ignored. 131 132If the second argument is C<replace>, then modifying C<@_> doesn't do 133anything. The return value of C<after> is returned from 134C<preserve_context> instead. 135 136Run 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 153Note that there's no comma between the first block and the C<< after 154=> >> part. This is how perl parses functions with the C<(&@)> 155prototype. The alternative is to say: 156 157 preserve_context(sub { original }, after => sub { after }); 158 159You can pick the one you like, but I think the first version is much 160prettier. 161 162=head1 AUTHOR AND COPYRIGHT 163 164Jonathan Rockway C<< <jrockway@cpan.org> >> 165 166Copyright (c) 2008 Infinity Interactive. You may redistribute this 167module under the same terms as Perl itself. 168 169 170