Commit | Line | Data |
---|---|---|
e3f7a951 RGS |
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: |