blob: 3c0a5d2864e10d5ea04d9d3ec2b58282f1377e94 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
#!/usr/bin/perl
###########################################
# yamlparser
# Mike Schilli, 2004 (m@perlmeister.com)
###########################################
use warnings;
use strict;
package MyYAMLParser;
use base qw(Log::Log4perl::Config::BaseConfigurator);
use YAML qw(LoadFile Load);
use Data::Dumper;
###########################################
sub new {
###########################################
my($class, %options) = @_;
my $self = {};
bless $self, $class;
$self->{text} = $options{text} if exists $options{text};
$self->{file} = $options{file} if exists $options{file};
if(! exists $self->{text} and
! exists $self->{file}) {
die "usage: ", __PACKAGE__, "->new(file => \$filename) or ",
__PACKAGE__, "->new(text => \$text)";
}
return $self;
}
###########################################
sub parse {
###########################################
my($self) = @_;
my $data = {};
if(exists $self->{text}) {
$self->{data} = Load($self->{text});
}
# Move all non-hash values under {...}->{value}
my @todo = ($self->{data});
while (@todo) {
my $ref = shift @todo;
for (keys %$ref) {
if(ref($ref->{$_}) eq "HASH") {
push @todo, $ref->{$_};
} elsif($_ eq "name") {
# Appender 'name' entries are
# converted to ->{value} entries
$ref->{value} = $ref->{$_};
delete $ref->{$_};
} else {
my $tmp = $ref->{$_};
$ref->{$_} = {};
$ref->{$_}->{value} = $tmp;
}
}
}
return $self->{data};
}
package main;
use Log::Log4perl;
my $p = MyYAMLParser->new(text => <<EOT);
category:
Bar:
Twix: WARN, Screen, Screen2
appender:
Screen:
name: Log::Log4perl::Appender::Screen
layout: Log::Log4perl::Layout::SimpleLayout
Screen2:
name: Log::Log4perl::Appender::Screen
layout: Log::Log4perl::Layout::SimpleLayout
EOT
# use Data::Dump qw(dump);
# print dump($p->parse());
Log::Log4perl->init($p);
my $log = Log::Log4perl->get_logger("Bar::Twix");
$log->warn('foo');
|
