lib/cacheout.pl

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