lib/Log/Message/Config.pm

   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: