Commit | Line | Data |
---|---|---|
0111154e Z |
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 | ||
a6d71656 GS |
3 | # |
4 | # This library is no longer being maintained, and is included for backward | |
5 | # compatibility with Perl 4 programs which may require it. | |
e879c7c6 S |
6 | # This legacy library is deprecated and will be removed in a future |
7 | # release of perl. | |
a6d71656 GS |
8 | # |
9 | # In particular, this should not be used as an example of modern Perl | |
10 | # programming techniques. | |
11 | # | |
12 | # Suggested alternative: FileCache | |
13 | ||
39c3038c LW |
14 | # Open in their package. |
15 | ||
16 | sub cacheout'open { | |
17 | open($_[0], $_[1]); | |
18 | } | |
19 | ||
a0d0e21e LW |
20 | # Close as well |
21 | ||
22 | sub cacheout'close { | |
23 | close($_[0]); | |
24 | } | |
25 | ||
39c3038c LW |
26 | # But only this sub name is visible to them. |
27 | ||
28 | sub cacheout { | |
29 | package cacheout; | |
30 | ||
31 | ($file) = @_; | |
39c3038c LW |
32 | if (!$isopen{$file}) { |
33 | if (++$numopen > $maxopen) { | |
55204971 | 34 | local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen); |
39c3038c LW |
35 | splice(@lru, $maxopen / 3); |
36 | $numopen -= @lru; | |
a0d0e21e | 37 | for (@lru) { &close($_); delete $isopen{$_}; } |
39c3038c LW |
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')) { | |
7adad424 | 51 | local($_, $.); |
39c3038c | 52 | while (<PARAM>) { |
55204971 | 53 | $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/; |
39c3038c LW |
54 | } |
55 | close PARAM; | |
56 | } | |
57 | $maxopen = 16 unless $maxopen; | |
58 | ||
59 | 1; |