Commit | Line | Data |
64d0c973 |
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; |
3cb6de81 |
11 | |
64d0c973 |
12 | @ISA = (Tie::Scalar); |
3cb6de81 |
13 | |
64d0c973 |
14 | sub FETCH { ... } # Provide a needed method |
15 | sub TIESCALAR { ... } # Overrides inherited method |
3cb6de81 |
16 | |
17 | |
64d0c973 |
18 | package NewStdScalar; |
19 | require Tie::Scalar; |
3cb6de81 |
20 | |
64d0c973 |
21 | @ISA = (Tie::StdScalar); |
3cb6de81 |
22 | |
64d0c973 |
23 | # All methods provided by default, so define only what needs be overridden |
24 | sub FETCH { ... } |
3cb6de81 |
25 | |
26 | |
64d0c973 |
27 | package main; |
3cb6de81 |
28 | |
c954a603 |
29 | tie $new_scalar, 'NewScalar'; |
30 | tie $new_std_scalar, 'NewStdScalar'; |
64d0c973 |
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; |
d3a7d8c7 |
82 | use warnings::register; |
64d0c973 |
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"}) { |
d3a7d8c7 |
94 | warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing" |
95 | if warnings::enabled(); |
64d0c973 |
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; |