Update File::Copy tests to skip on OpenBSD, as it mounts too many filesystems nosuid.
[p5sagit/p5-mst-13.2.git] / lib / cacheout.pl
CommitLineData
a6d71656 1#
2# This library is no longer being maintained, and is included for backward
3# compatibility with Perl 4 programs which may require it.
e879c7c6 4# This legacy library is deprecated and will be removed in a future
5# release of perl.
a6d71656 6#
7# In particular, this should not be used as an example of modern Perl
8# programming techniques.
9#
10# Suggested alternative: FileCache
11
e879c7c6 12warn( "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
39c3038c 16# Open in their package.
17
18sub cacheout'open {
19 open($_[0], $_[1]);
20}
21
a0d0e21e 22# Close as well
23
24sub cacheout'close {
25 close($_[0]);
26}
27
39c3038c 28# But only this sub name is visible to them.
29
30sub cacheout {
31 package cacheout;
32
33 ($file) = @_;
39c3038c 34 if (!$isopen{$file}) {
35 if (++$numopen > $maxopen) {
55204971 36 local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
39c3038c 37 splice(@lru, $maxopen / 3);
38 $numopen -= @lru;
a0d0e21e 39 for (@lru) { &close($_); delete $isopen{$_}; }
39c3038c 40 }
41 &open($file, ($saw{$file}++ ? '>>' : '>') . $file)
42 || die "Can't create $file: $!\n";
43 }
44 $isopen{$file} = ++$seq;
45}
46
47package cacheout;
48
49$seq = 0;
50$numopen = 0;
51
52if (open(PARAM,'/usr/include/sys/param.h')) {
7adad424 53 local($_, $.);
39c3038c 54 while (<PARAM>) {
55204971 55 $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
39c3038c 56 }
57 close PARAM;
58}
59$maxopen = 16 unless $maxopen;
60
611;