summaryrefslogtreecommitdiff
path: root/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm
diff options
context:
space:
mode:
Diffstat (limited to 'beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm')
-rw-r--r--beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm376
1 files changed, 0 insertions, 376 deletions
diff --git a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm b/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm
deleted file mode 100644
index 140e793..0000000
--- a/beagle/debian-rfs/usr/lib/perl/5.10.1/IO/Handle.pm
+++ /dev/null
@@ -1,376 +0,0 @@
-package IO::Handle;
-
-use 5.006_001;
-use strict;
-our($VERSION, @EXPORT_OK, @ISA);
-use Carp;
-use Symbol;
-use SelectSaver;
-use IO (); # Load the XS module
-
-require Exporter;
-@ISA = qw(Exporter);
-
-$VERSION = "1.28";
-$VERSION = eval $VERSION;
-
-@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
- format_write
-
- print
- printf
- say
- getline
- getlines
-
- printflush
- flush
-
- SEEK_SET
- SEEK_CUR
- SEEK_END
- _IOFBF
- _IOLBF
- _IONBF
-);
-
-################################################
-## Constructors, destructors.
-##
-
-sub new {
- my $class = ref($_[0]) || $_[0] || "IO::Handle";
- @_ == 1 or croak "usage: new $class";
- my $io = gensym;
- bless $io, $class;
-}
-
-sub new_from_fd {
- my $class = ref($_[0]) || $_[0] || "IO::Handle";
- @_ == 3 or croak "usage: new_from_fd $class FD, MODE";
- my $io = gensym;
- shift;
- IO::Handle::fdopen($io, @_)
- or return undef;
- bless $io, $class;
-}
-
-#
-# There is no need for DESTROY to do anything, because when the
-# last reference to an IO object is gone, Perl automatically
-# closes its associated files (if any). However, to avoid any
-# attempts to autoload DESTROY, we here define it to do nothing.
-#
-sub DESTROY {}
-
-################################################
-## Open and close.
-##
-
-sub _open_mode_string {
- my ($mode) = @_;
- $mode =~ /^\+?(<|>>?)$/
- or $mode =~ s/^r(\+?)$/$1</
- or $mode =~ s/^w(\+?)$/$1>/
- or $mode =~ s/^a(\+?)$/$1>>/
- or croak "IO::Handle: bad open mode: $mode";
- $mode;
-}
-
-sub fdopen {
- @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
- my ($io, $fd, $mode) = @_;
- local(*GLOB);
-
- if (ref($fd) && "".$fd =~ /GLOB\(/o) {
- # It's a glob reference; Alias it as we cannot get name of anon GLOBs
- my $n = qualify(*GLOB);
- *GLOB = *{*$fd};
- $fd = $n;
- } elsif ($fd =~ m#^\d+$#) {
- # It's an FD number; prefix with "=".
- $fd = "=$fd";
- }
-
- open($io, _open_mode_string($mode) . '&' . $fd)
- ? $io : undef;
-}
-
-sub close {
- @_ == 1 or croak 'usage: $io->close()';
- my($io) = @_;
-
- close($io);
-}
-
-################################################
-## Normal I/O functions.
-##
-
-# flock
-# select
-
-sub opened {
- @_ == 1 or croak 'usage: $io->opened()';
- defined fileno($_[0]);
-}
-
-sub fileno {
- @_ == 1 or croak 'usage: $io->fileno()';
- fileno($_[0]);
-}
-
-sub getc {
- @_ == 1 or croak 'usage: $io->getc()';
- getc($_[0]);
-}
-
-sub eof {
- @_ == 1 or croak 'usage: $io->eof()';
- eof($_[0]);
-}
-
-sub print {
- @_ or croak 'usage: $io->print(ARGS)';
- my $this = shift;
- print $this @_;
-}
-
-sub printf {
- @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
- my $this = shift;
- printf $this @_;
-}
-
-sub say {
- @_ or croak 'usage: $io->say(ARGS)';
- my $this = shift;
- local $\ = "\n";
- print $this @_;
-}
-
-sub getline {
- @_ == 1 or croak 'usage: $io->getline()';
- my $this = shift;
- return scalar <$this>;
-}
-
-*gets = \&getline; # deprecated
-
-sub getlines {
- @_ == 1 or croak 'usage: $io->getlines()';
- wantarray or
- croak 'Can\'t call $io->getlines in a scalar context, use $io->getline';
- my $this = shift;
- return <$this>;
-}
-
-sub truncate {
- @_ == 2 or croak 'usage: $io->truncate(LEN)';
- truncate($_[0], $_[1]);
-}
-
-sub read {
- @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
- read($_[0], $_[1], $_[2], $_[3] || 0);
-}
-
-sub sysread {
- @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
- sysread($_[0], $_[1], $_[2], $_[3] || 0);
-}
-
-sub write {
- @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])';
- local($\) = "";
- $_[2] = length($_[1]) unless defined $_[2];
- print { $_[0] } substr($_[1], $_[3] || 0, $_[2]);
-}
-
-sub syswrite {
- @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
- if (defined($_[2])) {
- syswrite($_[0], $_[1], $_[2], $_[3] || 0);
- } else {
- syswrite($_[0], $_[1]);
- }
-}
-
-sub stat {
- @_ == 1 or croak 'usage: $io->stat()';
- stat($_[0]);
-}
-
-################################################
-## State modification functions.
-##
-
-sub autoflush {
- my $old = new SelectSaver qualify($_[0], caller);
- my $prev = $|;
- $| = @_ > 1 ? $_[1] : 1;
- $prev;
-}
-
-sub output_field_separator {
- carp "output_field_separator is not supported on a per-handle basis"
- if ref($_[0]);
- my $prev = $,;
- $, = $_[1] if @_ > 1;
- $prev;
-}
-
-sub output_record_separator {
- carp "output_record_separator is not supported on a per-handle basis"
- if ref($_[0]);
- my $prev = $\;
- $\ = $_[1] if @_ > 1;
- $prev;
-}
-
-sub input_record_separator {
- carp "input_record_separator is not supported on a per-handle basis"
- if ref($_[0]);
- my $prev = $/;
- $/ = $_[1] if @_ > 1;
- $prev;
-}
-
-sub input_line_number {
- local $.;
- () = tell qualify($_[0], caller) if ref($_[0]);
- my $prev = $.;
- $. = $_[1] if @_ > 1;
- $prev;
-}
-
-sub format_page_number {
- my $old;
- $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
- my $prev = $%;
- $% = $_[1] if @_ > 1;
- $prev;
-}
-
-sub format_lines_per_page {
- my $old;
- $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
- my $prev = $=;
- $= = $_[1] if @_ > 1;
- $prev;
-}
-
-sub format_lines_left {
- my $old;
- $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
- my $prev = $-;
- $- = $_[1] if @_ > 1;
- $prev;
-}
-
-sub format_name {
- my $old;
- $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
- my $prev = $~;
- $~ = qualify($_[1], caller) if @_ > 1;
- $prev;
-}
-
-sub format_top_name {
- my $old;
- $old = new SelectSaver qualify($_[0], caller) if ref($_[0]);
- my $prev = $^;
- $^ = qualify($_[1], caller) if @_ > 1;
- $prev;
-}
-
-sub format_line_break_characters {
- carp "format_line_break_characters is not supported on a per-handle basis"
- if ref($_[0]);
- my $prev = $:;
- $: = $_[1] if @_ > 1;
- $prev;
-}
-
-sub format_formfeed {
- carp "format_formfeed is not supported on a per-handle basis"
- if ref($_[0]);
- my $prev = $^L;
- $^L = $_[1] if @_ > 1;
- $prev;
-}
-
-sub formline {
- my $io = shift;
- my $picture = shift;
- local($^A) = $^A;
- local($\) = "";
- formline($picture, @_);
- print $io $^A;
-}
-
-sub format_write {
- @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )';
- if (@_ == 2) {
- my ($io, $fmt) = @_;
- my $oldfmt = $io->format_name(qualify($fmt,caller));
- CORE::write($io);
- $io->format_name($oldfmt);
- } else {
- CORE::write($_[0]);
- }
-}
-
-sub fcntl {
- @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
- my ($io, $op) = @_;
- return fcntl($io, $op, $_[2]);
-}
-
-sub ioctl {
- @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );';
- my ($io, $op) = @_;
- return ioctl($io, $op, $_[2]);
-}
-
-# this sub is for compatability with older releases of IO that used
-# a sub called constant to detemine if a constant existed -- GMB
-#
-# The SEEK_* and _IO?BF constants were the only constants at that time
-# any new code should just chech defined(&CONSTANT_NAME)
-
-sub constant {
- no strict 'refs';
- my $name = shift;
- (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name})
- ? &{$name}() : undef;
-}
-
-# so that flush.pl can be deprecated
-
-sub printflush {
- my $io = shift;
- my $old;
- $old = new SelectSaver qualify($io, caller) if ref($io);
- local $| = 1;
- if(ref($io)) {
- print $io @_;
- }
- else {
- print @_;
- }
-}
-
-1;
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-17 22:56:37 +0000