Commit | Line | Data |
3fea05b9 |
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 | |