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