Commit | Line | Data |
---|---|---|
6269bcb3 MS |
1 | package Tie::StdHandle; |
2 | ||
d10ced8a NC |
3 | use strict; |
4 | ||
6269bcb3 | 5 | use Tie::Handle; |
d10ced8a NC |
6 | use vars qw(@ISA $VERSION); |
7 | @ISA = 'Tie::Handle'; | |
c033ac4e | 8 | $VERSION = '4.3'; |
d10ced8a NC |
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 MS |
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; |