Commit | Line | Data |
64d0c973 |
1 | package Tie::Scalar; |
2 | |
b75c8c73 |
3 | our $VERSION = '1.00'; |
4 | |
64d0c973 |
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; |
3cb6de81 |
13 | |
abc0156b |
14 | @ISA = qw(Tie::Scalar); |
3cb6de81 |
15 | |
64d0c973 |
16 | sub FETCH { ... } # Provide a needed method |
17 | sub TIESCALAR { ... } # Overrides inherited method |
3cb6de81 |
18 | |
19 | |
64d0c973 |
20 | package NewStdScalar; |
21 | require Tie::Scalar; |
3cb6de81 |
22 | |
abc0156b |
23 | @ISA = qw(Tie::StdScalar); |
3cb6de81 |
24 | |
64d0c973 |
25 | # All methods provided by default, so define only what needs be overridden |
26 | sub FETCH { ... } |
3cb6de81 |
27 | |
28 | |
64d0c973 |
29 | package main; |
3cb6de81 |
30 | |
c954a603 |
31 | tie $new_scalar, 'NewScalar'; |
32 | tie $new_std_scalar, 'NewStdScalar'; |
64d0c973 |
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 | |
bbc7dcd2 |
50 | =over 4 |
64d0c973 |
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; |
d3a7d8c7 |
84 | use warnings::register; |
64d0c973 |
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; |
c6c73c78 |
95 | if ($pkg->can('new') and $pkg ne __PACKAGE__) { |
7e6d00f8 |
96 | warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"); |
64d0c973 |
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; |
abc0156b |
120 | @ISA = qw(Tie::Scalar); |
64d0c973 |
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; |