develooper 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";




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About