1: <code>package Tie::Scalar::Symlink;
2: # Copyright (C) 2001 Drake Wilson <premchai21 {at} bigfoot.com>
3: #
4: # This module is free software; you may redistribute and/or
5: # modify it under the terms of the GNU General Public License
6: # as published by the Free Software Foundation, either version
7: # 2 of the License or (at your option) any later version.
8: #
9: # This module is distributed in the hope that it will be useful,
10: # but WITHOUT ANY WARRANTY, without even the implied warranty
11: # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See
12: # the GNU General Public License for more details.
13: #
14: # You should have received a copy of the GNU General Public License
15: # along with this module; if not, write to the Free Software
16: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
17: # USA.
18:
19: use strict;
20: use warnings;
21: use Carp;
22: use vars qw($VERSION @ISA);
23:
24: $VERSION = 0.01;
25: @ISA = qw//;
26:
27: sub TIESCALAR
28: {
29: my ($class, $r) = @_;
30: (ref($r) eq 'SCALAR')
31: || croak 'Argument must be an unblessed reference to a scalar';
32: return bless \$r, $class;
33: }
34:
35: sub FETCH { $ {$ {$_[0]}} }
36: sub STORE { $ {$ {$_[0]}} = $_[1] }
37: sub DESTROY { undef $ {$_[0]} }
38:
39: =head1 NAME
40:
41: Tie::Scalar::Symlink
42:
43: =head1 SYNOPSIS
44:
45: $t = 5;
46: tie $u, 'Tie::Scalar::Symlink', \$t;
47: print $u; # prints 5 -- $u is linked to $t.
48: $u = 6;
49: print $t; # prints 6
50: untie $u;
51: $t = 7;
52: print $u; # prints 6
53:
54: =head1 DESCRIPTION
55:
56: This module allows you to link a scalar (source) to another (target) using the tie interface, such that accesses to the store are redirected to accesses to the target. See SYNOPSIS.
57:
58: =head1 SEE ALSO
59:
60: L<perltie>, L<Tie::Scalar>
61:
62: =cut
63:
64: "Tie::Scalar::Symlink v0.01";
65:
66: # It's very simple, but I can imagine it being very useful.
67: # Feedback?
68: </code> 