lib/cacheout.pl

   1 #
   2 # This library is no longer being maintained, and is included for backward
   3 # compatibility with Perl 4 programs which may require it.
   4 #
   5 # In particular, this should not be used as an example of modern Perl
   6 # programming techniques.
   7 #
   8 # Suggested alternative: FileCache
   9
  10 # Open in their package.
  11
  12 sub cacheout'open {
  13     open($_[0], $_[1]);
  14 }
  15
  16 # Close as well
  17
  18 sub cacheout'close {
  19     close($_[0]);
  20 }
  21
  22 # But only this sub name is visible to them.
  23
  24 sub cacheout {
  25     package cacheout;
  26
  27     ($file) = @_;
  28     if (!$isopen{$file}) {
  29         if (++$numopen > $maxopen) {
  30             local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
  31             splice(@lru, $maxopen / 3);
  32             $numopen -= @lru;
  33             for (@lru) { &close($_); delete $isopen{$_}; }
  34         }
  35         &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
  36             || die "Can't create $file: $!\n";
  37     }
  38     $isopen{$file} = ++$seq;
  39 }
  40
  41 package cacheout;
  42
  43 $seq = 0;
  44 $numopen = 0;
  45
  46 if (open(PARAM,'/usr/include/sys/param.h')) {
  47     local($_, $.);
  48     while (<PARAM>) {
  49         $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
  50     }
  51     close PARAM;
  52 }
  53 $maxopen = 16 unless $maxopen;
  54
  55 1;