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