lib/MHArc/Config.pm

   1 ##---------------------------------------------------------------------------##
   2 ##  File:
   3 ##      $Id: Config.pm,v 1.8 2002/09/20 02:58:38 ehood Exp $
   4 ##  Description:
   5 ##      POD at end of file.
   6 ##---------------------------------------------------------------------------##
   7 ##  Copyright (C) 2002  Earl Hood <earl@earlhood.com>
   8 ##
   9 ##  This program is free software; you can redistribute it and/or modify
  10 ##  it under the terms of the GNU General Public License as published by
  11 ##  the Free Software Foundation; either version 2 of the License, or
  12 ##  (at your option) any later version.
  13 ##
  14 ##  This program is distributed in the hope that it will be useful,
  15 ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ##  GNU General Public License for more details.
  18 ##
  19 ##  You should have received a copy of the GNU General Public License
  20 ##  along with this program; if not, write to the Free Software
  21 ##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  22 ##  02111-1307, USA
  23 ##---------------------------------------------------------------------------##
  24
  25 package MHArc::Config;
  26
  27 BEGIN {
  28   $Debug   = 0;
  29   $Cache   = 1;
  30 }
  31
  32 sub load {
  33     my $self    = { };
  34     my $mod     = shift;        # Name of module
  35     my $fname   = shift;        # Filename to read configuration from
  36     my $class   = ref($mod) || $mod;
  37
  38     bless $self, $class;
  39     $self->read_filename($fname);
  40 }
  41
  42 sub read_filename {
  43   my $self      = shift;
  44   my $in_file   = shift;
  45
  46   READ_FILE: {
  47     if ($in_file eq '-') {
  48       $fh = \*STDIN;
  49       $self->parse_config_sh($fh);
  50       last READ_FILE;
  51     }
  52
  53     my $filename = $in_file;
  54     my $cache_file = $in_file . '.cache.pl';
  55
  56     if ($Cache) {
  57       my $cache_mtime;
  58       if (-e $cache_file) {
  59         $cache_mtime = (stat(_))[9];
  60         print 'Cache mtime: ', $cache_mtime, "\n"  if $Debug;
  61       }
  62       if (!(-e $filename)) {
  63         $filename .= '.dist';
  64         if (-e $filename) {
  65           warn qq/Warning: Using "$filename"\n/;
  66         } else {
  67           die qq/ERROR: "$in_file" does not exist\n/;
  68         }
  69       }
  70       my $file_mtime = (stat(_))[9];
  71       print 'Config mtime: ', $file_mtime, "\n"  if $Debug;
  72       if (defined($cache_mtime) && ($cache_mtime >= $file_mtime)) {
  73         print "Using cache\n"  if $Debug;
  74         delete $INC{$cache_file};
  75         my $vars;
  76         eval {
  77           $vars = require $cache_file;
  78         };
  79         if ($@) {
  80           warn qq/Warning: Problem requiring "$cache_file": $@\n/;
  81         } else {
  82           $self = $vars;
  83           last READ_FILE;
  84         }
  85       }
  86     }
  87
  88     local(*FILE);
  89     open(FILE, $filename) ||
  90         die qq/ERROR: Unable to open "$filename": $!\n/;
  91     print "Using $filename\n"  if $Debug;
  92     $self->parse_config_sh(\*FILE);
  93     close(FILE);
  94
  95     if ($Cache) {
  96       eval {
  97         require Data::Dumper;
  98         local $Data::Dumper::Terse = 1;
  99         local $Data::Dumper::Indent = 0;
 100         print 'Create cache ', $cache_file, "\n"  if $Debug;
 101         open(FILE, '>'.$cache_file) ||
 102             die qq/Unable to create "$cache_file": $!\n/;
 103         print FILE '# DO NOT EDIT THIS FILE!', "\n",
 104                    Data::Dumper::Dumper($self), ';';
 105         close(FILE);
 106       };
 107       if ($@) {
 108         warn qq/Warning: Problem writing "$cache_file": $@\n/;
 109         unlink($cache_file);
 110       };
 111     }
 112   }
 113
 114   # Check for MHONARC_LIB, and if defined, add to perl's @INC
 115   if ($self->{'MHONARC_LIB'}) {
 116     print 'Adding ', $self->{'MHONARC_LIB'}, "to \@INC\n"  if $Debug;
 117     unshift(@INC, $self->{'MHONARC_LIB'});
 118   }
 119   $self;
 120 }
 121
 122 sub parse_config_sh {
 123   my $self  = shift;
 124   my $fh    = shift;
 125
 126   my($line, $key, $value);
 127   while (defined($line = <$fh>)) {
 128     next unless $line =~ /\S/;
 129     next if     $line =~ /^\s*#/;
 130     chomp $line;
 131     ($key, $value) = split(/=/, $line, 2);
 132
 133     if ($value =~ s/^'//) {
 134       $value =~ s/'$//;
 135     } else {
 136       $value =~ s/^"//; $value =~ s/"$//;
 137       $value = _expand_vars($self, $value);
 138     }
 139     $self->{$key} = $value;
 140   }
 141 }
 142
 143 sub dump_config {
 144   my $self = shift;
 145   my $fh   = shift;
 146
 147   foreach my $key (sort keys %$self) {
 148     print $fh $key, '=', $self->{$key}, "\n";
 149   }
 150 }
 151
 152 sub _expand_vars {
 153   my $map     = shift;
 154   my $str     = shift;
 155
 156   $str =~ s/(^|[^\$])\$(\{[^}]+\}|[\w]+)/$1 . _var_lookup($map, $2);/ge;
 157   $str;
 158 }
 159
 160 sub _var_lookup {
 161   my $map     = shift;
 162   my $key     = shift;
 163   $key =~ s/[{}]//g;
 164   defined($map->{$key}) ? $map->{$key} :
 165       defined($ENV{$key}) ? $ENV{$key} : "";
 166 }
 167
 168 #my $config = MHArc::Config->load('-');
 169 #foreach (sort keys %$config) {
 170 #  print "$_=", $config->{$_}, "\n";
 171 #}
 172
 173 #==========================================================================
 174 1;
 175 __END__
 176
 177 =head1 NAME
 178
 179 MHArc::Config - Load mail archive configuration file
 180
 181 =head1 SYNOPSIS
 182
 183   $conf = MHArc::Config->load($filename);
 184   print $conf->{'HTML_DIR'};
 185
 186 =head1 DESCRIPTION
 187
 188 This module will load in the archive configuration file.  The
 189 archive configuration file defines variables in Bourne shell syntax format.
 190
 191 B<NOTE:> Only a subset of the Bourne shell syntax is supported, so do
 192 not get fancy with the file.
 193
 194 The C<load> static method will create a new configuration instance
 195 that is a bless hash reference.  The variables defined in the file
 196 will be the hash keys.
 197
 198 B<NOTE:> If the filename specified does not exist, then the C<load()>
 199 method will check for the filename with a C<.dist> extension.  It
 200 is recommended to not rely on the C<.dist> version since it will
 201 get overwritten on software updates.
 202
 203 =head1 CACHING
 204
 205 This module will create a cached version of the file loaded to
 206 make subsequent loadings quicker.  The cached file will be called
 207 C<E<lt>filenameE<gt>.cache.pl> and will contain the configuration
 208 data in a Perl format.
 209
 210 When loading the configuration of a file, the timestamps of the
 211 cache file and the regular file are compared.  If the cache is newer,
 212 it is used.  Else, the regular file will be loaded and a new cache
 213 file created.
 214
 215 =head1 VARIABLES
 216
 217 =over
 218
 219 =item C<$MHArc::Config::Cache>
 220
 221 If set to C<0>, no cache processing will be done.  Configuration will
 222 be loaded directly from specified file.
 223
 224 =item C<$MHArc::Config::Debug>
 225
 226 If set to C<1>, diagnostic information will be printed.  This variable
 227 should only be used for debugging and not in production.
 228
 229 =back
 230
 231 =head1 VERSION
 232
 233 C<$Id: Config.pm,v 1.8 2002/09/20 02:58:38 ehood Exp $>
 234
 235 =head1 AUTHOR
 236
 237 Earl Hood, earl@earlhood.com
 238
 239 This module is part of the mharc archiving system and comes with
 240 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
 241 the GNU General Public License, which may be found in the MHArc
 242 distribution.
 243
 244 =cut
 245