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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
package Log::Dispatch::Configurator::AppConfig;
use strict;
use vars qw($VERSION);
$VERSION = '1.00';
use Log::Dispatch::Configurator;
use base qw(Log::Dispatch::Configurator);
use AppConfig;
sub new {
my($class, $file, $section) = @_;
my $self = bless { section => ($section ? "${section}_" : '') }, $class;
if(ref $file && $file->isa('AppConfig')){
$self->{config} = $file;
}else{
$self->{file} = $file;
}
$self->parse_file;
return $self;
}
sub parse_file {
my $self = shift;
my $section = $self->{section};
my $config;
if($self->{config}){
$config = $self->{config};
}
else{
$config = AppConfig->new({
CREATE => 1,
GLOBAL => {
ARGCOUNT => AppConfig::ARGCOUNT_ONE(),
},
});
$config->file($self->{file});
}
$config->define("${section}dispatchers" => { DEFAULT => '' }) unless $config->varlist("^${section}dispatchers\$");
$config->define("${section}format" => { DEFAULT => undef }) unless $config->varlist("^${section}format\$");
$self->{_config} = $config;
}
sub reload {
my $self = shift;
$self->parse_file;
}
sub _config { $_[0]->{_config} }
sub get_attrs_global {
my $self = shift;
my $section = $self->{section};
return {
format => scalar $self->_config->get("${section}format"),
dispatchers => [ split /\s+/, $self->_config->get("${section}dispatchers") ],
};
}
sub get_attrs {
my($self, $name) = @_;
my $section = $self->{section};
my $regex = "^$section$name" . '[\._]';
my %var = $self->_config->varlist($regex);
my %param = map {
(my $key = $_) =~ s/$regex//;
$key => $var{$_};
} keys %var;
return \%param;
}
1;
__END__
=head1 NAME
Log::Dispatch::Configurator::AppConfig - Configurator implementation with AppConfig
=head1 SYNOPSIS
use Log::Dispatch::Config;
use Log::Dispatch::Configurator::AppConfig;
my $config = Log::Dispatch::Configurator::AppConfig->new('log.cfg');
Log::Dispatch::Config->configure($config);
# nearby piece of code
my $log = Log::Dispatch::Config->instance;
=head1 DESCRIPTION
Log::Dispatch::Configurator::AppConfig is an implementation of
Log::Dispatch::Configurator using AppConfig format. Here is a sample
of config file.
dispatchers = file screen
file.class = Log::Dispatch::File
file.min_level = debug
file.filename = /path/to/log
file.mode = append
file.format = [%d] [%p] %m at %F line %L%n
screen.class = Log::Dispatch::Screen
screen.min_level = info
screen.stderr = 1
screen.format = %m
You can use ini style grouping.
[file]
class = Log::Dispatch::File
min_level = debug
[screen]
class = Log::Dispatch::Screen
min_level = info
If you use _ (underscore) in dispatcher name, something very B<bad>
may happen. It is safe when you avoid doing so.
=head1 AUTHOR
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
L<Log::Dispatch::Config>, L<AppConfig>
=cut
|
