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