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