lib/Log/Message/Config.pm

   1 package Log::Message::Config;\r
   2 use strict;\r
   3 \r
   4 use Params::Check qw[check];\r
   5 use Module::Load;\r
   6 use FileHandle;\r
   7 use Locale::Maketext::Simple Style => 'gettext';\r
   8 \r
   9 BEGIN {\r
  10     use vars        qw[$VERSION $AUTOLOAD];\r
  11     $VERSION    =   0.01;\r
  12 }\r
  13 \r
  14 sub new {\r
  15     my $class = shift;\r
  16     my %hash  = @_;\r
  17 \r
  18     ### find out if the user specified a config file to use\r
  19     ### and/or a default configuration object\r
  20     ### and remove them from the argument hash\r
  21     my %special =   map { lc, delete $hash{$_} }\r
  22                     grep /^config|default$/i, keys %hash;\r
  23 \r
  24     ### allow provided arguments to override the values from the config ###\r
  25     my $tmpl = {\r
  26         private => { default => undef,  },\r
  27         verbose => { default => 1       },\r
  28         tag     => { default => 'NONE', },\r
  29         level   => { default => 'log',  },\r
  30         remove  => { default => 0       },\r
  31         chrono  => { default => 1       },\r
  32     };\r
  33 \r
  34     my %lc_hash = map { lc, $hash{$_} } keys %hash;\r
  35 \r
  36     my $file_conf;\r
  37     if( $special{config} ) {\r
  38         $file_conf = _read_config_file( $special{config} )\r
  39                         or ( warn( loc(q[Could not parse config file!]) ), return );\r
  40     }\r
  41 \r
  42     my $def_conf = \%{ $special{default} || {} };\r
  43 \r
  44     ### make sure to only include keys that are actually defined --\r
  45     ### the checker will assign even 'undef' if you have provided that\r
  46     ### as a value\r
  47     ### priorities goes as follows:\r
  48     ### 1: arguments passed\r
  49     ### 2: any config file passed\r
  50     ### 3: any default config passed\r
  51     my %to_check =  map     { @$_ }\r
  52                     grep    { defined $_->[1] }\r
  53                     map     {   [ $_ =>\r
  54                                     defined $lc_hash{$_}        ? $lc_hash{$_}      :\r
  55                                     defined $file_conf->{$_}    ? $file_conf->{$_}  :\r
  56                                     defined $def_conf->{$_}     ? $def_conf->{$_}   :\r
  57                                     undef\r
  58                                 ]\r
  59                             } keys %$tmpl;\r
  60 \r
  61     my $rv = check( $tmpl, \%to_check, 1 )\r
  62                 or ( warn( loc(q[Could not validate arguments!]) ), return );\r
  63 \r
  64     return bless $rv, $class;\r
  65 }\r
  66 \r
  67 sub _read_config_file {\r
  68     my $file = shift or return;\r
  69 \r
  70     my $conf = {};\r
  71     my $FH = new FileHandle;\r
  72     $FH->open("$file") or (\r
  73                         warn(loc(q[Could not open config file '%1': %2],$file,$!)),\r
  74                         return {}\r
  75                     );\r
  76 \r
  77     while(<$FH>) {\r
  78         next if     /\s*#/;\r
  79         next unless /\S/;\r
  80 \r
  81         chomp; s/^\s*//; s/\s*$//;\r
  82 \r
  83         my ($param,$val) = split /\s*=\s*/;\r
  84 \r
  85         if( (lc $param) eq 'include' ) {\r
  86             load $val;\r
  87             next;\r
  88         }\r
  89 \r
  90         ### add these to the config hash ###\r
  91         $conf->{ lc $param } = $val;\r
  92     }\r
  93     close $FH;\r
  94 \r
  95     return $conf;\r
  96 }\r
  97 \r
  98 sub AUTOLOAD {\r
  99     $AUTOLOAD =~ s/.+:://;\r
 100 \r
 101     my $self = shift;\r
 102 \r
 103     return $self->{ lc $AUTOLOAD } if exists $self->{ lc $AUTOLOAD };\r
 104 \r
 105     die loc(q[No such accessor '%1' for class '%2'], $AUTOLOAD, ref $self);\r
 106 }\r
 107 \r
 108 sub DESTROY { 1 }\r
 109 \r
 110 1;\r
 111 \r
 112 __END__\r
 113 \r
 114 =pod\r
 115 \r
 116 =head1 NAME\r
 117 \r
 118 Log::Message::Config - Configuration options for Log::Message\r
 119 \r
 120 =head1 SYNOPSIS\r
 121 \r
 122     # This module is implicitly used by Log::Message to create a config\r
 123     # which it uses to log messages.\r
 124     # For the options you can pass, see the C<Log::Message new()> method.\r
 125 \r
 126     # Below is a sample of a config file you could use\r
 127 \r
 128     # comments are denoted by a single '#'\r
 129     # use a shared stack, or have a private instance?\r
 130     # if none provided, set to '0',\r
 131     private = 1\r
 132 \r
 133     # do not be verbose\r
 134     verbose = 0\r
 135 \r
 136     # default tag to set on new items\r
 137     # if none provided, set to 'NONE'\r
 138     tag = SOME TAG\r
 139 \r
 140     # default level to handle items\r
 141     # if none provided, set to 'log'\r
 142     level = carp\r
 143 \r
 144     # extra files to include\r
 145     # if none provided, no files are auto included\r
 146     include = mylib.pl\r
 147     include = ../my/other/lib.pl\r
 148 \r
 149     # automatically delete items\r
 150     # when you retrieve them from the stack?\r
 151     # if none provided, set to '0'\r
 152     remove = 1\r
 153 \r
 154     # retrieve errors in chronological order, or not?\r
 155     # if none provided, set to '1'\r
 156     chrono = 0\r
 157 \r
 158 =head1 DESCRIPTION\r
 159 \r
 160 Log::Message::Config provides a standardized config object for\r
 161 Log::Message objects.\r
 162 \r
 163 It can either read options as perl arguments, or as a config file.\r
 164 See the Log::Message manpage for more information about what arguments\r
 165 are valid, and see the Synopsis for an example config file you can use\r
 166 \r
 167 =head1 SEE ALSO\r
 168 \r
 169 L<Log::Message>, L<Log::Message::Item>, L<Log::Message::Handlers>\r
 170 \r
 171 =head1 AUTHOR\r
 172 \r
 173 This module by\r
 174 Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
 175 \r
 176 =head1 Acknowledgements\r
 177 \r
 178 Thanks to Ann Barcomb for her suggestions.\r
 179 \r
 180 =head1 COPYRIGHT\r
 181 \r
 182 This module is\r
 183 copyright (c) 2002 Jos Boumans E<lt>kane@cpan.orgE<gt>.\r
 184 All rights reserved.\r
 185 \r
 186 This library is free software;\r
 187 you may redistribute and/or modify it under the same\r
 188 terms as Perl itself.\r
 189 \r
 190 =cut\r
 191 \r
 192 # Local variables:\r
 193 # c-indentation-style: bsd\r
 194 # c-basic-offset: 4\r
 195 # indent-tabs-mode: nil\r
 196 # End:\r
 197 # vim: expandtab shiftwidth=4:\r