diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Log/Message/Config.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Log/Message/Config.pm | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Log/Message/Config.pm b/Master/tlpkg/tlperl0/lib/Log/Message/Config.pm new file mode 100755 index 00000000000..9769119ed32 --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/Log/Message/Config.pm @@ -0,0 +1,197 @@ +package Log::Message::Config; +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.01; +} + +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") 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: |