Allow ~~ overloading on the left side, when the right side is a plain scalar
[perl.git] / 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 #
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;