package FileHandle;
-# Note that some additional FileHandle methods are defined in POSIX.pm.
+use 5.003_11;
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-=head1 NAME
+$VERSION = "2.00";
-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<perlvar> for complete descriptions of each of the following supported C<FileHandle>
-methods:
-
- print
autoflush
output_field_separator
output_record_separator
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<sys/param.h> lies with its C<NOFILE> 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<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.
+################################################
+# 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 = new FileHandle;
+ if ($fh->open "< file") {
+ print <$fh>;
+ $fh->close;
+ }
+
+ $fh = new FileHandle "> FOO";
+ if (defined $fh) {
+ print $fh "bar\n";
+ $fh->close;
+ }
+
+ $fh = new FileHandle "file", "r";
+ if (defined $fh) {
+ print <$fh>;
+ undef $fh; # automatically closes the file
+ }
+
+ $fh = new FileHandle "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<FileHandle::new> creates a C<FileHandle>, which is a reference to a
+newly created symbol (see the C<Symbol> package). If it receives any
+parameters, they are passed to C<FileHandle::open>; if the open fails,
+the C<FileHandle> object is destroyed. Otherwise, it is returned to
+the caller.
+
+C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does.
+It requires two parameters, which are passed to C<FileHandle::fdopen>;
+if the fdopen fails, the C<FileHandle> object is destroyed.
+Otherwise, it is returned to the caller.
+
+C<FileHandle::open> accepts one parameter or two. With one parameter,
+it is just a front end for the built-in C<open> 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<FileHandle::open> receives a Perl mode string (">", "+<", etc.)
+or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic
+Perl C<open> operator.
+
+If C<FileHandle::open> is given a numeric mode, it passes that mode
+and the optional permissions value to the Perl C<sysopen> operator.
+For convenience, C<FileHandle::import> 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<FileHandle::fdopen> is like C<open> 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<FileHandle::getpos> returns an opaque value that represents the
+current position of the FileHandle, and C<FileHandle::setpos> uses
+that value to return to a previously visited position.
+
+If the C function setvbuf() is available, then C<FileHandle::setvbuf>
+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<FileHandle::setvbuf> must not be
+modified in any way until the FileHandle is closed or until
+C<FileHandle::setvbuf> is called again, or memory corruption may
+result!
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<FileHandle> methods, which are just front ends for the
+corresponding built-in functions:
+
+ close
+ fileno
+ getc
+ gets
+ eof
+ clearerr
+ seek
+ tell
+
+See L<perlvar> for complete descriptions of each of the following
+supported C<FileHandle> methods:
-@ISA = qw(Exporter);
-@EXPORT = qw(
- print
autoflush
output_field_separator
output_record_separator
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
-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<perlfunc/print>.
-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<perlfunc/printf>.
-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<perlop/"I/O Operators">
+except that it's more readable and can be safely called in an
+array 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 an array 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 (<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;
-}
+=head1 SEE ALSO
-$cacheout_seq = 0;
-$cacheout_numopen = 0;
+The B<IO> extension,
+L<perlfunc>,
+L<perlop/"I/O Operators">.
-1;
+=cut
https://perl5.git.perl.org / perl5.git / blobdiff