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>
Back to
Craft