Commit | Line | Data |
---|---|---|
920dae64 AT |
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; |