This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix a couple of -Dmad compiler warnings
[perl5.git] / lib / cacheout.pl
CommitLineData
0111154e
Z
1warn "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
16sub cacheout'open {
17 open($_[0], $_[1]);
18}
19
a0d0e21e
LW
20# Close as well
21
22sub cacheout'close {
23 close($_[0]);
24}
25
39c3038c
LW
26# But only this sub name is visible to them.
27
28sub 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
45package cacheout;
46
47$seq = 0;
48$numopen = 0;
49
50if (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
591;