line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Sub::Filter - automatically filter function's return value |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use Sub::Filter qw(mutate_sub_filter_return); |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
mutate_sub_filter_return(\&get_height, \&num_checker); |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Sub::Filter qw(filter_return); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub get_height :filter_return(num_checker) { ... |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 DESCRIPTION |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
This module allows a function to be augmented with a filter that will be |
18
|
|
|
|
|
|
|
applied to its return values. Whenever the function returns, by whatever |
19
|
|
|
|
|
|
|
means, the value (or list of values) being returned is passed through the |
20
|
|
|
|
|
|
|
filter before going to the caller. The filter may be any function, and |
21
|
|
|
|
|
|
|
may perform type checking/coercion, logging, or any other manipulation. |
22
|
|
|
|
|
|
|
The filtering is invisible to the body of the augmented function: the |
23
|
|
|
|
|
|
|
stack shows its normal caller, not a wrapping stack frame. |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head2 Return filtering |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
When using a return filter, the resulting augmented function is |
28
|
|
|
|
|
|
|
effectively composed from two simpler functions, the main function and |
29
|
|
|
|
|
|
|
the filter function. When the augmented function is called, first the |
30
|
|
|
|
|
|
|
main function executes, then when that returns the filter function has |
31
|
|
|
|
|
|
|
a chance to munge the return value. The main function doesn't actually |
32
|
|
|
|
|
|
|
have an independent callable identity. The filter function, however, |
33
|
|
|
|
|
|
|
is completely distinct, callable in its own right, and can act as a |
34
|
|
|
|
|
|
|
filter for several augmented functions simultaneously. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
When the main function executes, it appears to be being called |
37
|
|
|
|
|
|
|
independently in the normal manner. The L |
38
|
|
|
|
|
|
|
function shows that the immediate caller is whatever code actually |
39
|
|
|
|
|
|
|
called the augmented function, and lower-level tricks that get a more |
40
|
|
|
|
|
|
|
detailed view of the stack show the same situation. The main function |
41
|
|
|
|
|
|
|
body is aware of the calling context as usual, which it can check using |
42
|
|
|
|
|
|
|
L. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
When the main body returns, the filter function is implicitly called. |
45
|
|
|
|
|
|
|
L will show that it is called from (the return |
46
|
|
|
|
|
|
|
statement of) the augmented function. The filter function executes |
47
|
|
|
|
|
|
|
with the same calling context that the main function had, and whatever |
48
|
|
|
|
|
|
|
the filter function returns will be used as the return value of the |
49
|
|
|
|
|
|
|
augmented function. The values returned by the main function body are |
50
|
|
|
|
|
|
|
available to the filter function as its arguments. The nature of these |
51
|
|
|
|
|
|
|
arguments will depend on the calling context: in scalar context it will |
52
|
|
|
|
|
|
|
be exactly one value, and in void context it will be no values at all. |
53
|
|
|
|
|
|
|
The filter function must be prepared for these situations. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
If the main function, written in Perl, does a C, this replaces |
56
|
|
|
|
|
|
|
the entire stack frame of the augmented function, and the filter function |
57
|
|
|
|
|
|
|
will not be called. Likewise, L can bypass the |
58
|
|
|
|
|
|
|
filter, returning directly to the caller of the augmented function. |
59
|
|
|
|
|
|
|
These are ugly tricks that mess with the stack. Throwing an exception, |
60
|
|
|
|
|
|
|
by L, also causes the filter not to run, but in this |
61
|
|
|
|
|
|
|
case there is no return value to filter. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
The main function to which a filter is to be applied may be either pure |
64
|
|
|
|
|
|
|
Perl or XS (native code, usually written in C). The filter function |
65
|
|
|
|
|
|
|
may also be either pure Perl or XS, and either type of filter function |
66
|
|
|
|
|
|
|
can be attached to either type of main function. It is also possible |
67
|
|
|
|
|
|
|
to apply multiple filters to one main function, effectively using an |
68
|
|
|
|
|
|
|
augmented function (main plus filter) as the main function to attach |
69
|
|
|
|
|
|
|
another filter to. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
package Sub::Filter; |
74
|
|
|
|
|
|
|
|
75
|
14
|
|
|
14
|
|
325849
|
{ use 5.008001; } |
|
14
|
|
|
|
|
52
|
|
|
14
|
|
|
|
|
589
|
|
76
|
14
|
|
|
14
|
|
77
|
use warnings; |
|
14
|
|
|
|
|
27
|
|
|
14
|
|
|
|
|
492
|
|
77
|
14
|
|
|
14
|
|
71
|
use strict; |
|
14
|
|
|
|
|
23
|
|
|
14
|
|
|
|
|
600
|
|
78
|
|
|
|
|
|
|
|
79
|
14
|
|
|
14
|
|
70
|
use Carp qw(croak); |
|
14
|
|
|
|
|
26
|
|
|
14
|
|
|
|
|
2234
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
our $VERSION = "0.004"; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
my %SUB_EXPORT_OK = map { $_ => undef } qw(mutate_sub_filter_return); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub import { |
86
|
14
|
|
|
14
|
|
98
|
my $package = shift(@_); |
87
|
14
|
|
|
|
|
115
|
foreach(@_) { |
88
|
5
|
100
|
|
|
|
77
|
if(exists $SUB_EXPORT_OK{$_}) { |
|
|
50
|
|
|
|
|
|
89
|
14
|
|
|
14
|
|
115
|
no strict "refs"; |
|
14
|
|
|
|
|
23
|
|
|
14
|
|
|
|
|
3745
|
|
90
|
4
|
|
|
|
|
11
|
*{caller()."::".$_} = \&$_; |
|
4
|
|
|
|
|
66
|
|
91
|
|
|
|
|
|
|
} elsif($_ eq "filter_return") { |
92
|
1
|
|
|
|
|
849
|
require Attribute::Lexical; |
93
|
1
|
|
|
|
|
10444
|
Attribute::Lexical->VERSION(0.004); |
94
|
1
|
|
|
|
|
1539
|
require Sub::Mutate; |
95
|
0
|
|
|
|
|
|
Sub::Mutate->VERSION(0.005); |
96
|
0
|
|
|
|
|
|
Attribute::Lexical->import("CODE:filter_return" => |
97
|
|
|
|
|
|
|
\&_handle_attr_filter_return); |
98
|
|
|
|
|
|
|
} else { |
99
|
0
|
|
|
|
|
|
croak "\"$_\" is not exported by the $package module"; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
require XSLoader; |
105
|
|
|
|
|
|
|
XSLoader::load(__PACKAGE__, $VERSION); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 FUNCTION |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=over |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=item mutate_sub_filter_return(SUB, FILTER) |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
I and I must both be references to subroutines. I is |
114
|
|
|
|
|
|
|
modified in place, such that whatever I returns will be filtered |
115
|
|
|
|
|
|
|
through I. The subroutine's identity is not changed, but the |
116
|
|
|
|
|
|
|
behaviour of the existing subroutine is changed. Beware of action at |
117
|
|
|
|
|
|
|
a distance. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
This is best done at compile time, preferably in a C block |
120
|
|
|
|
|
|
|
immediately after the initial definition of I. It is preferable, |
121
|
|
|
|
|
|
|
where possible, to use the subroutine attribute described below. |
122
|
|
|
|
|
|
|
This function exists mainly for awkward situations where the attribute |
123
|
|
|
|
|
|
|
is difficult to use. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=back |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head1 SUBROUTINE ATTRIBUTE |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
The visibility of this attribute is controlled by lexical (block) |
130
|
|
|
|
|
|
|
scoping, managed by L. To make it available in the |
131
|
|
|
|
|
|
|
current block, include C in the import list in the C |
132
|
|
|
|
|
|
|
statement for this module, as shown in the synopsis. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=over |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=item :filter_return(FILTER) |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
The function to which this attribute is applied will be augmented, such |
139
|
|
|
|
|
|
|
that whatever it returns will be filtered through the function specified |
140
|
|
|
|
|
|
|
by I. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
I must be the name of a function. It may be either |
143
|
|
|
|
|
|
|
fully-qualified (e.g., C), or an unqualified name |
144
|
|
|
|
|
|
|
(e.g., C) referring to a function in the current package |
145
|
|
|
|
|
|
|
(current where the attribute is used). (It is not possible to use an |
146
|
|
|
|
|
|
|
anonymous filter function this way; see L |
147
|
|
|
|
|
|
|
if you need to do that.) |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=cut |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub _handle_attr_filter_return { |
152
|
0
|
|
|
0
|
|
|
my($target, $attname, $arg, $caller) = @_; |
153
|
0
|
0
|
|
|
|
|
$arg = "" unless defined $arg; |
154
|
0
|
|
|
|
|
|
my $filterer; |
155
|
0
|
0
|
|
|
|
|
if($arg =~ /\A[A-Za-z_][0-9A-Za-z_]*\z/) { |
|
|
0
|
|
|
|
|
|
156
|
14
|
|
|
14
|
|
74
|
no strict "refs"; |
|
14
|
|
|
|
|
24
|
|
|
14
|
|
|
|
|
1393
|
|
157
|
0
|
|
|
|
|
|
$filterer = \&{$caller->[0]."::".$arg}; |
|
0
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
} elsif($arg =~ /\A(?:[0-9A-Za-z_]+::)+[A-Za-z_][0-9A-Za-z_]*\z/) { |
159
|
14
|
|
|
14
|
|
107
|
no strict "refs"; |
|
14
|
|
|
|
|
23
|
|
|
14
|
|
|
|
|
1876
|
|
160
|
0
|
|
|
|
|
|
$filterer = \&$arg; |
161
|
|
|
|
|
|
|
} else { |
162
|
0
|
|
|
|
|
|
croak "attribute :$attname needs a function name argument"; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
Sub::Mutate::when_sub_bodied($target, sub { |
165
|
0
|
|
|
0
|
|
|
mutate_sub_filter_return($_[0], $filterer); |
166
|
0
|
|
|
|
|
|
}); |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=back |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 BUGS |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
A filter cannot be attached to a Perl function that shares its op tree |
174
|
|
|
|
|
|
|
with another. This can happen due to threading, or due to closures (where |
175
|
|
|
|
|
|
|
all closures from a single source share one op tree). This limitation |
176
|
|
|
|
|
|
|
should be removed in a future version. The problem does not occur if |
177
|
|
|
|
|
|
|
a filter is attached before the sharing arises. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
Filtering on an lvalue subroutine currently breaks the lvalue behaviour. |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
The way a filter is attached to a pure Perl main function confuses |
182
|
|
|
|
|
|
|
L. The resulting augmented function consists of a network of |
183
|
|
|
|
|
|
|
op nodes, just like a pure Perl function, but the nodes fit together in |
184
|
|
|
|
|
|
|
a structure that the Perl compiler never generates. This is ultimately |
185
|
|
|
|
|
|
|
because the call to the filter function is difficult to express in pure |
186
|
|
|
|
|
|
|
Perl, due to the context-dependent behaviour. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 SEE ALSO |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
L, |
191
|
|
|
|
|
|
|
L |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head1 AUTHOR |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Andrew Main (Zefram) |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 COPYRIGHT |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
Copyright (C) 2009, 2010, 2013 Andrew Main (Zefram) |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head1 LICENSE |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it |
204
|
|
|
|
|
|
|
under the same terms as Perl itself. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=cut |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
1; |