File Coverage

blib/lib/Filter/Include.pm
Criterion Covered Total %
statement 64 64 100.0
branch 12 16 75.0
condition 1 6 16.6
subroutine 16 16 100.0
pod 0 2 0.0
total 93 104 89.4


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 so C<@INC> is searched accordingly and C<%INC> is
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