line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
{ |
2
|
|
|
|
|
|
|
package Filter::Include; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
$VERSION = '1.7'; |
5
|
|
|
|
|
|
|
|
6
|
5
|
|
|
5
|
|
148358
|
use strict; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
215
|
|
7
|
|
|
|
|
|
|
# XXX - this is dropped for the sake of pre-5.6 perls |
8
|
|
|
|
|
|
|
# use warnings; |
9
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
23
|
use Carp 'croak'; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
281
|
|
11
|
5
|
|
|
5
|
|
21
|
use Scalar::Util 'reftype'; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
405
|
|
12
|
5
|
|
|
5
|
|
2820
|
use File::Spec::Functions 'catfile'; |
|
5
|
|
|
|
|
3618
|
|
|
5
|
|
|
|
|
323
|
|
13
|
5
|
|
|
5
|
|
2537
|
use Module::Locate Global => 1, 'get_source'; |
|
5
|
|
|
|
|
29319
|
|
|
5
|
|
|
|
|
36
|
|
14
|
|
|
|
|
|
|
|
15
|
5
|
|
|
5
|
|
334
|
use vars '$MATCH_RE'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
881
|
|
16
|
|
|
|
|
|
|
$MATCH_RE = qr{ ^ \043 ? \s* include \s+ (.+?) ;? $ }xm; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub install_handler { |
19
|
4
|
|
|
4
|
0
|
6
|
my($name, $handler) = @_; |
20
|
|
|
|
|
|
|
|
21
|
4
|
50
|
0
|
|
|
29
|
croak "The $name handler must be a CODE reference, was given: " . |
|
|
|
33
|
|
|
|
|
22
|
|
|
|
|
|
|
ref($handler) || $handler |
23
|
|
|
|
|
|
|
if !ref $handler or reftype $handler ne 'CODE'; |
24
|
|
|
|
|
|
|
|
25
|
5
|
|
|
5
|
|
39
|
no strict 'refs'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
907
|
|
26
|
4
|
|
|
|
|
5
|
*{$name . '_handler'} = $handler; |
|
4
|
|
|
|
|
35
|
|
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub import { |
30
|
|
|
|
|
|
|
my( $called_by, %args ) = @_; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
install_handler $_ => delete $args{$_} |
33
|
|
|
|
|
|
|
for grep exists $args{$_}, qw/ before after pre post /; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
## There's probably a nice module to do this somewhere ... |
37
|
|
|
|
|
|
|
sub handler { |
38
|
24
|
|
|
24
|
0
|
61
|
my $name = shift(@_) . '_handler'; |
39
|
24
|
|
|
|
|
89
|
my $handler = \&$name; |
40
|
|
|
|
|
|
|
|
41
|
24
|
100
|
|
|
|
94
|
goto &$handler |
42
|
|
|
|
|
|
|
if defined &$name; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
5
|
|
|
5
|
|
29
|
use vars '$LINE'; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
2858
|
|
46
|
|
|
|
|
|
|
sub _filter { |
47
|
6
|
|
|
6
|
|
12
|
local $_ = shift; |
48
|
|
|
|
|
|
|
|
49
|
6
|
|
|
|
|
77
|
s{$MATCH_RE}{ |
50
|
7
|
|
|
|
|
23
|
my $include = $1; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
## Only do this the first time. |
53
|
7
|
100
|
|
|
|
36
|
$LINE = _find_initial_lineno($_, $&) |
54
|
|
|
|
|
|
|
unless defined $LINE; |
55
|
|
|
|
|
|
|
|
56
|
7
|
|
|
|
|
21
|
_source($include); |
57
|
|
|
|
|
|
|
}ge; |
58
|
|
|
|
|
|
|
|
59
|
6
|
|
|
|
|
23
|
$LINE += tr[\n][\n]; |
60
|
|
|
|
|
|
|
|
61
|
6
|
|
|
|
|
30
|
return $_ . "\n#line $LINE\n"; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
## work magic to find the first line number so #line declarations are correct |
65
|
|
|
|
|
|
|
sub _find_initial_lineno { |
66
|
4
|
|
|
4
|
|
12
|
my($src, $match) = @_; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
## Find the number of lines before the $match in $src. |
69
|
4
|
|
|
|
|
40
|
my $include_at = () = substr($src, 0, index($src, $match)) =~ /^(.?)/mg; |
70
|
|
|
|
|
|
|
|
71
|
4
|
|
|
|
|
10
|
my($i, $called_from) = 0; |
72
|
4
|
|
|
|
|
77
|
$called_from = ( caller $i++ )[2] |
73
|
|
|
|
|
|
|
while caller $i; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
## We need the caller's line num in addition to the number of lines before |
76
|
|
|
|
|
|
|
## the match substring as Filter::Simple only filters after it is called. |
77
|
4
|
|
|
|
|
17
|
return $include_at + $called_from; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub _resolve_source { |
81
|
7
|
|
|
7
|
|
8
|
my $include = shift; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Looks like a package so treat it like one. |
84
|
7
|
100
|
|
|
|
63
|
return $include, get_source($include) |
85
|
|
|
|
|
|
|
if $include =~ $Module::Locate::PkgRe; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Probably got a string so attempt to get a path. |
88
|
5
|
|
|
|
|
6
|
local $@; |
89
|
5
|
|
|
|
|
308
|
my $path = eval $include; |
90
|
|
|
|
|
|
|
|
91
|
5
|
50
|
|
|
|
23
|
croak "Filter::Include - failed to resolve filename from '$path' - $@" |
92
|
|
|
|
|
|
|
if $@; |
93
|
|
|
|
|
|
|
|
94
|
5
|
50
|
|
|
|
204
|
open my $fh, '<', $path |
95
|
|
|
|
|
|
|
or croak "Filter::Include - couldn't open '$path' for reading - $!"; |
96
|
|
|
|
|
|
|
|
97
|
5
|
|
|
|
|
23
|
local $/; |
98
|
5
|
|
|
|
|
167
|
return $path, <$fh>; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub _source { |
102
|
7
|
|
|
7
|
|
12
|
my $source = shift; |
103
|
|
|
|
|
|
|
|
104
|
7
|
50
|
|
|
|
18
|
return '' |
105
|
|
|
|
|
|
|
unless defined $source; |
106
|
|
|
|
|
|
|
|
107
|
7
|
|
|
|
|
17
|
my($include, $data) = _resolve_source($source); |
108
|
|
|
|
|
|
|
|
109
|
7
|
|
|
|
|
726
|
$data = _expand_source($include, $data); |
110
|
|
|
|
|
|
|
|
111
|
7
|
|
|
|
|
51
|
return $data; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub _expand_source { |
115
|
7
|
|
|
7
|
|
13
|
my($include, $data) = @_; |
116
|
|
|
|
|
|
|
|
117
|
7
|
|
|
|
|
16
|
handler pre => $include, $data; |
118
|
|
|
|
|
|
|
|
119
|
7
|
100
|
|
|
|
1255
|
$data = _filter($data) |
120
|
|
|
|
|
|
|
if $data =~ $MATCH_RE; |
121
|
|
|
|
|
|
|
|
122
|
7
|
|
|
|
|
17
|
handler post => $include, $data; |
123
|
|
|
|
|
|
|
|
124
|
7
|
|
|
|
|
1154
|
return $data; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
5
|
|
|
5
|
|
7054
|
use Filter::Simple; |
|
5
|
|
|
|
|
88114
|
|
|
5
|
|
|
|
|
32
|
|
128
|
|
|
|
|
|
|
FILTER { |
129
|
|
|
|
|
|
|
## You are crazy Filter::Simple, quite simply mad. |
130
|
|
|
|
|
|
|
return |
131
|
|
|
|
|
|
|
if /\A\s*\z/s; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
handler before => $_; |
134
|
|
|
|
|
|
|
$_ = _filter($_); |
135
|
|
|
|
|
|
|
handler after => $_; |
136
|
|
|
|
|
|
|
}; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
q. The End.; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=pod |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head1 NAME |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Filter::Include - Emulate the behaviour of the C<#include> directive |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 SYNOPSIS |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
use Filter::Include; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
include Foo::Bar; |
152
|
|
|
|
|
|
|
include "somefile.pl"; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
## or the C preprocessor directive style: |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#include Some::Class |
157
|
|
|
|
|
|
|
#include "little/library.pl" |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=head1 DESCRIPTION |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Take the C<#include> preproccesor directive from C, stir in some C |
162
|
|
|
|
|
|
|
semantics and we have this module. Only one keyword is used, C, which |
163
|
|
|
|
|
|
|
is really just a processor directive for the filter, which indicates the file to |
164
|
|
|
|
|
|
|
be included. The argument supplied to C will be handled like it would |
165
|
|
|
|
|
|
|
by C and C |
166
|
|
|
|
|
|
|
populated. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 #include |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
For those who have not come across C's C<#include> preprocessor directive |
171
|
|
|
|
|
|
|
this section shall explain briefly what it does. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
When the C preprocessor sees the C<#include> directive, it will include the |
174
|
|
|
|
|
|
|
given file straight into the source. The file is dumped directly to where |
175
|
|
|
|
|
|
|
C<#include> previously stood, so becomes part of the source of the given file |
176
|
|
|
|
|
|
|
when it is compiled. This is used primarily for C's header files so function |
177
|
|
|
|
|
|
|
and data predeclarations can be nicely separated out. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
So given a small script like this: |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
## conf.pl |
182
|
|
|
|
|
|
|
my $conf = { lots => 'of', configuration => 'info' }; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
We can pull this file I in to the source of the following script |
185
|
|
|
|
|
|
|
using C |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
use Filter::Include; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
include 'conf.pl'; |
190
|
|
|
|
|
|
|
print join(' ', map { $_, $conf->{$_} } reverse sort keys %$conf), "\n"; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Once the filter is applied to the file above the source will look like this: |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
## conf.pl |
195
|
|
|
|
|
|
|
my $conf = { lots => 'of', configuration => 'info' }; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
print join(' ', map { $_, $conf->{$_} } reverse sort keys %$conf), "\n"; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
So unlike C's native file include functions C pulls the |
200
|
|
|
|
|
|
|
source of the file to be included I into the caller's source without |
201
|
|
|
|
|
|
|
any code evaluation. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head2 Why not to use C<-P> |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
To quote directly from L: |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
NOTE: Use of -P is strongly discouraged because of its inherent problems, |
208
|
|
|
|
|
|
|
including poor portability. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
So while you can use the C<#include> natively in C it comes with the |
211
|
|
|
|
|
|
|
baggage of the C preprocessor. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head1 HANDLERS |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
C has a facility to install handlers at various points of the |
216
|
|
|
|
|
|
|
filtering process. These handlers can be installed by passing in the name of the |
217
|
|
|
|
|
|
|
handler and an associated subroutine e.g |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
use Filter::Include pre => sub { |
220
|
|
|
|
|
|
|
my $include = shift; |
221
|
|
|
|
|
|
|
print "Including $inc\n"; |
222
|
|
|
|
|
|
|
}, |
223
|
|
|
|
|
|
|
after => sub { |
224
|
|
|
|
|
|
|
my $code = shift; |
225
|
|
|
|
|
|
|
print "The resulting source looks like:\n$code\n"; |
226
|
|
|
|
|
|
|
}; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
This will install the C and C handlers (documented below). |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
These handlers are going to be most suited for debugging purposes but could also |
231
|
|
|
|
|
|
|
be useful for tracking module usage. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=over 4 |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=item pre/post |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Both handlers take two positional arguments - the current include e.g |
238
|
|
|
|
|
|
|
C or C, and the source of the include which in the |
239
|
|
|
|
|
|
|
case of the C handler is the source before it is parsed and in the case of |
240
|
|
|
|
|
|
|
the C handler it is the source after it has been parsed and updated as |
241
|
|
|
|
|
|
|
appropriate. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=item before/after |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Both handlers take a single argument - a string representing the relevant |
246
|
|
|
|
|
|
|
source code. The C handler is called I any filtering is |
247
|
|
|
|
|
|
|
performed so it will get the pre-filtered source as its first argument. The |
248
|
|
|
|
|
|
|
C handler is called I the filtering has been performed so will |
249
|
|
|
|
|
|
|
get the source post-filtered as its first argument. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=back |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=head1 AUTHOR |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Dan Brook C<< >> |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head1 SEE ALSO |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
C, -P in L, L, L |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=cut |