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