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