#!./perl # $Id: tied.pl,v 0.18 2006/10/08 03:37:29 ray Exp $ # # Copyright (c) 1995-1998, Raphael Manfredi # # You may redistribute only under the terms of the Artistic License, # as specified in the README file that comes with the distribution. # # $Log: tied.pl,v $ # Revision 0.18 2006/10/08 03:37:29 ray # Commented out VERSION causes errors with DynaLoader in perl 5.6.1 (and # probably all earlier versions. It was removed. # # Revision 0.14 2003/09/07 22:02:36 ray # VERSION 0.15 # # Revision 0.13.2.1 2003/09/07 21:51:13 ray # added support for unicode hash keys. This is only really a bug in 5.8.0 and # the test in t/03scalar supports this. # # Revision 0.13 2002/06/12 06:41:55 ray # VERSION 0.13 # # Revision 0.11 2001/07/29 19:31:05 ray # VERSION 0.11 # # Revision 0.10 2001/04/29 21:56:10 ray # VERSION 0.10 # # Revision 0.9 2001/03/05 00:11:49 ray # version 0.9 # # Revision 0.9 2000/08/21 23:06:34 ray # added support for code refs # # Revision 0.8 2000/08/11 17:08:36 ray # Release 0.08. # # Revision 0.7 2000/08/01 00:43:48 ray # release 0.07. # # Revision 0.6.2.1 2000/08/01 00:42:53 ray # modified to use as a require statement. # # Revision 0.6 2000/08/01 01:38:38 ray # "borrowed" code from Storable # # Revision 0.6 1998/06/04 16:08:40 ram # Baseline for first beta release. # require 't/dump.pl'; package TIED_HASH; sub TIEHASH { my $self = bless {}, shift; return $self; } sub FETCH { my $self = shift; my ($key) = @_; $main::hash_fetch++; return $self->{$key}; } sub STORE { my $self = shift; my ($key, $value) = @_; $self->{$key} = $value; } sub FIRSTKEY { my $self = shift; scalar keys %{$self}; return each %{$self}; } sub NEXTKEY { my $self = shift; return each %{$self}; } package TIED_ARRAY; sub TIEARRAY { my $self = bless [], shift; return $self; } sub FETCH { my $self = shift; my ($idx) = @_; $main::array_fetch++; return $self->[$idx]; } sub STORE { my $self = shift; my ($idx, $value) = @_; $self->[$idx] = $value; } sub FETCHSIZE { my $self = shift; return @{$self}; } package TIED_SCALAR; sub TIESCALAR { my $scalar; my $self = bless \$scalar, shift; return $self; } sub FETCH { my $self = shift; $main::scalar_fetch++; return $$self; } sub STORE { my $self = shift; my ($value) = @_; $$self = $value; } 1;