home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PERL4036.ZIP / lib / cacheout.pl < prev    next >
Perl Script  |  1993-02-08  |  785b  |  41 lines
  1. # Open in their package.
  2.  
  3. sub cacheout'open {
  4.     open($_[0], $_[1]);
  5. }
  6.  
  7. # But only this sub name is visible to them.
  8.  
  9. sub cacheout {
  10.     package cacheout;
  11.  
  12.     ($file) = @_;
  13.     if (!$isopen{$file}) {
  14.     if (++$numopen > $maxopen) {
  15.         local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
  16.         splice(@lru, $maxopen / 3);
  17.         $numopen -= @lru;
  18.         for (@lru) { close $_; delete $isopen{$_}; }
  19.     }
  20.     &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
  21.         || die "Can't create $file: $!\n";
  22.     }
  23.     $isopen{$file} = ++$seq;
  24. }
  25.  
  26. package cacheout;
  27.  
  28. $seq = 0;
  29. $numopen = 0;
  30.  
  31. if (open(PARAM,'/usr/include/sys/param.h')) {
  32.     local($.);
  33.     while (<PARAM>) {
  34.     $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
  35.     }
  36.     close PARAM;
  37. }
  38. $maxopen = 16 unless $maxopen;
  39.  
  40. 1;
  41.