1package Log::Log4perl::Config::BaseConfigurator;
2
3use warnings;
4use strict;
5use constant _INTERNAL_DEBUG => 0;
6
7*eval_if_perl      = \&Log::Log4perl::Config::eval_if_perl;
8*compile_if_perl   = \&Log::Log4perl::Config::compile_if_perl;
9*leaf_path_to_hash = \&Log::Log4perl::Config::leaf_path_to_hash;
10
11################################################
12sub new {
13################################################
14    my($class, %options) = @_;
15
16    my $self = {
17        utf8 => 0,
18        %options,
19    };
20
21    bless $self, $class;
22
23    $self->file($self->{file}) if exists $self->{file};
24    $self->text($self->{text}) if exists $self->{text};
25
26    return $self;
27}
28
29################################################
30sub text {
31################################################
32    my($self, $text) = @_;
33
34        # $text is an array of scalars (lines)
35    if(defined $text) {
36        if(ref $text eq "ARRAY") {
37            $self->{text} = $text;
38        } else {
39            $self->{text} = [split "\n", $text];
40        }
41    }
42
43    return $self->{text};
44}
45
46################################################
47sub file {
48################################################
49    my($self, $filename) = @_;
50
51    open my $fh, "$filename" or die "Cannot open $filename ($!)";
52
53    if( $self->{ utf8 } ) {
54        binmode $fh, ":utf8";
55    }
56
57    $self->file_h_read( $fh );
58    close $fh;
59}
60
61################################################
62sub file_h_read {
63################################################
64    my($self, $fh) = @_;
65
66        # Dennis Gregorovic <dgregor@redhat.com> added this
67        # to protect apps which are tinkering with $/ globally.
68    local $/ = "\n";
69
70    $self->{text} = [<$fh>];
71}
72
73################################################
74sub parse {
75################################################
76    die __PACKAGE__ . "::parse() is a virtual method. " .
77        "It must be implemented " .
78        "in a derived class (currently: ", ref(shift), ")";
79}
80
81################################################
82sub parse_post_process {
83################################################
84    my($self, $data, $leaf_paths) = @_;
85
86    #   [
87    #     'category',
88    #     'value',
89    #     'WARN, Logfile'
90    #   ],
91    #   [
92    #     'appender',
93    #     'Logfile',
94    #     'value',
95    #     'Log::Log4perl::Appender::File'
96    #   ],
97    #   [
98    #     'appender',
99    #     'Logfile',
100    #     'filename',
101    #     'value',
102    #     'test.log'
103    #   ],
104    #   [
105    #     'appender',
106    #     'Logfile',
107    #     'layout',
108    #     'value',
109    #     'Log::Log4perl::Layout::PatternLayout'
110    #   ],
111    #   [
112    #     'appender',
113    #     'Logfile',
114    #     'layout',
115    #     'ConversionPattern',
116    #     'value',
117    #     '%d %F{1} %L> %m %n'
118    #   ]
119
120    for my $path ( @{ Log::Log4perl::Config::leaf_paths( $data )} ) {
121
122        print "path=@$path\n" if _INTERNAL_DEBUG;
123
124        if(0) {
125        } elsif(
126            $path->[0] eq "appender" and
127            $path->[2] eq "trigger"
128          ) {
129            my $ref = leaf_path_to_hash( $path, $data );
130            my $code = compile_if_perl( $$ref );
131
132            if(_INTERNAL_DEBUG) {
133                if($code) {
134                    print "Code compiled: $$ref\n";
135                } else {
136                    print "Not compiled: $$ref\n";
137                }
138            }
139
140            $$ref = $code if defined $code;
141        } elsif (
142            $path->[0] eq "filter"
143          ) {
144            # do nothing
145        } elsif (
146            $path->[0] eq "appender" and
147            $path->[2] eq "warp_message"
148          ) {
149            # do nothing
150        } elsif (
151            $path->[0] eq "appender" and
152            $path->[3] eq "cspec" or
153            $path->[1] eq "cspec"
154          ) {
155              # could be either
156              #    appender appndr layout cspec
157              # or
158              #    PatternLayout cspec U value ...
159              #
160            # do nothing
161        } else {
162            my $ref = leaf_path_to_hash( $path, $data );
163
164            if(_INTERNAL_DEBUG) {
165                print "Calling eval_if_perl on $$ref\n";
166            }
167
168            $$ref = eval_if_perl( $$ref );
169        }
170    }
171
172    return $data;
173}
174
1751;
176
177__END__
178
179=head1 NAME
180
181Log::Log4perl::Config::BaseConfigurator - Configurator Base Class
182
183=head1 SYNOPSIS
184
185This is a virtual base class, all configurators should be derived from it.
186
187=head1 DESCRIPTION
188
189=head2 METHODS
190
191=over 4
192
193=item C<< new >>
194
195Constructor, typically called like
196
197    my $config_parser = SomeConfigParser->new(
198        file => $file,
199    );
200
201    my $data = $config_parser->parse();
202
203Instead of C<file>, the derived class C<SomeConfigParser> may define any
204type of configuration input medium (e.g. C<url =E<gt> 'http://foobar'>).
205It just has to make sure its C<parse()> method will later pull the input
206data from the medium specified.
207
208The base class accepts a filename or a reference to an array
209of text lines:
210
211=over 4
212
213=item C<< file >>
214
215Specifies a file which the C<parse()> method later parses.
216
217=item C<< text >>
218
219Specifies a reference to an array of scalars, representing configuration
220records (typically lines of a file). Also accepts a simple scalar, which it
221splits at its newlines and transforms it into an array:
222
223    my $config_parser = MyYAMLParser->new(
224        text => ['foo: bar',
225                 'baz: bam',
226                ],
227    );
228
229    my $data = $config_parser->parse();
230
231=back
232
233If either C<file> or C<text> parameters have been specified in the
234constructor call, a later call to the configurator's C<text()> method
235will return a reference to an array of configuration text lines.
236This will typically be used by the C<parse()> method to process the
237input.
238
239=item C<< parse >>
240
241Virtual method, needs to be defined by the derived class.
242
243=back
244
245=head2 Parser requirements
246
247=over 4
248
249=item *
250
251If the parser provides variable substitution functionality, it has
252to implement it.
253
254=item *
255
256The parser's C<parse()> method returns a reference to a hash of hashes (HoH).
257The top-most hash contains the
258top-level keywords (C<category>, C<appender>) as keys, associated
259with values which are references to more deeply nested hashes.
260
261=item *
262
263The C<log4perl.> prefix (e.g. as used in the PropertyConfigurator class)
264is stripped, it's not part in the HoH structure.
265
266=item *
267
268Each Log4perl config value is indicated by the C<value> key, as in
269
270    $data->{category}->{Bar}->{Twix}->{value} = "WARN, Logfile"
271
272=back
273
274=head2 EXAMPLES
275
276The following Log::Log4perl configuration:
277
278    log4perl.category.Bar.Twix        = WARN, Screen
279    log4perl.appender.Screen          = Log::Log4perl::Appender::File
280    log4perl.appender.Screen.filename = test.log
281    log4perl.appender.Screen.layout   = Log::Log4perl::Layout::SimpleLayout
282
283needs to be transformed by the parser's C<parse()> method
284into this data structure:
285
286    { appender => {
287        Screen  => {
288          layout => {
289            value  => "Log::Log4perl::Layout::SimpleLayout" },
290            value  => "Log::Log4perl::Appender::Screen",
291        },
292      },
293      category => {
294        Bar => {
295          Twix => {
296            value => "WARN, Screen" }
297        } }
298    }
299
300For a full-fledged example, check out the sample YAML parser implementation
301in C<eg/yamlparser>. It uses a simple YAML syntax to specify the Log4perl
302configuration to illustrate the concept.
303
304=head1 SEE ALSO
305
306Log::Log4perl::Config::PropertyConfigurator
307
308Log::Log4perl::Config::DOMConfigurator
309
310Log::Log4perl::Config::LDAPConfigurator (tbd!)
311
312=head1 LICENSE
313
314Copyright 2002-2012 by Mike Schilli E<lt>m@perlmeister.comE<gt>
315and Kevin Goess E<lt>cpan@goess.orgE<gt>.
316
317This library is free software; you can redistribute it and/or modify
318it under the same terms as Perl itself.
319
320=head1 AUTHOR
321
322Please contribute patches to the project on Github:
323
324    http://github.com/mschilli/log4perl
325
326Send bug reports or requests for enhancements to the authors via our
327
328MAILING LIST (questions, bug reports, suggestions/patches):
329log4perl-devel@lists.sourceforge.net
330
331Authors (please contact them via the list above, not directly):
332Mike Schilli <m@perlmeister.com>,
333Kevin Goess <cpan@goess.org>
334
335Contributors (in alphabetical order):
336Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
337Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
338Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
339Grundman, Paul Harrington, David Hull, Robert Jacobson, Jason Kohles,
340Jeff Macdonald, Markus Peter, Brett Rann, Peter Rabbitson, Erik
341Selberg, Aaron Straup Cope, Lars Thegler, David Viner, Mac Yang.
342
343