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