xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Tie/Handle.pm (revision 0:68f95e015346)
1*0Sstevel@tonic-gatepackage Tie::Handle;
2*0Sstevel@tonic-gate
3*0Sstevel@tonic-gateuse 5.006_001;
4*0Sstevel@tonic-gateour $VERSION = '4.1';
5*0Sstevel@tonic-gate
6*0Sstevel@tonic-gate=head1 NAME
7*0Sstevel@tonic-gate
8*0Sstevel@tonic-gateTie::Handle, Tie::StdHandle  - base class definitions for tied handles
9*0Sstevel@tonic-gate
10*0Sstevel@tonic-gate=head1 SYNOPSIS
11*0Sstevel@tonic-gate
12*0Sstevel@tonic-gate    package NewHandle;
13*0Sstevel@tonic-gate    require Tie::Handle;
14*0Sstevel@tonic-gate
15*0Sstevel@tonic-gate    @ISA = qw(Tie::Handle);
16*0Sstevel@tonic-gate
17*0Sstevel@tonic-gate    sub READ { ... }		# Provide a needed method
18*0Sstevel@tonic-gate    sub TIEHANDLE { ... }	# Overrides inherited method
19*0Sstevel@tonic-gate
20*0Sstevel@tonic-gate
21*0Sstevel@tonic-gate    package main;
22*0Sstevel@tonic-gate
23*0Sstevel@tonic-gate    tie *FH, 'NewHandle';
24*0Sstevel@tonic-gate
25*0Sstevel@tonic-gate=head1 DESCRIPTION
26*0Sstevel@tonic-gate
27*0Sstevel@tonic-gateThis module provides some skeletal methods for handle-tying classes. See
28*0Sstevel@tonic-gateL<perltie> for a list of the functions required in tying a handle to a package.
29*0Sstevel@tonic-gateThe basic B<Tie::Handle> package provides a C<new> method, as well as methods
30*0Sstevel@tonic-gateC<TIEHANDLE>, C<PRINT>, C<PRINTF> and C<GETC>.
31*0Sstevel@tonic-gate
32*0Sstevel@tonic-gateFor developers wishing to write their own tied-handle classes, the methods
33*0Sstevel@tonic-gateare summarized below. The L<perltie> section not only documents these, but
34*0Sstevel@tonic-gatehas sample code as well:
35*0Sstevel@tonic-gate
36*0Sstevel@tonic-gate=over 4
37*0Sstevel@tonic-gate
38*0Sstevel@tonic-gate=item TIEHANDLE classname, LIST
39*0Sstevel@tonic-gate
40*0Sstevel@tonic-gateThe method invoked by the command C<tie *glob, classname>. Associates a new
41*0Sstevel@tonic-gateglob instance with the specified class. C<LIST> would represent additional
42*0Sstevel@tonic-gatearguments (along the lines of L<AnyDBM_File> and compatriots) needed to
43*0Sstevel@tonic-gatecomplete the association.
44*0Sstevel@tonic-gate
45*0Sstevel@tonic-gate=item WRITE this, scalar, length, offset
46*0Sstevel@tonic-gate
47*0Sstevel@tonic-gateWrite I<length> bytes of data from I<scalar> starting at I<offset>.
48*0Sstevel@tonic-gate
49*0Sstevel@tonic-gate=item PRINT this, LIST
50*0Sstevel@tonic-gate
51*0Sstevel@tonic-gatePrint the values in I<LIST>
52*0Sstevel@tonic-gate
53*0Sstevel@tonic-gate=item PRINTF this, format, LIST
54*0Sstevel@tonic-gate
55*0Sstevel@tonic-gatePrint the values in I<LIST> using I<format>
56*0Sstevel@tonic-gate
57*0Sstevel@tonic-gate=item READ this, scalar, length, offset
58*0Sstevel@tonic-gate
59*0Sstevel@tonic-gateRead I<length> bytes of data into I<scalar> starting at I<offset>.
60*0Sstevel@tonic-gate
61*0Sstevel@tonic-gate=item READLINE this
62*0Sstevel@tonic-gate
63*0Sstevel@tonic-gateRead a single line
64*0Sstevel@tonic-gate
65*0Sstevel@tonic-gate=item GETC this
66*0Sstevel@tonic-gate
67*0Sstevel@tonic-gateGet a single character
68*0Sstevel@tonic-gate
69*0Sstevel@tonic-gate=item CLOSE this
70*0Sstevel@tonic-gate
71*0Sstevel@tonic-gateClose the handle
72*0Sstevel@tonic-gate
73*0Sstevel@tonic-gate=item OPEN this, filename
74*0Sstevel@tonic-gate
75*0Sstevel@tonic-gate(Re-)open the handle
76*0Sstevel@tonic-gate
77*0Sstevel@tonic-gate=item BINMODE this
78*0Sstevel@tonic-gate
79*0Sstevel@tonic-gateSpecify content is binary
80*0Sstevel@tonic-gate
81*0Sstevel@tonic-gate=item EOF this
82*0Sstevel@tonic-gate
83*0Sstevel@tonic-gateTest for end of file.
84*0Sstevel@tonic-gate
85*0Sstevel@tonic-gate=item TELL this
86*0Sstevel@tonic-gate
87*0Sstevel@tonic-gateReturn position in the file.
88*0Sstevel@tonic-gate
89*0Sstevel@tonic-gate=item SEEK this, offset, whence
90*0Sstevel@tonic-gate
91*0Sstevel@tonic-gatePosition the file.
92*0Sstevel@tonic-gate
93*0Sstevel@tonic-gateTest for end of file.
94*0Sstevel@tonic-gate
95*0Sstevel@tonic-gate=item DESTROY this
96*0Sstevel@tonic-gate
97*0Sstevel@tonic-gateFree the storage associated with the tied handle referenced by I<this>.
98*0Sstevel@tonic-gateThis is rarely needed, as Perl manages its memory quite well. But the
99*0Sstevel@tonic-gateoption exists, should a class wish to perform specific actions upon the
100*0Sstevel@tonic-gatedestruction of an instance.
101*0Sstevel@tonic-gate
102*0Sstevel@tonic-gate=back
103*0Sstevel@tonic-gate
104*0Sstevel@tonic-gate=head1 MORE INFORMATION
105*0Sstevel@tonic-gate
106*0Sstevel@tonic-gateThe L<perltie> section contains an example of tying handles.
107*0Sstevel@tonic-gate
108*0Sstevel@tonic-gate=head1 COMPATIBILITY
109*0Sstevel@tonic-gate
110*0Sstevel@tonic-gateThis version of Tie::Handle is neither related to nor compatible with
111*0Sstevel@tonic-gatethe Tie::Handle (3.0) module available on CPAN. It was due to an
112*0Sstevel@tonic-gateaccident that two modules with the same name appeared. The namespace
113*0Sstevel@tonic-gateclash has been cleared in favor of this module that comes with the
114*0Sstevel@tonic-gateperl core in September 2000 and accordingly the version number has
115*0Sstevel@tonic-gatebeen bumped up to 4.0.
116*0Sstevel@tonic-gate
117*0Sstevel@tonic-gate=cut
118*0Sstevel@tonic-gate
119*0Sstevel@tonic-gateuse Carp;
120*0Sstevel@tonic-gateuse warnings::register;
121*0Sstevel@tonic-gate
122*0Sstevel@tonic-gatesub new {
123*0Sstevel@tonic-gate    my $pkg = shift;
124*0Sstevel@tonic-gate    $pkg->TIEHANDLE(@_);
125*0Sstevel@tonic-gate}
126*0Sstevel@tonic-gate
127*0Sstevel@tonic-gate# "Grandfather" the new, a la Tie::Hash
128*0Sstevel@tonic-gate
129*0Sstevel@tonic-gatesub TIEHANDLE {
130*0Sstevel@tonic-gate    my $pkg = shift;
131*0Sstevel@tonic-gate    if (defined &{"{$pkg}::new"}) {
132*0Sstevel@tonic-gate	warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing");
133*0Sstevel@tonic-gate	$pkg->new(@_);
134*0Sstevel@tonic-gate    }
135*0Sstevel@tonic-gate    else {
136*0Sstevel@tonic-gate	croak "$pkg doesn't define a TIEHANDLE method";
137*0Sstevel@tonic-gate    }
138*0Sstevel@tonic-gate}
139*0Sstevel@tonic-gate
140*0Sstevel@tonic-gatesub PRINT {
141*0Sstevel@tonic-gate    my $self = shift;
142*0Sstevel@tonic-gate    if($self->can('WRITE') != \&WRITE) {
143*0Sstevel@tonic-gate	my $buf = join(defined $, ? $, : "",@_);
144*0Sstevel@tonic-gate	$buf .= $\ if defined $\;
145*0Sstevel@tonic-gate	$self->WRITE($buf,length($buf),0);
146*0Sstevel@tonic-gate    }
147*0Sstevel@tonic-gate    else {
148*0Sstevel@tonic-gate	croak ref($self)," doesn't define a PRINT method";
149*0Sstevel@tonic-gate    }
150*0Sstevel@tonic-gate}
151*0Sstevel@tonic-gate
152*0Sstevel@tonic-gatesub PRINTF {
153*0Sstevel@tonic-gate    my $self = shift;
154*0Sstevel@tonic-gate
155*0Sstevel@tonic-gate    if($self->can('WRITE') != \&WRITE) {
156*0Sstevel@tonic-gate	my $buf = sprintf(shift,@_);
157*0Sstevel@tonic-gate	$self->WRITE($buf,length($buf),0);
158*0Sstevel@tonic-gate    }
159*0Sstevel@tonic-gate    else {
160*0Sstevel@tonic-gate	croak ref($self)," doesn't define a PRINTF method";
161*0Sstevel@tonic-gate    }
162*0Sstevel@tonic-gate}
163*0Sstevel@tonic-gate
164*0Sstevel@tonic-gatesub READLINE {
165*0Sstevel@tonic-gate    my $pkg = ref $_[0];
166*0Sstevel@tonic-gate    croak "$pkg doesn't define a READLINE method";
167*0Sstevel@tonic-gate}
168*0Sstevel@tonic-gate
169*0Sstevel@tonic-gatesub GETC {
170*0Sstevel@tonic-gate    my $self = shift;
171*0Sstevel@tonic-gate
172*0Sstevel@tonic-gate    if($self->can('READ') != \&READ) {
173*0Sstevel@tonic-gate	my $buf;
174*0Sstevel@tonic-gate	$self->READ($buf,1);
175*0Sstevel@tonic-gate	return $buf;
176*0Sstevel@tonic-gate    }
177*0Sstevel@tonic-gate    else {
178*0Sstevel@tonic-gate	croak ref($self)," doesn't define a GETC method";
179*0Sstevel@tonic-gate    }
180*0Sstevel@tonic-gate}
181*0Sstevel@tonic-gate
182*0Sstevel@tonic-gatesub READ {
183*0Sstevel@tonic-gate    my $pkg = ref $_[0];
184*0Sstevel@tonic-gate    croak "$pkg doesn't define a READ method";
185*0Sstevel@tonic-gate}
186*0Sstevel@tonic-gate
187*0Sstevel@tonic-gatesub WRITE {
188*0Sstevel@tonic-gate    my $pkg = ref $_[0];
189*0Sstevel@tonic-gate    croak "$pkg doesn't define a WRITE method";
190*0Sstevel@tonic-gate}
191*0Sstevel@tonic-gate
192*0Sstevel@tonic-gatesub CLOSE {
193*0Sstevel@tonic-gate    my $pkg = ref $_[0];
194*0Sstevel@tonic-gate    croak "$pkg doesn't define a CLOSE method";
195*0Sstevel@tonic-gate}
196*0Sstevel@tonic-gate
197*0Sstevel@tonic-gatepackage Tie::StdHandle;
198*0Sstevel@tonic-gateour @ISA = 'Tie::Handle';
199*0Sstevel@tonic-gateuse Carp;
200*0Sstevel@tonic-gate
201*0Sstevel@tonic-gatesub TIEHANDLE
202*0Sstevel@tonic-gate{
203*0Sstevel@tonic-gate my $class = shift;
204*0Sstevel@tonic-gate my $fh    = \do { local *HANDLE};
205*0Sstevel@tonic-gate bless $fh,$class;
206*0Sstevel@tonic-gate $fh->OPEN(@_) if (@_);
207*0Sstevel@tonic-gate return $fh;
208*0Sstevel@tonic-gate}
209*0Sstevel@tonic-gate
210*0Sstevel@tonic-gatesub EOF     { eof($_[0]) }
211*0Sstevel@tonic-gatesub TELL    { tell($_[0]) }
212*0Sstevel@tonic-gatesub FILENO  { fileno($_[0]) }
213*0Sstevel@tonic-gatesub SEEK    { seek($_[0],$_[1],$_[2]) }
214*0Sstevel@tonic-gatesub CLOSE   { close($_[0]) }
215*0Sstevel@tonic-gatesub BINMODE { binmode($_[0]) }
216*0Sstevel@tonic-gate
217*0Sstevel@tonic-gatesub OPEN
218*0Sstevel@tonic-gate{
219*0Sstevel@tonic-gate $_[0]->CLOSE if defined($_[0]->FILENO);
220*0Sstevel@tonic-gate @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]);
221*0Sstevel@tonic-gate}
222*0Sstevel@tonic-gate
223*0Sstevel@tonic-gatesub READ     { read($_[0],$_[1],$_[2]) }
224*0Sstevel@tonic-gatesub READLINE { my $fh = $_[0]; <$fh> }
225*0Sstevel@tonic-gatesub GETC     { getc($_[0]) }
226*0Sstevel@tonic-gate
227*0Sstevel@tonic-gatesub WRITE
228*0Sstevel@tonic-gate{
229*0Sstevel@tonic-gate my $fh = $_[0];
230*0Sstevel@tonic-gate print $fh substr($_[1],0,$_[2])
231*0Sstevel@tonic-gate}
232*0Sstevel@tonic-gate
233*0Sstevel@tonic-gate
234*0Sstevel@tonic-gate1;
235