File Coverage

blib/lib/Log/Log4perl/Resurrector.pm
Criterion Covered Total %
statement 56 61 91.8
branch 10 14 71.4
condition n/a
subroutine 11 11 100.0
pod 0 4 0.0
total 77 90 85.5


line stmt bran cond sub pod time code
1             use warnings;
2 1     1   575 use strict;
  1         2  
  1         35  
3 1     1   5  
  1         2  
  1         30  
4             # [rt.cpan.org #84818]
5             use if $^O eq "MSWin32", "Win32";
6 1     1   828  
  1         14  
  1         6  
7             use File::Temp qw(tempfile);
8 1     1   831 use File::Spec;
  1         22094  
  1         78  
9 1     1   9  
  1         2  
  1         23  
10             use constant INTERNAL_DEBUG => 0;
11 1     1   5  
  1         2  
  1         624  
12             our $resurrecting = '';
13              
14             ###########################################
15             ###########################################
16             resurrector_init();
17             }
18 1     1   12  
19             ##################################################
20             ##################################################
21             my($file) = @_;
22              
23             local($/) = undef;
24 6     6 0 13 open FILE, "<$file" or die "Cannot open $file";
25             my $text = <FILE>;
26 6         29 close FILE;
27 6 50       208  
28 6         988 print "Read ", length($text), " bytes from $file\n" if INTERNAL_DEBUG;
29 6         96  
30             my($tmp_fh, $tmpfile) = tempfile( UNLINK => 1 );
31 6         12 print "Opened tmpfile $tmpfile\n" if INTERNAL_DEBUG;
32              
33 6         29 $text =~ s/^\s*###l4p//mg;
34 6         2740  
35             print "Text=[$text]\n" if INTERNAL_DEBUG;
36 6         86  
37             print $tmp_fh $text;
38 6         10 seek $tmp_fh, 0, 0;
39              
40 6         282 return $tmp_fh;
41 6         207 }
42              
43 6         44 ###########################################
44             ###########################################
45             my ($code, $module) = @_;
46              
47             print "resurrector_loader called with $module\n" if INTERNAL_DEBUG;
48              
49 7     7 0 117930 # Avoid recursion
50             if($resurrecting eq $module) {
51 7         14 print "ignoring $module (recursion)\n" if INTERNAL_DEBUG;
52             return undef;
53             }
54 7 50       23
55 0         0 local $resurrecting = $module;
56 0         0
57            
58             # Skip Log4perl appenders
59 7         12 if($module =~ m#^Log/Log4perl/Appender#) {
60             print "Ignoring $module (Log4perl-internal)\n" if INTERNAL_DEBUG;
61             return undef;
62             }
63 7 100       25  
64 1         2 my $path = $module;
65 1         997  
66             # Skip unknown files
67             if(!-f $module) {
68 6         11 # We might have a 'use lib' statement that modified the
69             # INC path, search again.
70             $path = pm_search($module);
71 6 50       195 if(! defined $path) {
72             print "File $module not found\n" if INTERNAL_DEBUG;
73             return undef;
74 6         23 }
75 6 50       27 print "File $module found in $path\n" if INTERNAL_DEBUG;
76 0         0 }
77 0         0  
78             print "Resurrecting module $path\n" if INTERNAL_DEBUG;
79 6         11  
80             my $fh = resurrector_fh($path);
81              
82 6         9 my $abs_path = File::Spec->rel2abs( $path );
83             print "Setting %INC entry of $module to $abs_path\n" if INTERNAL_DEBUG;
84 6         15 $INC{$module} = $abs_path;
85              
86 6         126 return $fh;
87 6         13 }
88 6         16  
89             ###########################################
90 6         2652 ###########################################
91             my($pmfile) = @_;
92              
93             for(@INC) {
94             # Skip subrefs
95             next if ref($_);
96 6     6 0 16 my $path = File::Spec->catfile($_, $pmfile);
97             return $path if -f $path;
98 6         18 }
99              
100 55 100       128 return undef;
101 49         398 }
102 49 100       725  
103             ###########################################
104             ###########################################
105 0         0 unshift @INC, \&resurrector_loader;
106             }
107              
108             1;
109              
110              
111 1     1 0 25 =encoding utf8
112              
113             =head1 NAME
114              
115             Log::Log4perl::Resurrector - Dark Magic to resurrect hidden L4p statements
116              
117             =head1 DESCRIPTION
118              
119             Loading C<use Log::Log4perl::Resurrector> causes subsequently loaded
120             modules to have their hidden
121              
122             ###l4p use Log::Log4perl qw(:easy);
123              
124             ###l4p DEBUG(...)
125             ###l4p INFO(...)
126             ...
127              
128             statements uncommented and therefore 'resurrected', i.e. activated.
129              
130             This allows for a module C<Foobar.pm> to be written with Log4perl
131             statements commented out and running at full speed in normal mode.
132             When loaded via
133              
134             use Foobar;
135              
136             all hidden Log4perl statements will be ignored.
137              
138             However, if a script loads the module C<Foobar> I<after> loading
139             C<Log::Log4perl::Resurrector>, as in
140              
141             use Log::Log4perl::Resurrector;
142             use Foobar;
143              
144             then C<Log::Log4perl::Resurrector> will have put a source filter in place
145             that will extract all hidden Log4perl statements in C<Foobar> before
146             C<Foobar> actually gets loaded.
147              
148             Therefore, C<Foobar> will then behave as if the
149              
150             ###l4p use Log::Log4perl qw(:easy);
151              
152             ###l4p DEBUG(...)
153             ###l4p INFO(...)
154             ...
155              
156             statements were actually written like
157              
158             use Log::Log4perl qw(:easy);
159              
160             DEBUG(...)
161             INFO(...)
162             ...
163              
164             and the module C<Foobar> will indeed be Log4perl-enabled. Whether any
165             activated Log4perl statement will actually trigger log
166             messages, is up to the Log4perl configuration, of course.
167              
168             There's a startup cost to using C<Log::Log4perl::Resurrector> (all
169             subsequently loaded modules are examined) but once the compilation
170             phase has finished, the perl program will run at full speed.
171              
172             Some of the techniques used in this module have been stolen from the
173             C<Acme::Incorporated> CPAN module, written by I<chromatic>. Long
174             live CPAN!
175            
176             =head1 LICENSE
177              
178             Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt>
179             and Kevin Goess E<lt>cpan@goess.orgE<gt>.
180              
181             This library is free software; you can redistribute it and/or modify
182             it under the same terms as Perl itself.
183              
184             =head1 AUTHOR
185              
186             Please contribute patches to the project on Github:
187              
188             http://github.com/mschilli/log4perl
189              
190             Send bug reports or requests for enhancements to the authors via our
191              
192             MAILING LIST (questions, bug reports, suggestions/patches):
193             log4perl-devel@lists.sourceforge.net
194              
195             Authors (please contact them via the list above, not directly):
196             Mike Schilli <m@perlmeister.com>,
197             Kevin Goess <cpan@goess.org>
198              
199             Contributors (in alphabetical order):
200             Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
201             Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
202             Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
203             Grundman, Paul Harrington, Alexander Hartmaier David Hull,
204             Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter,
205             Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope,
206             Lars Thegler, David Viner, Mac Yang.
207