home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / lib / Tie / Scalar.pm < prev    next >
Text File  |  2000-03-12  |  3KB  |  140 lines

  1. package Tie::Scalar;
  2.  
  3. =head1 NAME
  4.  
  5. Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     package NewScalar;
  10.     require Tie::Scalar;
  11.  
  12.     @ISA = (Tie::Scalar);
  13.  
  14.     sub FETCH { ... }        # Provide a needed method
  15.     sub TIESCALAR { ... }    # Overrides inherited method
  16.  
  17.  
  18.     package NewStdScalar;
  19.     require Tie::Scalar;
  20.  
  21.     @ISA = (Tie::StdScalar);
  22.  
  23.     # All methods provided by default, so define only what needs be overridden
  24.     sub FETCH { ... }
  25.  
  26.  
  27.     package main;
  28.  
  29.     tie $new_scalar, 'NewScalar';
  30.     tie $new_std_scalar, 'NewStdScalar';
  31.  
  32. =head1 DESCRIPTION
  33.  
  34. This module provides some skeletal methods for scalar-tying classes. See
  35. L<perltie> for a list of the functions required in tying a scalar to a
  36. package. The basic B<Tie::Scalar> package provides a C<new> method, as well
  37. as methods C<TIESCALAR>, C<FETCH> and C<STORE>. The B<Tie::StdScalar>
  38. package provides all the methods specified in  L<perltie>. It inherits from
  39. B<Tie::Scalar> and causes scalars tied to it to behave exactly like the
  40. built-in scalars, allowing for selective overloading of methods. The C<new>
  41. method is provided as a means of grandfathering, for classes that forget to
  42. provide their own C<TIESCALAR> method.
  43.  
  44. For developers wishing to write their own tied-scalar classes, the methods
  45. are summarized below. The L<perltie> section not only documents these, but
  46. has sample code as well:
  47.  
  48. =over
  49.  
  50. =item TIESCALAR classname, LIST
  51.  
  52. The method invoked by the command C<tie $scalar, classname>. Associates a new
  53. scalar instance with the specified class. C<LIST> would represent additional
  54. arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
  55. complete the association.
  56.  
  57. =item FETCH this
  58.  
  59. Retrieve the value of the tied scalar referenced by I<this>.
  60.  
  61. =item STORE this, value
  62.  
  63. Store data I<value> in the tied scalar referenced by I<this>.
  64.  
  65. =item DESTROY this
  66.  
  67. Free the storage associated with the tied scalar referenced by I<this>.
  68. This is rarely needed, as Perl manages its memory quite well. But the
  69. option exists, should a class wish to perform specific actions upon the
  70. destruction of an instance.
  71.  
  72. =back
  73.  
  74. =head1 MORE INFORMATION
  75.  
  76. The L<perltie> section uses a good example of tying scalars by associating
  77. process IDs with priority.
  78.  
  79. =cut
  80.  
  81. use Carp;
  82. use warnings::register;
  83.  
  84. sub new {
  85.     my $pkg = shift;
  86.     $pkg->TIESCALAR(@_);
  87. }
  88.  
  89. # "Grandfather" the new, a la Tie::Hash
  90.  
  91. sub TIESCALAR {
  92.     my $pkg = shift;
  93.     if (defined &{"{$pkg}::new"}) {
  94.     warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"
  95.         if warnings::enabled();
  96.     $pkg->new(@_);
  97.     }
  98.     else {
  99.     croak "$pkg doesn't define a TIESCALAR method";
  100.     }
  101. }
  102.  
  103. sub FETCH {
  104.     my $pkg = ref $_[0];
  105.     croak "$pkg doesn't define a FETCH method";
  106. }
  107.  
  108. sub STORE {
  109.     my $pkg = ref $_[0];
  110.     croak "$pkg doesn't define a STORE method";
  111. }
  112.  
  113. #
  114. # The Tie::StdScalar package provides scalars that behave exactly like
  115. # Perl's built-in scalars. Good base to inherit from, if you're only going to
  116. # tweak a small bit.
  117. #
  118. package Tie::StdScalar;
  119. @ISA = (Tie::Scalar);
  120.  
  121. sub TIESCALAR {
  122.     my $class = shift;
  123.     my $instance = shift || undef;
  124.     return bless \$instance => $class;
  125. }
  126.  
  127. sub FETCH {
  128.     return ${$_[0]};
  129. }
  130.  
  131. sub STORE {
  132.     ${$_[0]} = $_[1];
  133. }
  134.  
  135. sub DESTROY {
  136.     undef ${$_[0]};
  137. }
  138.  
  139. 1;
  140.