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