"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Tie/StdHandle.pm" (10 Mar 2019, 1378 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package Tie::StdHandle; 
    2 
    3 use strict;
    4 
    5 use Tie::Handle;
    6 our @ISA = 'Tie::Handle';
    7 our $VERSION = '4.5';
    8 
    9 =head1 NAME
   10 
   11 Tie::StdHandle - base class definitions for tied handles
   12 
   13 =head1 SYNOPSIS
   14 
   15     package NewHandle;
   16     require Tie::Handle;
   17 
   18     @ISA = qw(Tie::Handle);
   19 
   20     sub READ { ... }        # Provide a needed method
   21     sub TIEHANDLE { ... }   # Overrides inherited method
   22 
   23 
   24     package main;
   25 
   26     tie *FH, 'NewHandle';
   27 
   28 =head1 DESCRIPTION
   29 
   30 The B<Tie::StdHandle> package provide most methods for file handles described
   31 in L<perltie> (the exceptions are C<UNTIE> and C<DESTROY>).  It causes tied
   32 file handles to behave exactly like standard file handles and allow for
   33 selective overwriting of methods.
   34 
   35 =cut
   36 
   37 sub TIEHANDLE 
   38 {
   39  my $class = shift;
   40  my $fh    = \do { local *HANDLE};
   41  bless $fh,$class;
   42  $fh->OPEN(@_) if (@_);
   43  return $fh;
   44 }
   45 
   46 sub EOF     { eof($_[0]) }
   47 sub TELL    { tell($_[0]) }
   48 sub FILENO  { fileno($_[0]) }
   49 sub SEEK    { seek($_[0],$_[1],$_[2]) }
   50 sub CLOSE   { close($_[0]) }
   51 sub BINMODE { binmode($_[0]) }
   52 
   53 sub OPEN
   54 {
   55  $_[0]->CLOSE if defined($_[0]->FILENO);
   56  @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]);
   57 }
   58 
   59 sub READ     { &CORE::read(shift, \shift, @_) }
   60 sub READLINE { my $fh = $_[0]; <$fh> }
   61 sub GETC     { getc($_[0]) }
   62 
   63 sub WRITE
   64 {
   65  my $fh = $_[0];
   66  local $\; # don't print any line terminator
   67  print $fh substr($_[1], $_[3], $_[2]);
   68 }
   69 
   70 
   71 1;