ok
Direktori : /usr/share/perl5/vendor_perl/Log/Message/ |
Current File : //usr/share/perl5/vendor_perl/Log/Message/Config.pm |
package Log::Message::Config; use if $] > 5.017, 'deprecate'; use strict; use Params::Check qw[check]; use Module::Load; use FileHandle; use Locale::Maketext::Simple Style => 'gettext'; BEGIN { use vars qw[$VERSION $AUTOLOAD]; $VERSION = '0.08'; } sub new { my $class = shift; my %hash = @_; ### find out if the user specified a config file to use ### and/or a default configuration object ### and remove them from the argument hash my %special = map { lc, delete $hash{$_} } grep /^config|default$/i, keys %hash; ### allow provided arguments to override the values from the config ### my $tmpl = { private => { default => undef, }, verbose => { default => 1 }, tag => { default => 'NONE', }, level => { default => 'log', }, remove => { default => 0 }, chrono => { default => 1 }, }; my %lc_hash = map { lc, $hash{$_} } keys %hash; my $file_conf; if( $special{config} ) { $file_conf = _read_config_file( $special{config} ) or ( warn( loc(q[Could not parse config file!]) ), return ); } my $def_conf = \%{ $special{default} || {} }; ### make sure to only include keys that are actually defined -- ### the checker will assign even 'undef' if you have provided that ### as a value ### priorities goes as follows: ### 1: arguments passed ### 2: any config file passed ### 3: any default config passed my %to_check = map { @$_ } grep { defined $_->[1] } map { [ $_ => defined $lc_hash{$_} ? $lc_hash{$_} : defined $file_conf->{$_} ? $file_conf->{$_} : defined $def_conf->{$_} ? $def_conf->{$_} : undef ] } keys %$tmpl; my $rv = check( $tmpl, \%to_check, 1 ) or ( warn( loc(q[Could not validate arguments!]) ), return ); return bless $rv, $class; } sub _read_config_file { my $file = shift or return; my $conf = {}; my $FH = new FileHandle; $FH->open("$file", 'r') or ( warn(loc(q[Could not open config file '%1': %2],$file,$!)), return {} ); while(<$FH>) { next if /\s*#/; next unless /\S/; chomp; s/^\s*//; s/\s*$//; my ($param,$val) = split /\s*=\s*/; if( (lc $param) eq 'include' ) { load $val; next; } ### add these to the config hash ### $conf->{ lc $param } = $val; } close $FH; return $conf; } sub AUTOLOAD { $AUTOLOAD =~ s/.+:://; my $self = shift; return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD }; die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self); } sub DESTROY { 1 } 1; __END__ =pod =head1 NAME Log::Message::Config - Configuration options for Log::Message =head1 SYNOPSIS # This module is implicitly used by Log::Message to create a config # which it uses to log messages. # For the options you can pass, see the C<Log::Message new()> method. # Below is a sample of a config file you could use # comments are denoted by a single '#' # use a shared stack, or have a private instance? # if none provided, set to '0', private = 1 # do not be verbose verbose = 0 # default tag to set on new items # if none provided, set to 'NONE' tag = SOME TAG # default level to handle items # if none provided, set to 'log' level = carp # extra files to include # if none provided, no files are auto included include = mylib.pl include = ../my/other/lib.pl # automatically delete items # when you retrieve them from the stack? # if none provided, set to '0' remove = 1 # retrieve errors in chronological order, or not? # if none provided, set to '1' chrono = 0 =head1 DESCRIPTION Log::Message::Config provides a standardized config object for Log::Message objects. It can either read options as perl arguments, or as a config file. See the Log::Message manpage for more information about what arguments are valid, and see the Synopsis for an example config file you can use =head1 SEE ALSO L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Handlers> =head1 AUTHOR This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 Acknowledgements Thanks to Ann Barcomb for her suggestions. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: