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