perl 3.0 patch #30 patch #29, continued
[perl.git] / lib / cacheout.pl
1 #!/usr/bin/perl
2
3 # Open in their package.
4
5 sub cacheout'open {
6     open($_[0], $_[1]);
7 }
8
9 # But only this sub name is visible to them.
10
11 sub cacheout {
12     package cacheout;
13
14     ($file) = @_;
15     ($package) = caller;
16     if (!$isopen{$file}) {
17         if (++$numopen > $maxopen) {
18             sub byseq {$isopen{$a} != $isopen{$b};}
19             local(@lru) = sort byseq keys(%isopen);
20             splice(@lru, $maxopen / 3);
21             $numopen -= @lru;
22             for (@lru) { close $_; delete $isopen{$_}; }
23         }
24         &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
25             || die "Can't create $file: $!\n";
26     }
27     $isopen{$file} = ++$seq;
28 }
29
30 package cacheout;
31
32 $seq = 0;
33 $numopen = 0;
34
35 if (open(PARAM,'/usr/include/sys/param.h')) {
36     local($.);
37     while (<PARAM>) {
38         $maxopen = $1 - 4 if /^#define NOFILE\s+(\d+)/;
39     }
40     close PARAM;
41 }
42 $maxopen = 16 unless $maxopen;
43
44 1;