home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / FileCache.pm < prev    next >
Text File  |  1997-11-25  |  2KB  |  79 lines
  1. package FileCache;
  2.  
  3. =head1 NAME
  4.  
  5. FileCache - keep more files open than the system permits
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     cacheout $path;
  10.     print $path @data;
  11.  
  12. =head1 DESCRIPTION
  13.  
  14. The C<cacheout> function will make sure that there's a filehandle open
  15. for writing available as the pathname you give it.  It automatically
  16. closes and re-opens files if you exceed your system file descriptor
  17. maximum.
  18.  
  19. =head1 BUGS
  20.  
  21. F<sys/param.h> lies with its C<NOFILE> define on some systems,
  22. so you may have to set $FileCache::cacheout_maxopen yourself.
  23.  
  24. =cut
  25.  
  26. require 5.000;
  27. use Carp;
  28. use Exporter;
  29.  
  30. @ISA = qw(Exporter);
  31. @EXPORT = qw(
  32.     cacheout
  33. );
  34.  
  35. # Open in their package.
  36.  
  37. sub cacheout_open {
  38.     my $pack = caller(1);
  39.     open(*{$pack . '::' . $_[0]}, $_[1]);
  40. }
  41.  
  42. sub cacheout_close {
  43.     my $pack = caller(1);
  44.     close(*{$pack . '::' . $_[0]});
  45. }
  46.  
  47. # But only this sub name is visible to them.
  48.  
  49. $cacheout_seq = 0;
  50. $cacheout_numopen = 0;
  51.  
  52. sub cacheout {
  53.     ($file) = @_;
  54.     unless (defined $cacheout_maxopen) {
  55.     if (open(PARAM,'/usr/include/sys/param.h')) {
  56.         local ($_, $.);
  57.         while (<PARAM>) {
  58.         $cacheout_maxopen = $1 - 4
  59.             if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
  60.         }
  61.         close PARAM;
  62.     }
  63.     $cacheout_maxopen = 16 unless $cacheout_maxopen;
  64.     }
  65.     if (!$isopen{$file}) {
  66.     if (++$cacheout_numopen > $cacheout_maxopen) {
  67.         my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
  68.         splice(@lru, $cacheout_maxopen / 3);
  69.         $cacheout_numopen -= @lru;
  70.         for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
  71.     }
  72.     cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
  73.         or croak("Can't create $file: $!");
  74.     }
  75.     $isopen{$file} = ++$cacheout_seq;
  76. }
  77.  
  78. 1;
  79.