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