summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Log/Message/Config.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Log/Message/Config.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Log/Message/Config.pm197
1 files changed, 197 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Log/Message/Config.pm b/Master/tlpkg/tlperl/lib/Log/Message/Config.pm
new file mode 100755
index 00000000000..9769119ed32
--- /dev/null
+++ b/Master/tlpkg/tlperl/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: