X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFileHandle.pm;h=9408717a7cabbd7146b22d4f0f9062896467d8cf;hb=c296029969658ed2c8d9a223d4b09026463ca970;hp=b975c2b990f8b68c36ef031c6b1f02bb41f482b6;hpb=8990e3071044a96302560bbdb5706f3e74cf1bef;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm
index b975c2b..9408717 100644
--- a/lib/FileHandle.pm
+++ b/lib/FileHandle.pm
@@ -1,17 +1,84 @@
 package FileHandle;
 
-BEGIN {
-    require 5.000;
-    require English; import English;
-}
-@ISA = ();
+# Note that some additional FileHandle methods are defined in POSIX.pm.
+
+=head1 NAME 
+
+FileHandle - supply object methods for filehandles
+
+cacheout - keep more files open than the system permits
+
+=head1 SYNOPSIS
+
+    use FileHandle;
+    autoflush STDOUT 1;
+
+    cacheout($path);
+    print $path @data;
+
+=head1 DESCRIPTION
+
+See L<perlvar> for complete descriptions of each of the following supported C<FileHandle> 
+methods:
+
+    print
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+
+The cacheout() function will make sure that there's a filehandle
+open for writing available as the pathname you give it.  It automatically
+closes and re-opens files if you exceed your system file descriptor maximum.
+
+=head1 BUGS
+
+F<sys/param.h> lies with its C<NOFILE> define on some systems,
+so you may have to set $cacheout::maxopen yourself.
+
+Due to backwards compatibility, all filehandles resemble objects
+of class C<FileHandle>, or actually classes derived from that class.
+They actually aren't.  Which means you can't derive your own 
+class from C<FileHandle> and inherit those methods.
+
+=cut
+
+require 5.000;
+use English;
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(
+    print
+    autoflush
+    output_field_separator
+    output_record_separator
+    input_record_separator
+    input_line_number
+    format_page_number
+    format_lines_per_page
+    format_lines_left
+    format_name
+    format_top_name
+    format_line_break_characters
+    format_formfeed
+    cacheout
+);
 
 sub print {
     local($this) = shift;
     print $this @_;
 }
 
-sub output_autoflush {
+sub autoflush {
     local($old) = select($_[0]);
     local($prev) = $OUTPUT_AUTOFLUSH;
     $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1;
@@ -107,4 +174,50 @@ sub format_formfeed {
     $prev;
 }
 
+
+# --- cacheout functions ---
+
+# Open in their package.
+
+sub cacheout_open {
+    my $pack = caller(1);
+    open(*{$pack . '::' . $_[0]}, $_[1]);
+}
+
+sub cacheout_close {
+    my $pack = caller(1);
+    close(*{$pack . '::' . $_[0]});
+}
+
+# But only this sub name is visible to them.
+
+sub cacheout {
+    ($file) = @_;
+    if (!$cacheout_maxopen){
+	if (open(PARAM,'/usr/include/sys/param.h')) {
+	    local($.);
+	    while (<PARAM>) {
+		$cacheout_maxopen = $1 - 4
+		    if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+	    }
+	    close PARAM;
+	}
+	$cacheout_maxopen = 16 unless $cacheout_maxopen;
+    }
+    if (!$isopen{$file}) {
+	if (++$cacheout_numopen > $cacheout_maxopen) {
+	    local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
+	    splice(@lru, $cacheout_maxopen / 3);
+	    $cacheout_numopen -= @lru;
+	    for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
+	}
+	&cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+	    || croak("Can't create $file: $!");
+    }
+    $isopen{$file} = ++$cacheout_seq;
+}
+
+$cacheout_seq = 0;
+$cacheout_numopen = 0;
+
 1;