perl 3.0 patch #30 patch #29, continued

See patch #29.

1 files changed, 44 insertions, 0 deletions

diff --git a/lib/cacheout.pl b/lib/cacheout.pl
new file mode 100644
index 0000000000..106014cc5d
--- /dev/null
+++ b/lib/cacheout.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+# Open in their package.
+
+sub cacheout'open {
+    open($_[0], $_[1]);
+}
+
+# But only this sub name is visible to them.
+
+sub cacheout {
+    package cacheout;
+
+    ($file) = @_;
+    ($package) = caller;
+    if (!$isopen{$file}) {
+	if (++$numopen > $maxopen) {
+	    sub byseq {$isopen{$a} != $isopen{$b};}
+	    local(@lru) = sort byseq keys(%isopen);
+	    splice(@lru, $maxopen / 3);
+	    $numopen -= @lru;
+	    for (@lru) { close $_; delete $isopen{$_}; }
+	}
+	&open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+	    || die "Can't create $file: $!\n";
+    }
+    $isopen{$file} = ++$seq;
+}
+
+package cacheout;
+
+$seq = 0;
+$numopen = 0;
+
+if (open(PARAM,'/usr/include/sys/param.h')) {
+    local($.);
+    while (<PARAM>) {
+	$maxopen = $1 - 4 if /^#define NOFILE\s+(\d+)/;
+    }
+    close PARAM;
+}
+$maxopen = 16 unless $maxopen;
+
+1;