CVS: mharc/lib/MHArc Config.pm,1.7,1.8

Update of /cvsroot/mhonarc/mharc/lib/MHArc
In directory subversions:/tmp/cvs-serv15382/lib/MHArc

Modified Files:
	Config.pm 
Log Message:
Added config caching to speed subsequent loads of config file.
Should help in procmail processing since extract-mesg-date is called
for each message delivered into the raw archives.


Index: Config.pm
===================================================================
RCS file: /cvsroot/mhonarc/mharc/lib/MHArc/Config.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
*** Config.pm	13 Sep 2002 07:24:18 -0000	1.7
--- Config.pm	20 Sep 2002 02:58:38 -0000	1.8
***************
*** 25,28 ****
--- 25,33 ----
  package MHArc::Config;
  
+ BEGIN {
+   $Debug   = 0;
+   $Cache   = 1;
+ }
+ 
  sub load {
      my $self	= { };
***************
*** 37,56 ****
  sub read_filename {
    my $self	= shift;
!   my $filename	= shift;
  
!   my $fh	= undef;
!   my $fh_close	= 0;
  
!   local(*FILE);
!   if ($filename eq '-') {
!     $fh = \*STDIN;
!   } else {
!     $filename .= '.dist'  unless (-e $filename);
      open(FILE, $filename) ||
  	die qq/ERROR: Unable to open "$filename": $!\n/;
!     $fh = \*FILE;
!     $fh_close = 1;
    }
  
    while (defined($line = <$fh>)) {
      next unless $line =~ /\S/;
--- 42,128 ----
  sub read_filename {
    my $self	= shift;
!   my $in_file	= shift;
! 
!   READ_FILE: {
!     if ($in_file eq '-') {
!       $fh = \*STDIN;
!       $self->parse_config_sh($fh);
!       last READ_FILE;
!     }
  
!     my $filename = $in_file;
!     my $cache_file = $in_file . '.cache.pl';
  
!     if ($Cache) {
!       my $cache_mtime;
!       if (-e $cache_file) {
! 	$cache_mtime = (stat(_))[9];
! 	print 'Cache mtime: ', $cache_mtime, "\n"  if $Debug;
!       }
!       if (!(-e $filename)) {
! 	$filename .= '.dist';
! 	if (-e $filename) {
! 	  warn qq/Warning: Using "$filename"\n/;
! 	} else {
! 	  die qq/ERROR: "$in_file" does not exist\n/;
! 	}
!       }
!       my $file_mtime = (stat(_))[9];
!       print 'Config mtime: ', $file_mtime, "\n"  if $Debug;
!       if (defined($cache_mtime) && ($cache_mtime >= $file_mtime)) {
! 	print "Using cache\n"  if $Debug;
! 	delete $INC{$cache_file};
! 	my $vars;
! 	eval {
! 	  $vars = require $cache_file;
! 	};
! 	if ($@) {
! 	  warn qq/Warning: Problem requiring "$cache_file": $(_at_)\n/;
! 	} else {
! 	  $self = $vars;
! 	  last READ_FILE;
! 	}
!       }
!     }
! 
!     local(*FILE);
      open(FILE, $filename) ||
  	die qq/ERROR: Unable to open "$filename": $!\n/;
!     print "Using $filename\n"  if $Debug;
!     $self->parse_config_sh(\*FILE);
!     close(FILE);
! 
!     if ($Cache) {
!       eval {
! 	require Data::Dumper;
! 	local $Data::Dumper::Terse = 1;
! 	local $Data::Dumper::Indent = 0;
! 	print 'Create cache ', $cache_file, "\n"  if $Debug;
! 	open(FILE, '>'.$cache_file) ||
! 	    die qq/Unable to create "$cache_file": $!\n/;
! 	print FILE '# DO NOT EDIT THIS FILE!', "\n",
! 		   Data::Dumper::Dumper($self), ';';
! 	close(FILE);
!       };
!       if ($@) {
! 	warn qq/Warning: Problem writing "$cache_file": $(_at_)\n/;
! 	unlink($cache_file);
!       };
!     }
!   }
! 
!   # Check for MHONARC_LIB, and if defined, add to perl's @INC
!   if ($self->{'MHONARC_LIB'}) {
!     print 'Adding ', $self->{'MHONARC_LIB'}, "to \(_at_)INC\n"  if $Debug;
!     unshift(@INC, $self->{'MHONARC_LIB'});
    }
+   $self;
+ }
  
+ sub parse_config_sh {
+   my $self  = shift;
+   my $fh    = shift;
+ 
+   my($line, $key, $value);
    while (defined($line = <$fh>)) {
      next unless $line =~ /\S/;
***************
*** 67,78 ****
      $self->{$key} = $value;
    }
- 
-   close($fh)  if $fh_close;
- 
-   # Check for MHONARC_LIB, and if defined, add to perl's @INC
-   if ($self->{'MHONARC_LIB'}) {
-     unshift(@INC, $self->{'MHONARC_LIB'});
-   }
-   $self;
  }
  
--- 139,142 ----
***************
*** 136,139 ****
--- 200,231 ----
  is recommended to not rely on the C<.dist> version since it will
  get overwritten on software updates.
+ 
+ =head1 CACHING
+ 
+ This module will create a cached version of the file loaded to
+ make subsequent loadings quicker.  The cached file will be called
+ C<E<lt>filenameE<gt>.cache.pl> and will contain the configuration
+ data in a Perl format.
+ 
+ When loading the configuration of a file, the timestamps of the
+ cache file and the regular file are compared.  If the cache is newer,
+ it is used.  Else, the regular file will be loaded and a new cache
+ file created.
+ 
+ =head1 VARIABLES
+ 
+ =over
+ 
+ =item C<$MHArc::Config::Cache>
+ 
+ If set to C<0>, no cache processing will be done.  Configuration will
+ be loaded directly from specified file.
+ 
+ =item C<$MHArc::Config::Debug>
+ 
+ If set to C<1>, diagnostic information will be printed.  This variable
+ should only be used for debugging and not in production.
+ 
+ =back
  
  =head1 VERSION

---------------------------------------------------------------------
To sign-off this list, send email to majordomo(_at_)mhonarc(_dot_)org with the
message text UNSUBSCRIBE MHONARC-DEV