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