[patch@29297] perl5db.pl detecting forked debugger on VMS.

[p5sagit/p5-mst-13.2.git] / lib / Log / Message / Config.pm

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