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;
$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;