X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFileHandle.pm;h=6b3636a089d5ea59d6757564f230b4d961908177;hb=a79d563c5b1e534968f5274b3cc36fa26e10ba16;hp=9408717a7cabbd7146b22d4f0f9062896467d8cf;hpb=f06db76b9e41859439aeadb79feb6c603ee741ff;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index 9408717..6b3636a 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -1,27 +1,19 @@ package FileHandle; -# Note that some additional FileHandle methods are defined in POSIX.pm. +use 5.006; +use strict; +our($VERSION, @ISA, @EXPORT, @EXPORT_OK); -=head1 NAME +$VERSION = "2.02"; -FileHandle - supply object methods for filehandles - -cacheout - keep more files open than the system permits - -=head1 SYNOPSIS - - use FileHandle; - autoflush STDOUT 1; +require IO::File; +@ISA = qw(IO::File); - cacheout($path); - print $path @data; +@EXPORT = qw(_IOFBF _IOLBF _IONBF); -=head1 DESCRIPTION +@EXPORT_OK = qw( + pipe -See L for complete descriptions of each of the following supported C -methods: - - print autoflush output_field_separator output_record_separator @@ -35,29 +27,189 @@ methods: 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. + print + printf + getline + getlines +); -=head1 BUGS +# +# Everything we're willing to export, we must first import. +# +import IO::Handle grep { !defined(&$_) } @EXPORT, @EXPORT_OK; + +# +# Some people call "FileHandle::function", so all the functions +# that were in the old FileHandle class must be imported, too. +# +{ + no strict 'refs'; + + my %import = ( + 'IO::Handle' => + [qw(DESTROY new_from_fd fdopen close fileno getc ungetc gets + eof flush error clearerr setbuf setvbuf _open_mode_string)], + 'IO::Seekable' => + [qw(seek tell getpos setpos)], + 'IO::File' => + [qw(new new_tmpfile open)] + ); + for my $pkg (keys %import) { + for my $func (@{$import{$pkg}}) { + my $c = *{"${pkg}::$func"}{CODE} + or die "${pkg}::$func missing"; + *$func = $c; + } + } +} -F lies with its C define on some systems, -so you may have to set $cacheout::maxopen yourself. +# +# Specialized importer for Fcntl magic. +# +sub import { + my $pkg = shift; + my $callpkg = caller; + require Exporter; + Exporter::export($pkg, $callpkg, @_); + + # + # If the Fcntl extension is available, + # export its constants. + # + eval { + require Fcntl; + Exporter::export('Fcntl', $callpkg); + }; +} -Due to backwards compatibility, all filehandles resemble objects -of class C, or actually classes derived from that class. -They actually aren't. Which means you can't derive your own -class from C and inherit those methods. +################################################ +# This is the only exported function we define; +# the rest come from other classes. +# -=cut +sub pipe { + my $r = new IO::Handle; + my $w = new IO::Handle; + CORE::pipe($r, $w) or return undef; + ($r, $w); +} -require 5.000; -use English; -use Exporter; +# Rebless standard file handles +bless *STDIN{IO}, "FileHandle" if ref *STDIN{IO} eq "IO::Handle"; +bless *STDOUT{IO}, "FileHandle" if ref *STDOUT{IO} eq "IO::Handle"; +bless *STDERR{IO}, "FileHandle" if ref *STDERR{IO} eq "IO::Handle"; + +1; + +__END__ + +=head1 NAME + +FileHandle - supply object methods for filehandles + +=head1 SYNOPSIS + + use FileHandle; + + $fh = FileHandle->new; + if ($fh->open("< file")) { + print <$fh>; + $fh->close; + } + + $fh = FileHandle->new("> FOO"); + if (defined $fh) { + print $fh "bar\n"; + $fh->close; + } + + $fh = FileHandle->new("file", "r"); + if (defined $fh) { + print <$fh>; + undef $fh; # automatically closes the file + } + + $fh = FileHandle->new("file", O_WRONLY|O_APPEND); + if (defined $fh) { + print $fh "corge\n"; + undef $fh; # automatically closes the file + } + + $pos = $fh->getpos; + $fh->setpos($pos); + + $fh->setvbuf($buffer_var, _IOLBF, 1024); + + ($readfh, $writefh) = FileHandle::pipe; + + autoflush STDOUT 1; + +=head1 DESCRIPTION + +NOTE: This class is now a front-end to the IO::* classes. + +C creates a C, which is a reference to a +newly created symbol (see the C package). If it receives any +parameters, they are passed to C; if the open fails, +the C object is destroyed. Otherwise, it is returned to +the caller. + +C creates a C like C does. +It requires two parameters, which are passed to C; +if the fdopen fails, the C object is destroyed. +Otherwise, it is returned to the caller. + +C accepts one parameter or two. With one parameter, +it is just a front end for the built-in C function. With two +parameters, the first parameter is a filename that may include +whitespace or other special characters, and the second parameter is +the open mode, optionally followed by a file permission value. + +If C receives a Perl mode string (">", "+<", etc.) +or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic +Perl C operator. + +If C is given a numeric mode, it passes that mode +and the optional permissions value to the Perl C operator. +For convenience, C tries to import the O_XXX +constants from the Fcntl module. If dynamic loading is not available, +this may fail, but the rest of FileHandle will still work. + +C is like C except that its first parameter +is not a filename but rather a file handle name, a FileHandle object, +or a file descriptor number. + +If the C functions fgetpos() and fsetpos() are available, then +C returns an opaque value that represents the +current position of the FileHandle, and C uses +that value to return to a previously visited position. + +If the C function setvbuf() is available, then C +sets the buffering policy for the FileHandle. The calling sequence +for the Perl function is the same as its C counterpart, including the +macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer +parameter specifies a scalar variable to use as a buffer. WARNING: A +variable used as a buffer by C must not be +modified in any way until the FileHandle is closed or until +C is called again, or memory corruption may +result! + +See L for complete descriptions of each of the following +supported C methods, which are just front ends for the +corresponding built-in functions: + + close + fileno + getc + gets + eof + clearerr + seek + tell + +See L for complete descriptions of each of the following +supported C methods: -@ISA = qw(Exporter); -@EXPORT = qw( - print autoflush output_field_separator output_record_separator @@ -70,154 +222,41 @@ use Exporter; format_top_name format_line_break_characters format_formfeed - cacheout -); -sub print { - local($this) = shift; - print $this @_; -} +Furthermore, for doing normal I/O you might need these: -sub autoflush { - local($old) = select($_[0]); - local($prev) = $OUTPUT_AUTOFLUSH; - $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1; - select($old); - $prev; -} +=over 4 -sub output_field_separator { - local($old) = select($_[0]); - local($prev) = $OUTPUT_FIELD_SEPARATOR; - $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1; - select($old); - $prev; -} +=item $fh->print -sub output_record_separator { - local($old) = select($_[0]); - local($prev) = $OUTPUT_RECORD_SEPARATOR; - $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; - select($old); - $prev; -} +See L. -sub input_record_separator { - local($old) = select($_[0]); - local($prev) = $INPUT_RECORD_SEPARATOR; - $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; - select($old); - $prev; -} +=item $fh->printf -sub input_line_number { - local($old) = select($_[0]); - local($prev) = $INPUT_LINE_NUMBER; - $INPUT_LINE_NUMBER = $_[1] if @_ > 1; - select($old); - $prev; -} +See L. -sub format_page_number { - local($old) = select($_[0]); - local($prev) = $FORMAT_PAGE_NUMBER; - $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1; - select($old); - $prev; -} +=item $fh->getline -sub format_lines_per_page { - local($old) = select($_[0]); - local($prev) = $FORMAT_LINES_PER_PAGE; - $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1; - select($old); - $prev; -} +This works like <$fh> described in L +except that it's more readable and can be safely called in a +list context but still returns just one line. -sub format_lines_left { - local($old) = select($_[0]); - local($prev) = $FORMAT_LINES_LEFT; - $FORMAT_LINES_LEFT = $_[1] if @_ > 1; - select($old); - $prev; -} +=item $fh->getlines -sub format_name { - local($old) = select($_[0]); - local($prev) = $FORMAT_NAME; - $FORMAT_NAME = $_[1] if @_ > 1; - select($old); - $prev; -} +This works like <$fh> when called in a list context to +read all the remaining lines in a file, except that it's more readable. +It will also croak() if accidentally called in a scalar context. -sub format_top_name { - local($old) = select($_[0]); - local($prev) = $FORMAT_TOP_NAME; - $FORMAT_TOP_NAME = $_[1] if @_ > 1; - select($old); - $prev; -} - -sub format_line_break_characters { - local($old) = select($_[0]); - local($prev) = $FORMAT_LINE_BREAK_CHARACTERS; - $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1; - select($old); - $prev; -} - -sub format_formfeed { - local($old) = select($_[0]); - local($prev) = $FORMAT_FORMFEED; - $FORMAT_FORMFEED = $_[1] if @_ > 1; - select($old); - $prev; -} - - -# --- cacheout functions --- - -# Open in their package. - -sub cacheout_open { - my $pack = caller(1); - open(*{$pack . '::' . $_[0]}, $_[1]); -} +=back -sub cacheout_close { - my $pack = caller(1); - close(*{$pack . '::' . $_[0]}); -} +There are many other functions available since FileHandle is descended +from IO::File, IO::Seekable, and IO::Handle. Please see those +respective pages for documentation on more functions. -# 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 () { - $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; -} +=head1 SEE ALSO -$cacheout_seq = 0; -$cacheout_numopen = 0; +The B extension, +L, +L. -1; +=cut