home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Log / Message / Config.pm next >
Encoding:
Perl POD Document  |  2009-06-26  |  4.9 KB  |  198 lines

  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:
  198.