1#!./perl 2 3# $Id: tied.pl,v 0.18 2006/10/08 03:37:29 ray Exp $ 4# 5# Copyright (c) 1995-1998, Raphael Manfredi 6# 7# You may redistribute only under the terms of the Artistic License, 8# as specified in the README file that comes with the distribution. 9# 10# $Log: tied.pl,v $ 11# Revision 0.18 2006/10/08 03:37:29 ray 12# Commented out VERSION causes errors with DynaLoader in perl 5.6.1 (and 13# probably all earlier versions. It was removed. 14# 15# Revision 0.14 2003/09/07 22:02:36 ray 16# VERSION 0.15 17# 18# Revision 0.13.2.1 2003/09/07 21:51:13 ray 19# added support for unicode hash keys. This is only really a bug in 5.8.0 and 20# the test in t/03scalar supports this. 21# 22# Revision 0.13 2002/06/12 06:41:55 ray 23# VERSION 0.13 24# 25# Revision 0.11 2001/07/29 19:31:05 ray 26# VERSION 0.11 27# 28# Revision 0.10 2001/04/29 21:56:10 ray 29# VERSION 0.10 30# 31# Revision 0.9 2001/03/05 00:11:49 ray 32# version 0.9 33# 34# Revision 0.9 2000/08/21 23:06:34 ray 35# added support for code refs 36# 37# Revision 0.8 2000/08/11 17:08:36 ray 38# Release 0.08. 39# 40# Revision 0.7 2000/08/01 00:43:48 ray 41# release 0.07. 42# 43# Revision 0.6.2.1 2000/08/01 00:42:53 ray 44# modified to use as a require statement. 45# 46# Revision 0.6 2000/08/01 01:38:38 ray 47# "borrowed" code from Storable 48# 49# Revision 0.6 1998/06/04 16:08:40 ram 50# Baseline for first beta release. 51# 52 53require 't/dump.pl'; 54 55package TIED_HASH; 56 57sub TIEHASH { 58 my $self = bless {}, shift; 59 return $self; 60} 61 62sub FETCH { 63 my $self = shift; 64 my ($key) = @_; 65 $main::hash_fetch++; 66 return $self->{$key}; 67} 68 69sub STORE { 70 my $self = shift; 71 my ($key, $value) = @_; 72 $self->{$key} = $value; 73} 74 75sub FIRSTKEY { 76 my $self = shift; 77 scalar keys %{$self}; 78 return each %{$self}; 79} 80 81sub NEXTKEY { 82 my $self = shift; 83 return each %{$self}; 84} 85 86package TIED_ARRAY; 87 88sub TIEARRAY { 89 my $self = bless [], shift; 90 return $self; 91} 92 93sub FETCH { 94 my $self = shift; 95 my ($idx) = @_; 96 $main::array_fetch++; 97 return $self->[$idx]; 98} 99 100sub STORE { 101 my $self = shift; 102 my ($idx, $value) = @_; 103 $self->[$idx] = $value; 104} 105 106sub FETCHSIZE { 107 my $self = shift; 108 return @{$self}; 109} 110 111package TIED_SCALAR; 112 113sub TIESCALAR { 114 my $scalar; 115 my $self = bless \$scalar, shift; 116 return $self; 117} 118 119sub FETCH { 120 my $self = shift; 121 $main::scalar_fetch++; 122 return $$self; 123} 124 125sub STORE { 126 my $self = shift; 127 my ($value) = @_; 128 $$self = $value; 129} 130 1311; 132