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