Front page | perl.perl5.porters |
Postings from January 2001
[ID 20010122.152] Problem with Tie::StdHash / FETCH ??
From:
nexus6_kills
Date:
January 22, 2001 17:30
Subject:
[ID 20010122.152] Problem with Tie::StdHash / FETCH ??
Message ID:
14956.56493.870638.663473@flatearth.reshape.com
Greetings,
The problem that I am encountering is shown in the example
file below (sorry for the length, but it is as short as I
could make it). In "package main", I have listed the seven
cases which I would like to make work. The last two cases
do not work. I would like to know why they don't work. I
understand that it has something to do with copy, but some
help would be appreciated.
The code below can be executed as is; you will get the
message:
"Can't use an undefined value as an ARRAY reference ..."
Thanks in advance.
- Nexus6
#!/usr/local/bin/perl -w
#===============================================================================
package MyPackage_1;
use Tie::Hash;
@ISA = (Tie::StdHash);
sub new
{
my ($className) = shift;
my $self = {};
bless ($self, $className);
$self->{key_1} = "val_1";
$self->{key_2} = "val_2";
my %retHash;
tie %retHash, $className, $self;
return bless \%retHash, $className;
}
sub TIEHASH
{
my ($className, $obj) = @_;
return bless $obj, $className;
}
sub FETCH
{
my ($self, $key) = @_;
my ($rhs) = $self->{$key};
$rhs = &$rhs if (ref($rhs) eq "CODE");
return $rhs;
}
#===============================================================================
package MyPackage_2;
use Tie::Hash;
@ISA = (Tie::StdHash);
sub new
{
my ($className, $pkg_1) = @_;
my $self = {};
bless ($self, $className);
$self->{DEPS}->{pkg_1} = $pkg_1;
$self->{the_keys} = sub { return [$self->{DEPS}->{pkg_1}->{key_1},
$self->{DEPS}->{pkg_1}->{key_2}]; };
$self->{the_keys_2} = sub { return ["foo", "bar"]; };
my %retHash;
tie %retHash, $className, $self;
return bless \%retHash, $className;
}
sub TIEHASH
{
my ($className, $obj) = @_;
return bless $obj, $className;
}
sub FETCH
{
my ($self, $key) = @_;
my ($rhs) = $self->{$key};
$rhs = &$rhs if (ref($rhs) eq "CODE");
return $rhs;
}
#===============================================================================
use strict;
package main;
sub printArray
{
my (@arr) = @_;
foreach my $m (@arr) {
print "+ ", $m;
}
print "\n";
}
my $pkg_1 = new MyPackage_1 ();
my $pkg_2 = new MyPackage_2 ($pkg_1);
my ($n);
#--- Case 1 (works)
my ($theArrRef) = $pkg_2->{the_keys};
foreach $n (@{$theArrRef}) {
print " ", $n;
}
print "\n";
#--- Case 2 (works)
print join (" : ", @{$pkg_2->{the_keys}}), "\n";
#--- Case 3 (works)
$theArrRef = $pkg_2->{the_keys};
printArray (@{$theArrRef});
#--- Case 4 (works)
printArray ((@{$theArrRef = $pkg_2->{the_keys}}));
#--- Case 5 (works)
printArray ((@{$pkg_2->{the_keys_2}}));
#--- Case 6 (DOES NOT work)
printArray ((@{$pkg_2->{the_keys}}));
#--- Case 7 (DOES NOT work)
foreach my $n (@{$pkg_2->{the_keys}}) {
print " ", $n;
}
print "\n";
-
[ID 20010122.152] Problem with Tie::StdHash / FETCH ??
by nexus6_kills