[Summary view] [Print] [Text view]

   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: