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