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