Object Hash Reference

[Pontifex]

I'm getting very odd errors with a chunk of code I'm working with. It's a module, which stores information internally with a hash reference. At first I was trying to use a 'my' variable external to the package's subroutines, but some bizarre errors later I learn that such variables are global across all objects of that type.

So here's the offending code:


sub new {
my ($class_name) = @_;
my $self = {
program_store => (),
base_name => (),
};
bless ($self, $class_name);
return $self;
}

sub add_program_reference {
my $self = shift;

#if the name isn't in base_names, add it to the hash
#if the name is in base_names, append the value of $base_name{$_} and increment to make names unique
foreach (@_) {
my $add = $_->get_name;

#check for dupes
if ($self->{base_name}->{$add}) {
$add = $add.'_'.$self->{base_name}->{$add}++;
} else {
$self->{base_name}->{$add} = 1;
}

#ERROR HERE
${$self->{program_store}}{$add} = $_;
# $self->{program_store}->{$add} = $_;
}
}


Error Message:

Can't use string ("base_name") as a HASH ref while "strict refs" in use at WFS_store.pm line 44.


As you can see I've been trying different syntax's in the hopes of getting rid of the error (Perl reports the error on the line after where I have labeled '#ERROR HERE'). I have verified that the line of code dealing with 'program_store' is indeed triggering the error.

As you can see I'm using no strings for hash references and the line in question doesn't even have 'base_name' on it!

This seems to have something to do with it:

http://www.troubleshooters.com/codecorn/littperl/perlfuncorder.htm

But I don't have prototypes and I'm not using subroutines before I define them in the code.

It looks as if $self is getting set to a string 'base_name' somehow. I tried adjusting the shift to:


my ($self, @input) = @_;


But that doesn't change anything. I suspect my syntax for accessing the hashes is a bit off, but I can't point to where right this moment.

Before I get to far into this, is this a good practice? I want to save information related to the objects, this seems the best place. Besides some weird looking syntax, everything seems to work fine.

It's late, maybe I'll something more in the morning. Thanks.


--Pontifex

[FishMonger]

The first problem is that you're relying on a poorly written example.

It looks as if $self is getting set to a string 'base_name' somehow.If that's true (which I doubt), then YOU must be setting it somewhere.

Please post a complete condensed version of your code that demonstrates your issue. I could modify the code sample that you posted to try to troubleshoot your problem, but it's almost guaranteed that my adjustments won't exhibit the same problem.

[Pontifex]

Fair enough. I've trimmed the code down to duplicate the problem:

main.pl:

#!/usr/bin/perl
use strict;
use warnings;

use WFS_URI;
use WFS_program_obj;
use WFS_store;

my $a = new WFS_URI('a');

my $context_prog = new WFS_program_obj('Context', 'C:\Program Files\ConTEXT\ConTEXT.exe');

$context_prog->add_content($a);

my $store = new WFS_store;

$store->add_program_reference($context_prog);


WFS_URI.pm:


package WFS_URI;
use strict;

sub new {
my ($class_name) = $_[0];

#setup object
my $self = {
path => $_[1],
type => $_[2],
};

bless ($self, $class_name);
return $self;
}

sub get_uri_path {
my ($self) = @_;
return $self->{path};
}

1;


WFS_program_obj.pm:


package WFS_program_obj;
use strict;

sub new {
my ($class_name) = $_[0];

#setup object
my $self = {
name => $_[1],
path => $_[2],
type => $_[3],
store => [],
};

bless ($self, $class_name);
return $self;
}

sub add_content {
my $self = shift;

#only add new unique values to the storage array
#values that don't exist in @content_store, but do exist in @_
my @input;
my %unique;

push (@input, @{$self->{store}}, @_);

foreach (@input) {
$unique{$_->get_uri_path} = $_;
}

$self->clear_content();

foreach (keys %unique) {
push(@{$self->{store}}, $unique{$_});
}
}

sub clear_content {
my $self = shift;
undef @{$self->{store}};
}

1;


WFS_store:


package WFS_store;
use strict;

sub new {
my ($class_name) = @_;
my $self = {
program_store => (),
base_name => (),
};
bless ($self, $class_name);
return $self;
}

sub trim {
my @out = @_;

foreach (@out) {
s/^\s+//;
s/\s+$//;
}

return wantarray ? @out : $out[0];
}#end of trim()


sub add_program_reference {
my ($self, @input) = @_;

#if the name isn't in base_names, add it to the hash
#if the name is in base_names, append the value of $base_name{$_} and increment to make names unique
foreach (@input) {
my $add = $_->get_name;

#check for dupes
if ($self->{base_name}->{$add}) {
$add = $add.'_'.$self->{base_name}->{$add}++;
} else {
$self->{base_name}->{$add} = 1;
}

$self->{program_store}{$add} = $_;
}


}

1;


Content is associated with a program object and program objects are stored in a Program_Store object. I've taken everything else out that isn't explicitly used when duplicating the issue.

--Pontifex

[FishMonger]

Your condensed version is missing the get_name() sub in WFS_store.

[FishMonger]

This should help to see the problem.

sub add_program_reference {
my ($self, @input) = @_;

use Data::Dumper;
print Dumper $self and exit;

#if the name isn't in base_names, add it to the hash
#if the name is in base_names, append the value of $base_name{$_} and increment to make names unique
foreach (@input) {
my $add = $_->get_name;

#check for dupes
if ($self->{base_name}->{$add}) {
$add = $add.'_'.$self->{base_name}->{$add}++;
} else {
$self->{base_name}->{$add} = 1;
}

$self->{program_store}{$add} = $_;
}

}
Outputs:
$VAR1 = bless( {
'program_store' => 'base_name'
}, 'WFS_store' );

[FishMonger]

Change:
my $self = {
program_store => (),
base_name => (),
};

To this:
my $self = {
program_store => '',
base_name => '',
};

[Pontifex]

Ok, so what was going on there? The declarations were correct (as far as I could see). Some bug I'm not aware of?

Also. THANK YOU, for Data Dumper. When I first went through Perl I found this wonderful tool, but when looking for a way to diagnose this problem I could not. for the life of me, find the name.

So I did the changes:


sub new {
my ($class_name) = @_;
my $self = {
program_store => '',
base_name => '',
};
bless ($self, $class_name);
return $self;
}


New errors:


$ perl object_revision.pl
Can't use string ("") as a HASH ref while "strict refs" in use at WFS_store.pm l
ine 48.


Data Dumper output:


$ perl object_revision.pl
$VAR1 = bless( {
'program_store' => '',
'base_name' => ''
}, 'WFS_store' );


So, everything looks good so far. Now before we move on I did some experimentation:



sub new {
my ($class_name) = @_;
my $self = {
program_store => '',
base_name => (),
};
bless ($self, $class_name);
return $self;
}


$VAR1 = bless( {
'program_store' => '',
'base_name' => undef
}, 'WFS_store' );


Look at that! I initialize the 'base_name' key with an anonymous hash and in the object it goes undef! Something odd here.


sub new {
my ($class_name) = @_;
my $self = {
program_store => (),
base_name => '',
};
bless ($self, $class_name);
return $self;
}


$VAR1 = bless( {
'' => undef,
'program_store' => 'base_name'
}, 'WFS_store' );


Weird stuff.


sub new {
my ($class_name) = @_;
my $self = {
program_store => (),
base_name => [],
};
bless ($self, $class_name);
return $self;
}


$VAR1 = bless( {
'program_store' => 'base_name',
'ARRAY(0x104bc544)' => undef
}, 'WFS_store' );


This one is actually what I expect:


sub new {
my ($class_name) = @_;
my $self = {
program_store => [],
base_name => [],
};
bless ($self, $class_name);
return $self;
}


$VAR1 = bless( {
'program_store' => [],
'base_name' => []
}, 'WFS_store' );


So it seems that the anonymous hash initializer isn't fully supported? From the patterns above I it looks like that I might as well not be initializing the keys. So I did it:


sub new {
my ($class_name) = @_;
my $self = {
program_store => ,
base_name => ,
};
bless ($self, $class_name);
return $self;
}


$VAR1 = bless( {
'program_store' => 'base_name'
}, 'WFS_store' );


Look at that, just like I started. Did I find a bug? The anonymous hash initializer just isn't recognized, I don't quite know why we get the "key-pointing-to-a-key" behavior I saw above, but that's what happens.

I think I'll just have to stick with the anonymous array and work with that.

--Pontifex

P.S. Why are you the only one that answers my questions? I think I've gotten one other person total that replies to my threads.

[FishMonger]

You need to use { } braces to assign an anonymous hash, not parenthesis. The parenthesis would be used to assign an empty list to an array.

sub new {
my ($class_name) = @_;
my $self = {
program_store => {},
base_name => {},
};
bless ($self, $class_name);
return $self;
}

P.S. Why are you the only one that answers my questions?I might be the only other person here that has worked with OO modules, and at that I have not done much in this area. However, I have a fairly good understanding of Perl overall, which is why I can spot the problems.

[FishMonger]

I've been looking at the condensed version of your code and am trying to figure out what you're trying to accomplish. Other than for obfuscation, why are you using 3 like modules that don't do any inheritance from each other? Most, if not all, of what this code is doing can be done in 1 module.

[Pontifex]

Curly Bracers, right. I had to increase the text size on Perldoc _twice_ before I saw the bloody things. Grrrr. I'm just amazed that strict Perl didn't throw an error about my previous declarations using a list when I meant to use a hash.

Usually in my C++ I make objects to store information. If I'm recording information about, URI's say (As in the code), I need an object for it. Then I want to put those objects in a container that has some meaningful relationship, as per a program in the code.

The program object has open URI objects relating to what pages it has open. I thought that would be the best way to do it.

As for inheritance. I'm going for extremely simple here. I just want to be able to enter my open programs, their open content and then write it out to XML for storage somewhere else. So that I can pick up a project later if I need to and still have all my notes, open pages, etc; Ready for me in a simple centralized location.

That's really more of the overview. But I don't use inheritance, because:

1) I don't really understand it in Perl, at this point and I don't want to make it more complicated than I have to.
2) In my experience inheritance usually makes the code more complicated for no real benefit.

I'm probably making some broad assumptions there, as inheritance in C and C++ is a headache. I hardly ever use it for the things I do.

--Pontifex