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