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