Rename tied_handle_method() to tied_method(), and make it non-static.
[perl.git] / lib / cacheout.pl
1 warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
2
3 #
4 # This library is no longer being maintained, and is included for backward
5 # compatibility with Perl 4 programs which may require it.
6 # This legacy library is deprecated and will be removed in a future
7 # release of perl.
8 #
9 # In particular, this should not be used as an example of modern Perl
10 # programming techniques.
11 #
12 # Suggested alternative: FileCache
13
14 # Open in their package.
15
16 sub cacheout'open {
17     open($_[0], $_[1]);
18 }
19
20 # Close as well
21
22 sub cacheout'close {
23     close($_[0]);
24 }
25
26 # But only this sub name is visible to them.
27
28 sub cacheout {
29     package cacheout;
30
31     ($file) = @_;
32     if (!$isopen{$file}) {
33         if (++$numopen > $maxopen) {
34             local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
35             splice(@lru, $maxopen / 3);
36             $numopen -= @lru;
37             for (@lru) { &close($_); delete $isopen{$_}; }
38         }
39         &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
40             || die "Can't create $file: $!\n";
41     }
42     $isopen{$file} = ++$seq;
43 }
44
45 package cacheout;
46
47 $seq = 0;
48 $numopen = 0;
49
50 if (open(PARAM,'/usr/include/sys/param.h')) {
51     local($_, $.);
52     while (<PARAM>) {
53         $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
54     }
55     close PARAM;
56 }
57 $maxopen = 16 unless $maxopen;
58
59 1;