diff options
author | Andy Dougherty <doughera.lafayette.edu> | 1996-02-03 00:53:00 +0000 |
---|---|---|
committer | Andy Dougherty <doughera.lafayette.edu> | 1996-02-03 00:53:00 +0000 |
commit | 399f14a194513745fd160c0e4e8f6f7f718779cf (patch) | |
tree | e110916dffcfdbc88bd35c14778a72a87cd6582e /lib/FileHandle.pm | |
parent | c07a80fdfe3926b5eb0585b674aa5d1f57b32ade (diff) | |
download | perl-399f14a194513745fd160c0e4e8f6f7f718779cf.tar.gz |
perl 5.002gamma: [patch introduction and re-organisations]
[ re-organisations:
# Give this module a sensible home.
mv pod/PerlDoc/Functions.pm lib/Pod/Functions.pm
rmdir pod/PerlDoc
# Tie:: finally has its own hierarchy
mkdir lib/Tie
mv lib/TieHash.pm lib/Tie/Hash.pm
mv lib/SubstrHash.pm lib/Tie/SubstrHash.pm
rm -f lib/FileHandle.pm # Duplicate of ext/FileHandle/FileHandle.pm
rm -f os2/diff.MANIFEST # Obsolete (I applied a variant of it.)
rm -f os2/diff.init # Obsolete.
]
This is patch.2gamma to perl5.002 beta3.
This takes you from 5.002beta3 to 5.002gamma.
To apply this patch, run the above commands, then
cd to your perl source directory and then type
patch -p1 -N < patch.2gamma
The changes are described after each /^Index/ line below. This is
designed so you can examine each change with a command such as
csplit -k patch.2gamma '/^Index:/' '{99}'
(Of course since there are 116 items and most csplit's have an
arbitrary limit of 100 files, you'll probably have to manually split
this file first, but you get the idea. (GNU csplit doesn't have this
limitation. Nor does a perl solution, of course.))
Patch and enjoy,
Andy Dougherty doughera@lafcol.lafayette.edu
Dept. of Physics
Lafayette College, Easton PA 18042
Diffstat (limited to 'lib/FileHandle.pm')
-rw-r--r-- | lib/FileHandle.pm | 426 |
1 files changed, 0 insertions, 426 deletions
diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm deleted file mode 100644 index 93a3088886..0000000000 --- a/lib/FileHandle.pm +++ /dev/null @@ -1,426 +0,0 @@ -package FileHandle; - -=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 - } - - ($readfh, $writefh) = FileHandle::pipe; - - autoflush STDOUT 1; - -=head1 DESCRIPTION - -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 in either Perl form (">", "+<", etc.) or POSIX form -("w", "r+", etc.). - -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. - -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: - - 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 - -Furthermore, for doing normal I/O you might need these: - -=over - -=item $fh->print - -See L<perlfunc/print>. - -=item $fh->printf - -See L<perlfunc/printf>. - -=item $fh->getline - -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. - -=item $fh->getlines - -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. - -=back - -=head1 SEE ALSO - -L<perlfunc>, -L<perlop/"I/O Operators">, -L<POSIX/"FileHandle"> - -=head1 BUGS - -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 Carp; -use Fcntl; -use Symbol; -use English; -use SelectSaver; - -require Exporter; -require DynaLoader; -@ISA = qw(Exporter DynaLoader); - -@EXPORT = (@Fcntl::EXPORT, - qw(_IOFBF _IOLBF _IONBF)); - -@EXPORT_OK = qw( - 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 - - print - printf - getline - getlines -); - - -################################################ -## Interaction with the XS. -## - -bootstrap FileHandle; - -sub AUTOLOAD { - if ($AUTOLOAD =~ /::(_?[a-z])/) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD - } - my $constname = $AUTOLOAD; - $constname =~ s/.*:://; - my $val = constant($constname); - defined $val or croak "$constname is not a valid FileHandle macro"; - *$AUTOLOAD = sub { $val }; - goto &$AUTOLOAD; -} - - -################################################ -## Constructors, destructors. -## - -sub new { - @_ >= 1 && @_ <= 3 or croak 'usage: new FileHandle [FILENAME [,MODE]]'; - my $class = shift; - my $fh = gensym; - if (@_) { - FileHandle::open($fh, @_) - or return undef; - } - bless $fh, $class; -} - -sub new_from_fd { - @_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE'; - my $class = shift; - my $fh = gensym; - FileHandle::fdopen($fh, @_) - or return undef; - bless $fh, $class; -} - -sub DESTROY { - my ($fh) = @_; - close($fh); -} - -################################################ -## Open and close. -## - -sub pipe { - @_ and croak 'usage: FileHandle::pipe()'; - my $readfh = new FileHandle; - my $writefh = new FileHandle; - pipe($readfh, $writefh) - or return undef; - ($readfh, $writefh); -} - -sub _open_mode_string { - my ($mode) = @_; - $mode =~ /^\+?(<|>>?)$/ - or $mode =~ s/^r(\+?)$/$1</ - or $mode =~ s/^w(\+?)$/$1>/ - or $mode =~ s/^a(\+?)$/$1>>/ - or croak "FileHandle: bad open mode: $mode"; - $mode; -} - -sub open { - @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])'; - my ($fh, $file) = @_; - if (@_ > 2) { - my ($mode, $perms) = @_[2, 3]; - if ($mode =~ /^\d+$/) { - defined $perms or $perms = 0666; - return sysopen($fh, $file, $mode, $perms); - } - $file = "./" . $file unless $file =~ m#^/#; - $file = _open_mode_string($mode) . " $file\0"; - } - open($fh, $file); -} - -sub fdopen { - @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)'; - my ($fh, $fd, $mode) = @_; - if (ref($fd) =~ /GLOB\(/) { - # It's a glob reference; remove the star from its name. - ($fd = "".$$fd) =~ s/^\*//; - } elsif ($fd =~ m#^\d+$#) { - # It's an FD number; prefix with "=". - $fd = "=$fd"; - } - open($fh, _open_mode_string($mode) . '&' . $fd); -} - -sub close { - @_ == 1 or croak 'usage: $fh->close()'; - close($_[0]); -} - -################################################ -## Normal I/O functions. -## - -sub fileno { - @_ == 1 or croak 'usage: $fh->fileno()'; - fileno($_[0]); -} - -sub getc { - @_ == 1 or croak 'usage: $fh->getc()'; - getc($_[0]); -} - -sub gets { - @_ == 1 or croak 'usage: $fh->gets()'; - my ($handle) = @_; - scalar <$handle>; -} - -sub eof { - @_ == 1 or croak 'usage: $fh->eof()'; - eof($_[0]); -} - -sub clearerr { - @_ == 1 or croak 'usage: $fh->clearerr()'; - seek($_[0], 0, 1); -} - -sub seek { - @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)'; - seek($_[0], $_[1], $_[2]); -} - -sub tell { - @_ == 1 or croak 'usage: $fh->tell()'; - tell($_[0]); -} - -sub print { - @_ or croak 'usage: $fh->print([ARGS])'; - my $this = shift; - print $this @_; -} - -sub printf { - @_ or croak 'usage: $fh->printf([ARGS])'; - my $this = shift; - printf $this @_; -} - -sub getline { - @_ == 1 or croak 'usage: $fh->getline'; - my $this = shift; - return scalar <$this>; -} - -sub getlines { - @_ == 1 or croak 'usage: $fh->getline()'; - my $this = shift; - wantarray or croak "Can't call FileHandle::getlines in a scalar context"; - return <$this>; -} - -################################################ -## State modification functions. -## - -sub autoflush { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $OUTPUT_AUTOFLUSH; - $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1; - $prev; -} - -sub output_field_separator { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $OUTPUT_FIELD_SEPARATOR; - $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1; - $prev; -} - -sub output_record_separator { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $OUTPUT_RECORD_SEPARATOR; - $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; - $prev; -} - -sub input_record_separator { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $INPUT_RECORD_SEPARATOR; - $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; - $prev; -} - -sub input_line_number { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $INPUT_LINE_NUMBER; - $INPUT_LINE_NUMBER = $_[1] if @_ > 1; - $prev; -} - -sub format_page_number { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $FORMAT_PAGE_NUMBER; - $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1; - $prev; -} - -sub format_lines_per_page { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $FORMAT_LINES_PER_PAGE; - $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1; - $prev; -} - -sub format_lines_left { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $FORMAT_LINES_LEFT; - $FORMAT_LINES_LEFT = $_[1] if @_ > 1; - $prev; -} - -sub format_name { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $FORMAT_NAME; - $FORMAT_NAME = qualify($_[1], caller) if @_ > 1; - $prev; -} - -sub format_top_name { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $FORMAT_TOP_NAME; - $FORMAT_TOP_NAME = qualify($_[1], caller) if @_ > 1; - $prev; -} - -sub format_line_break_characters { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $FORMAT_LINE_BREAK_CHARACTERS; - $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1; - $prev; -} - -sub format_formfeed { - my $old = new SelectSaver qualify($_[0], caller); - my $prev = $FORMAT_FORMFEED; - $FORMAT_FORMFEED = $_[1] if @_ > 1; - $prev; -} - -1; |