Commit | Line | Data |
e3f7a951 |
1 | package Log::Message::Config; |
2 | use strict; |
3 | |
4 | use Params::Check qw[check]; |
5 | use Module::Load; |
6 | use FileHandle; |
7 | use Locale::Maketext::Simple Style => 'gettext'; |
8 | |
9 | BEGIN { |
10 | use vars qw[$VERSION $AUTOLOAD]; |
11 | $VERSION = 0.01; |
12 | } |
13 | |
14 | sub new { |
15 | my $class = shift; |
16 | my %hash = @_; |
17 | |
18 | ### find out if the user specified a config file to use |
19 | ### and/or a default configuration object |
20 | ### and remove them from the argument hash |
21 | my %special = map { lc, delete $hash{$_} } |
22 | grep /^config|default$/i, keys %hash; |
23 | |
24 | ### allow provided arguments to override the values from the config ### |
25 | my $tmpl = { |
26 | private => { default => undef, }, |
27 | verbose => { default => 1 }, |
28 | tag => { default => 'NONE', }, |
29 | level => { default => 'log', }, |
30 | remove => { default => 0 }, |
31 | chrono => { default => 1 }, |
32 | }; |
33 | |
34 | my %lc_hash = map { lc, $hash{$_} } keys %hash; |
35 | |
36 | my $file_conf; |
37 | if( $special{config} ) { |
38 | $file_conf = _read_config_file( $special{config} ) |
39 | or ( warn( loc(q[Could not parse config file!]) ), return ); |
40 | } |
41 | |
42 | my $def_conf = \%{ $special{default} || {} }; |
43 | |
44 | ### make sure to only include keys that are actually defined -- |
45 | ### the checker will assign even 'undef' if you have provided that |
46 | ### as a value |
47 | ### priorities goes as follows: |
48 | ### 1: arguments passed |
49 | ### 2: any config file passed |
50 | ### 3: any default config passed |
51 | my %to_check = map { @$_ } |
52 | grep { defined $_->[1] } |
53 | map { [ $_ => |
54 | defined $lc_hash{$_} ? $lc_hash{$_} : |
55 | defined $file_conf->{$_} ? $file_conf->{$_} : |
56 | defined $def_conf->{$_} ? $def_conf->{$_} : |
57 | undef |
58 | ] |
59 | } keys %$tmpl; |
60 | |
61 | my $rv = check( $tmpl, \%to_check, 1 ) |
62 | or ( warn( loc(q[Could not validate arguments!]) ), return ); |
63 | |
64 | return bless $rv, $class; |
65 | } |
66 | |
67 | sub _read_config_file { |
68 | my $file = shift or return; |
69 | |
70 | my $conf = {}; |
71 | my $FH = new FileHandle; |
72 | $FH->open("$file") or ( |
73 | warn(loc(q[Could not open config file '%1': %2],$file,$!)), |
74 | return {} |
75 | ); |
76 | |
77 | while(<$FH>) { |
78 | next if /\s*#/; |
79 | next unless /\S/; |
80 | |
81 | chomp; s/^\s*//; s/\s*$//; |
82 | |
83 | my ($param,$val) = split /\s*=\s*/; |
84 | |
85 | if( (lc $param) eq 'include' ) { |
86 | load $val; |
87 | next; |
88 | } |
89 | |
90 | ### add these to the config hash ### |
91 | $conf->{ lc $param } = $val; |
92 | } |
93 | close $FH; |
94 | |
95 | return $conf; |
96 | } |
97 | |
98 | sub AUTOLOAD { |
99 | $AUTOLOAD =~ s/.+:://; |
100 | |
101 | my $self = shift; |
102 | |
103 | return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD }; |
104 | |
105 | die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self); |
106 | } |
107 | |
108 | sub DESTROY { 1 } |
109 | |
110 | 1; |
111 | |
112 | __END__ |
113 | |
114 | =pod |
115 | |
116 | =head1 NAME |
117 | |
118 | Log::Message::Config - Configuration options for Log::Message |
119 | |
120 | =head1 SYNOPSIS |
121 | |
122 | # This module is implicitly used by Log::Message to create a config |
123 | # which it uses to log messages. |
124 | # For the options you can pass, see the C<Log::Message new()> method. |
125 | |
126 | # Below is a sample of a config file you could use |
127 | |
128 | # comments are denoted by a single '#' |
129 | # use a shared stack, or have a private instance? |
130 | # if none provided, set to '0', |
131 | private = 1 |
132 | |
133 | # do not be verbose |
134 | verbose = 0 |
135 | |
136 | # default tag to set on new items |
137 | # if none provided, set to 'NONE' |
138 | tag = SOME TAG |
139 | |
140 | # default level to handle items |
141 | # if none provided, set to 'log' |
142 | level = carp |
143 | |
144 | # extra files to include |
145 | # if none provided, no files are auto included |
146 | include = mylib.pl |
147 | include = ../my/other/lib.pl |
148 | |
149 | # automatically delete items |
150 | # when you retrieve them from the stack? |
151 | # if none provided, set to '0' |
152 | remove = 1 |
153 | |
154 | # retrieve errors in chronological order, or not? |
155 | # if none provided, set to '1' |
156 | chrono = 0 |
157 | |
158 | =head1 DESCRIPTION |
159 | |
160 | Log::Message::Config provides a standardized config object for |
161 | Log::Message objects. |
162 | |
163 | It can either read options as perl arguments, or as a config file. |
164 | See the Log::Message manpage for more information about what arguments |
165 | are valid, and see the Synopsis for an example config file you can use |
166 | |
167 | =head1 SEE ALSO |
168 | |
169 | L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Handlers> |
170 | |
171 | =head1 AUTHOR |
172 | |
173 | This module by |
174 | Jos Boumans E<lt>kane@cpan.orgE<gt>. |
175 | |
176 | =head1 Acknowledgements |
177 | |
178 | Thanks to Ann Barcomb for her suggestions. |
179 | |
180 | =head1 COPYRIGHT |
181 | |
182 | This module is |
183 | copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>. |
184 | All rights reserved. |
185 | |
186 | This library is free software; |
187 | you may redistribute and/or modify it under the same |
188 | terms as Perl itself. |
189 | |
190 | =cut |
191 | |
192 | # Local variables: |
193 | # c-indentation-style: bsd |
194 | # c-basic-offset: 4 |
195 | # indent-tabs-mode: nil |
196 | # End: |
197 | # vim: expandtab shiftwidth=4: |