home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / OpenLinux 2.3 CD.iso / live / usr / lib / perl5 / 5.00502 / Tie / Handle.pm < prev    next >
Encoding:
Perl POD Document  |  1999-08-11  |  3.4 KB  |  162 lines
  1. package Tie::Handle;
  2.  
  3. =head1 NAME
  4.  
  5. Tie::Handle - base class definitions for tied handles
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     package NewHandle;
  10.     require Tie::Handle;
  11.      
  12.     @ISA = (Tie::Handle);
  13.      
  14.     sub READ { ... }        # Provide a needed method
  15.     sub TIEHANDLE { ... }    # Overrides inherited method
  16.          
  17.      
  18.     package main;
  19.     
  20.     tie *FH, 'NewHandle';
  21.  
  22. =head1 DESCRIPTION
  23.  
  24. This module provides some skeletal methods for handle-tying classes. See
  25. L<perltie> for a list of the functions required in tying a handle to a package.
  26. The basic B<Tie::Handle> package provides a C<new> method, as well as methods
  27. C<TIESCALAR>, C<FETCH> and C<STORE>. The C<new> method is provided as a means
  28. of grandfathering, for classes that forget to provide their own C<TIESCALAR>
  29. method.
  30.  
  31. For developers wishing to write their own tied-handle classes, the methods
  32. are summarized below. The L<perltie> section not only documents these, but
  33. has sample code as well:
  34.  
  35. =over
  36.  
  37. =item TIEHANDLE classname, LIST
  38.  
  39. The method invoked by the command C<tie *glob, classname>. Associates a new
  40. glob instance with the specified class. C<LIST> would represent additional
  41. arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
  42. complete the association.
  43.  
  44. =item WRITE this, scalar, length, offset
  45.  
  46. Write I<length> bytes of data from I<scalar> starting at I<offset>.
  47.  
  48. =item PRINT this, LIST
  49.  
  50. Print the values in I<LIST>
  51.  
  52. =item PRINTF this, format, LIST
  53.  
  54. Print the values in I<LIST> using I<format>
  55.  
  56. =item READ this, scalar, length, offset
  57.  
  58. Read I<length> bytes of data into I<scalar> starting at I<offset>.
  59.  
  60. =item READLINE this
  61.  
  62. Read a single line
  63.  
  64. =item GETC this
  65.  
  66. Get a single character
  67.  
  68. =item DESTROY this
  69.  
  70. Free the storage associated with the tied handle referenced by I<this>.
  71. This is rarely needed, as Perl manages its memory quite well. But the
  72. option exists, should a class wish to perform specific actions upon the
  73. destruction of an instance.
  74.  
  75. =back
  76.  
  77. =head1 MORE INFORMATION
  78.  
  79. The L<perltie> section contains an example of tying handles.
  80.  
  81. =cut
  82.  
  83. use Carp;
  84.  
  85. sub new {
  86.     my $pkg = shift;
  87.     $pkg->TIEHANDLE(@_);
  88. }
  89.  
  90. # "Grandfather" the new, a la Tie::Hash
  91.  
  92. sub TIEHANDLE {
  93.     my $pkg = shift;
  94.     if (defined &{"{$pkg}::new"}) {
  95.     carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
  96.         if $^W;
  97.     $pkg->new(@_);
  98.     }
  99.     else {
  100.     croak "$pkg doesn't define a TIEHANDLE method";
  101.     }
  102. }
  103.  
  104. sub PRINT {
  105.     my $self = shift;
  106.     if($self->can('WRITE') != \&WRITE) {
  107.     my $buf = join(defined $, ? $, : "",@_);
  108.     $buf .= $\ if defined $\;
  109.     $self->WRITE($buf,length($buf),0);
  110.     }
  111.     else {
  112.     croak ref($self)," doesn't define a PRINT method";
  113.     }
  114. }
  115.  
  116. sub PRINTF {
  117.     my $self = shift;
  118.     
  119.     if($self->can('WRITE') != \&WRITE) {
  120.     my $buf = sprintf(@_);
  121.     $self->WRITE($buf,length($buf),0);
  122.     }
  123.     else {
  124.     croak ref($self)," doesn't define a PRINTF method";
  125.     }
  126. }
  127.  
  128. sub READLINE {
  129.     my $pkg = ref $_[0];
  130.     croak "$pkg doesn't define a READLINE method";
  131. }
  132.  
  133. sub GETC {
  134.     my $self = shift;
  135.     
  136.     if($self->can('READ') != \&READ) {
  137.     my $buf;
  138.     $self->READ($buf,1);
  139.     return $buf;
  140.     }
  141.     else {
  142.     croak ref($self)," doesn't define a GETC method";
  143.     }
  144. }
  145.  
  146. sub READ {
  147.     my $pkg = ref $_[0];
  148.     croak "$pkg doesn't define a READ method";
  149. }
  150.  
  151. sub WRITE {
  152.     my $pkg = ref $_[0];
  153.     croak "$pkg doesn't define a WRITE method";
  154. }
  155.  
  156. sub CLOSE {
  157.     my $pkg = ref $_[0];
  158.     croak "$pkg doesn't define a CLOSE method";
  159. }
  160.  
  161. 1;
  162.