Upgrade to Pod-Simple-3.08
[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 # This legacy library is deprecated and will be removed in a future
5 # release of perl.
6 #
7 # In particular, this should not be used as an example of modern Perl
8 # programming techniques.
9 #
10 # Suggested alternative: FileCache
11
12 warn( "The 'cacheout.pl' legacy library is deprecated and will be"
13       . " removed in the next major release of perl. Please use the"
14       . " FileCache module instead." );
15
16 # Open in their package.
17
18 sub cacheout'open {
19     open($_[0], $_[1]);
20 }
21
22 # Close as well
23
24 sub cacheout'close {
25     close($_[0]);
26 }
27
28 # But only this sub name is visible to them.
29
30 sub cacheout {
31     package cacheout;
32
33     ($file) = @_;
34     if (!$isopen{$file}) {
35         if (++$numopen > $maxopen) {
36             local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
37             splice(@lru, $maxopen / 3);
38             $numopen -= @lru;
39             for (@lru) { &close($_); delete $isopen{$_}; }
40         }
41         &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
42             || die "Can't create $file: $!\n";
43     }
44     $isopen{$file} = ++$seq;
45 }
46
47 package cacheout;
48
49 $seq = 0;
50 $numopen = 0;
51
52 if (open(PARAM,'/usr/include/sys/param.h')) {
53     local($_, $.);
54     while (<PARAM>) {
55         $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
56     }
57     close PARAM;
58 }
59 $maxopen = 16 unless $maxopen;
60
61 1;