106 lines
2.1 KiB
Perl
106 lines
2.1 KiB
Perl
package FileHandle;
|
|
|
|
use 5.006;
|
|
use strict;
|
|
our($VERSION, @ISA, @EXPORT, @EXPORT_OK);
|
|
|
|
$VERSION = "2.03";
|
|
|
|
require IO::File;
|
|
@ISA = qw(IO::File);
|
|
|
|
@EXPORT = qw(_IOFBF _IOLBF _IONBF);
|
|
|
|
@EXPORT_OK = qw(
|
|
pipe
|
|
|
|
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
|
|
);
|
|
|
|
#
|
|
# Everything we're willing to export, we must first import.
|
|
#
|
|
IO::Handle->import( 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;
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# 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);
|
|
};
|
|
}
|
|
|
|
################################################
|
|
# This is the only exported function we define;
|
|
# the rest come from other classes.
|
|
#
|
|
|
|
sub pipe {
|
|
my $r = IO::Handle->new;
|
|
my $w = IO::Handle->new;
|
|
CORE::pipe($r, $w) or return undef;
|
|
($r, $w);
|
|
}
|
|
|
|
# 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__
|
|
|