| 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; |