From 94566f012421026c8311552f99175a5989eba063 Mon Sep 17 00:00:00 2001 From: Lorry Tar Creator Date: Sat, 1 Nov 2014 01:47:12 +0000 Subject: Log-Log4perl-1.46 --- lib/Log/Log4perl/Resurrector.pm | 214 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 214 insertions(+) create mode 100644 lib/Log/Log4perl/Resurrector.pm (limited to 'lib/Log/Log4perl/Resurrector.pm') diff --git a/lib/Log/Log4perl/Resurrector.pm b/lib/Log/Log4perl/Resurrector.pm new file mode 100644 index 0000000..0eee01a --- /dev/null +++ b/lib/Log/Log4perl/Resurrector.pm @@ -0,0 +1,214 @@ +package Log::Log4perl::Resurrector; +use warnings; +use strict; + +# [rt.cpan.org #84818] +use if $^O eq "MSWin32", "Win32"; + +use File::Temp qw(tempfile); +use File::Spec; + +use constant INTERNAL_DEBUG => 0; + +our $resurrecting = ''; + +########################################### +sub import { +########################################### + resurrector_init(); +} + +################################################## +sub resurrector_fh { +################################################## + my($file) = @_; + + local($/) = undef; + open FILE, "<$file" or die "Cannot open $file"; + my $text = ; + close FILE; + + print "Read ", length($text), " bytes from $file\n" if INTERNAL_DEBUG; + + my($tmp_fh, $tmpfile) = tempfile( UNLINK => 1 ); + print "Opened tmpfile $tmpfile\n" if INTERNAL_DEBUG; + + $text =~ s/^\s*###l4p//mg; + + print "Text=[$text]\n" if INTERNAL_DEBUG; + + print $tmp_fh $text; + seek $tmp_fh, 0, 0; + + return $tmp_fh; +} + +########################################### +sub resurrector_loader { +########################################### + my ($code, $module) = @_; + + print "resurrector_loader called with $module\n" if INTERNAL_DEBUG; + + # Avoid recursion + if($resurrecting eq $module) { + print "ignoring $module (recursion)\n" if INTERNAL_DEBUG; + return undef; + } + + local $resurrecting = $module; + + + # Skip Log4perl appenders + if($module =~ m#^Log/Log4perl/Appender#) { + print "Ignoring $module (Log4perl-internal)\n" if INTERNAL_DEBUG; + return undef; + } + + my $path = $module; + + # Skip unknown files + if(!-f $module) { + # We might have a 'use lib' statement that modified the + # INC path, search again. + $path = pm_search($module); + if(! defined $path) { + print "File $module not found\n" if INTERNAL_DEBUG; + return undef; + } + print "File $module found in $path\n" if INTERNAL_DEBUG; + } + + print "Resurrecting module $path\n" if INTERNAL_DEBUG; + + my $fh = resurrector_fh($path); + + my $abs_path = File::Spec->rel2abs( $path ); + print "Setting %INC entry of $module to $abs_path\n" if INTERNAL_DEBUG; + $INC{$module} = $abs_path; + + return $fh; +} + +########################################### +sub pm_search { +########################################### + my($pmfile) = @_; + + for(@INC) { + # Skip subrefs + next if ref($_); + my $path = File::Spec->catfile($_, $pmfile); + return $path if -f $path; + } + + return undef; +} + +########################################### +sub resurrector_init { +########################################### + unshift @INC, \&resurrector_loader; +} + +1; + +__END__ + +=encoding utf8 + +=head1 NAME + +Log::Log4perl::Resurrector - Dark Magic to resurrect hidden L4p statements + +=head1 DESCRIPTION + +Loading C causes subsequently loaded +modules to have their hidden + + ###l4p use Log::Log4perl qw(:easy); + + ###l4p DEBUG(...) + ###l4p INFO(...) + ... + +statements uncommented and therefore 'resurrected', i.e. activated. + +This allows for a module C to be written with Log4perl +statements commented out and running at full speed in normal mode. +When loaded via + + use Foobar; + +all hidden Log4perl statements will be ignored. + +However, if a script loads the module C I loading +C, as in + + use Log::Log4perl::Resurrector; + use Foobar; + +then C will have put a source filter in place +that will extract all hidden Log4perl statements in C before +C actually gets loaded. + +Therefore, C will then behave as if the + + ###l4p use Log::Log4perl qw(:easy); + + ###l4p DEBUG(...) + ###l4p INFO(...) + ... + +statements were actually written like + + use Log::Log4perl qw(:easy); + + DEBUG(...) + INFO(...) + ... + +and the module C will indeed be Log4perl-enabled. Whether any +activated Log4perl statement will actually trigger log +messages, is up to the Log4perl configuration, of course. + +There's a startup cost to using C (all +subsequently loaded modules are examined) but once the compilation +phase has finished, the perl program will run at full speed. + +Some of the techniques used in this module have been stolen from the +C CPAN module, written by I. Long +live CPAN! + +=head1 LICENSE + +Copyright 2002-2013 by Mike Schilli Em@perlmeister.comE +and Kevin Goess Ecpan@goess.orgE. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 AUTHOR + +Please contribute patches to the project on Github: + + http://github.com/mschilli/log4perl + +Send bug reports or requests for enhancements to the authors via our + +MAILING LIST (questions, bug reports, suggestions/patches): +log4perl-devel@lists.sourceforge.net + +Authors (please contact them via the list above, not directly): +Mike Schilli , +Kevin Goess + +Contributors (in alphabetical order): +Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton +Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony +Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy +Grundman, Paul Harrington, Alexander Hartmaier David Hull, +Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, +Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, +Lars Thegler, David Viner, Mac Yang. + -- cgit v1.2.1