File Coverage

blib/lib/Sub/Filter.pm
Criterion Covered Total %
statement 29 42 69.0
branch 3 10 30.0
condition n/a
subroutine 8 10 80.0
pod n/a
total 40 62 64.5


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;