use strict; package MyTie; my @TIED; sub TIEHASH { my $type = shift; my $index = shift; return undef unless $TIED[$index]; my $self; if ($TIED[$index]) { $self = $TIED[$index]; } else { $TIED[$index] = $self = {}; bless $self, ref($type) || $type; } $self->{HASH} = {}; @{$self->{HASH}}{@_} = @{$self->{ARRAY}}; $self->{ISTIED}{HASH} = 1; return $self; } sub TIEARRAY { my $type = shift; my $index = shift; my $self; if ($TIED[$index]) { $self = $TIED[$index]; } else { $TIED[$index] = $self = {}; bless $self, ref($type) || $type; } $self->{ARRAY} = [ @_ ]; $self->{ISTIED}{ARRAY} = 1; return $self; } sub FETCH { my $self = shift; my $key = shift; return undef unless defined $key; if ($key =~ /\D/) { return undef unless $self->{ISTIED}{HASH}; return $self->{HASH}{$key}; } else { return undef unless $self->{ISTIED}{ARRAY}; return $self->{ARRAY}[$key]; } } sub STORE { my $self = shift; my $key = shift; return undef unless defined $key; if ($key =~ /\D/) { return undef unless $self->{ISTIED}{HASH}; $self->{HASH}{$key} = shift; } else { return undef unless $self->{ISTIED}{ARRAY}; $self->{ARRAY}[$key] = shift; } } sub FETCHSIZE { my $self = shift; return $#{$self->{ARRAY}}; } 1; __END__ #### #!/usr/local/bin/perl use strict; use warnings; use MyTie; my $index = 0; my @blah; tie @blah, "MyTie", $index, (5, 4, 3, 2, 1); my %blah; tie %blah, 'MyTie', $index, qw(zero one two three four); print "$blah[2]\n"; print "$blah{two}\n";