lib/cacheout.pl

   1 #!/usr/bin/perl
   2
   3 # Open in their package.
   4
   5 sub cacheout'open {
   6     open($_[0], $_[1]);
   7 }
   8
   9 # But only this sub name is visible to them.
  10
  11 sub cacheout {
  12     package cacheout;
  13
  14     ($file) = @_;
  15     ($package) = caller;
  16     if (!$isopen{$file}) {
  17         if (++$numopen > $maxopen) {
  18             sub byseq {$isopen{$a} != $isopen{$b};}
  19             local(@lru) = sort byseq keys(%isopen);
  20             splice(@lru, $maxopen / 3);
  21             $numopen -= @lru;
  22             for (@lru) { close $_; delete $isopen{$_}; }
  23         }
  24         &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
  25             || die "Can't create $file: $!\n";
  26     }
  27     $isopen{$file} = ++$seq;
  28 }
  29
  30 package cacheout;
  31
  32 $seq = 0;
  33 $numopen = 0;
  34
  35 if (open(PARAM,'/usr/include/sys/param.h')) {
  36     local($.);
  37     while (<PARAM>) {
  38         $maxopen = $1 - 4 if /^#define NOFILE\s+(\d+)/;
  39     }
  40     close PARAM;
  41 }
  42 $maxopen = 16 unless $maxopen;
  43
  44 1;