oo programing using PERL

[alexandre.melard]

Hi,

My name is alex, this is my first post so cheerio everybody ;-)

I am building an oo app using perl, my problem is high level, not the
code.

I have a collection of objects. that I call nodes.
I have other objects called nodegroup
I want to be able to add nodes to a nodegroup object, so I do:
$node1 = Node->new(INDEX=>1, NAME => "old name");
$node2 = Node->new(blablabla);
$node3 = Node->new(blablabla);

$ng = Nodegroup->new(NAME=>"group1");

$ng->addNode($node1);
$ng->addNode($node2);
....

Everything seem to work all right, the problem comes when I change a
node,
let say:
$node1->name("new name");
when I do :
print "$ng->getNode(1)->name()";
I get "old name";

I found that I was copying the value of $node1 to $ng instead of
passing a reference.

I need a short help on oo programing in perl about reference passing,
if someone feels happy to help me understand, I will be most gratefull.

Alexandre.

 

[Keith Keller]

I have a collection of objects. that I call nodes.
I have other objects called nodegroup
I want to be able to add nodes to a nodegroup object, so I do:
$node1 = Node->new(INDEX=>1, NAME => "old name");
$node2 = Node->new(blablabla);
$node3 = Node->new(blablabla);

$ng = Nodegroup->new(NAME=>"group1");

$ng->addNode($node1);
$ng->addNode($node2);
...

Everything seem to work all right, the problem comes when I change a
node,
let say:
$node1->name("new name");
when I do :
print "$ng->getNode(1)->name()";
I get "old name";

I found that I was copying the value of $node1 to $ng instead of
passing a reference.

What you do with $node1 depends entirely on the code in sub addNode {}.
Certainly, if the above code is accurate, addNode's second argument
($_[1]) will be a reference pointing to the same place as $node1. You
might want to post a complete yet short code block that replicates the
problem (including the code to addNode, at bare minimum).

I need a short help on oo programing in perl about reference passing,

This isn't really a question about OO per se, just references. Have you
read perldoc perlreftut and perldoc perlref?

--keith

 

[Paul Lalli]

I need a short help on oo programing in perl about reference passing,
if someone feels happy to help me understand, I will be most gratefull.

Have you read the documentation and tutorials that come with Perl?

perldoc perlreftut
perldoc perlref
perldoc perldsc
perldoc perllol
perldoc perlsub

In short, all subroutine arguments are passed by reference. The
members of @_ are aliases to the arguments passed to the function call.

sub foo {
$_[0] *= 2;
$_[1] = 'alpha';
}

my ($x, $y) = (4, 4);
foo ($x, $y);
print "X = $x, Y = $y\n";
# prints: X = 8, Y = alpha

Note that if you make a copy of the arguments in the subroutine, and
then modify the copy, the originals do not change:

sub foo {
my ($one, $two) = @_;
$one *= 2;
$two = 'alpha';
}
#This does NOT have the same affect as above.
#X and Y are still 4

Alternatively, you can pass explicit references as arguments, so that
when you make copies of the references, they will still refer to the
same data:

sub foo {
my ($ref1, $ref2) = @_;
$$ref1 *= 2;
$$ref2 = 'alpha';
}

my ($x, $y) = (4, 4)
foo (\$x, \$y);
print "X = $x, Y = $y\n";
#same output as first example


For more help, please first read some of the perldocs above, and if you
can't figure out your problem, post a short-but-complete script that
demonstrates your issue.

Paul Lalli

 

[alexandre.melard]

I will do some more reading, I really apreciate your help.

I will let you know tomorrow morning about my results.

Thank you

Alexandre

 

[xhoster]

Hi,

My name is alex, this is my first post so cheerio everybody ;-)

I am building an oo app using perl, my problem is high level, not the
code.

I'm pretty sure your problem is the code, not the high level.

I have a collection of objects. that I call nodes.
I have other objects called nodegroup
I want to be able to add nodes to a nodegroup object, so I do:
$node1 = Node->new(INDEX=>1, NAME => "old name");
$node2 = Node->new(blablabla);
$node3 = Node->new(blablabla);

You don't seem to be using strict; shame shame.

$ng = Nodegroup->new(NAME=>"group1");

$ng->addNode($node1);
$ng->addNode($node2);
...

Everything seem to work all right, the problem comes when I change a
node,
let say:
$node1->name("new name");
when I do :
print "$ng->getNode(1)->name()";
I get "old name";

No, you don't. You can't invoke methods within double quotes that way.
What you get is a stringified reference, followed by
"->getNode(1)->name()".

If you want real help, show us real code.

I found that I was copying the value of $node1 to $ng instead of
passing a reference.

I need a short help on oo programing in perl about reference passing,
if someone feels happy to help me understand, I will be most gratefull.

use strict;
use warnings;

my $node1 = Node->new(INDEX=>1, NAME => "old name");
my $node2 = Node->new();
my $node3 = Node->new();
my $ng = Nodegroup->new(NAME=>"group1");
$ng->addNode($node1);
$ng->addNode($node2);
$ng->addNode($node3);
$node1->name("new name");
print $ng->getNode(0)->name(),"\n";

package Node;
sub new {
shift @_;
bless {@_};
};
sub name {
my $self=shift;
my $return = $self->{NAME};
$self->{NAME}=$_[0] if @_;
return $return;
};

package Nodegroup;
sub new {
return bless [];
};
sub addNode {
push @{$_[0]}, $_[1];
};
sub getNode {
return $_[0][$_[1]];
};
__END__
new name



Xho

 

[alexandre.melard]

Ok, I post part of my code in order to be more explicit:

#!/usr/bin/perl -w


use strict;
use Storable;
use User;
use Node;
use Hostgroup;
use Fcntl qwDEFAULT :flock);
use Term::ANSIColor qwconstants);

my $nodes = {};
my $hostgroups = {};

.....blablabla.....

addHostgroup();

.....blablabla.....

sub addHostgroup {
my $end = 0;
header();
print "--- ADD HOSTGROUPS---------------------------\n";
do {
my $hostgroupCreated = 0;
my $choice = undef;
my $name = getText("hostgroup name");
my $hostgroup = Hostgroup->new(NAME=>$name);
$hostgroup = addNodes($hostgroup);
$end = 0;
do {
print "---REVIEW-------------------------\n";
print "[1] name: ".$hostgroup->name()."\n";
print "[2] Nodes: ".$hostgroup->printNodesName()."\n";
print "[3] save hostgroup and go to main menu\n";
print "[4] save hostgroup and create another hostgroup\n";
print "[5] cancel and go back to main menu\n";
print "-----------------------------------\n";
do {
print "Enter your choice: ";
$choice = <STDIN>;
chomp $choice;
}until ($choice =~ /^\d+|q$/i);
if ($choice eq 1) { $name = getText("hostgroup name") }
elsif ($choice eq 2) { addNodes($hostgroup) }
elsif ($choice eq 3) {
createHostgroup(HOSTGROUP=>$hostgroup);
$hostgroupCreated = 1;
$end = 1;
}
elsif ($choice eq 4) {
createHostgroup(HOSTGROUP=>$hostgroup);
$hostgroupCreated = 1;
$end = 0;
}
else {
$hostgroupCreated = 1;
$end = 1;
}
}until ($hostgroupCreated); #create hostgroup


}until($end); #add hostgroups


}

.....blablabla.....

sub addNodes {
my $hostgroup = shift;
my $end = 0;
do {
my @off = undef;
my @on = undef;
my $i = 0;
for my $node ( sort keys %{$nodes} ) {
unless($hostgroup->getNode(NAME=>$nodes->{$node}->{NAME}))
{
push @off, "[".YELLOW."$node".GREEN."]
$nodes->{$node}->{NAME} ";
}else {
push @on, "[".YELLOW."$node".GREEN."]
$nodes->{$node}->{NAME} ";
}
}
print "availables:\n";
foreach (@off) {
print GREEN;
if($i<3 and $_) { print "$_"; $i++;}
elsif ($_) { print "$_\n"; $i = 0;}
elsif ($#off eq 0) { print RED, "No more node available",
RESET; }
print RESET;
}
}
$i = 0;
print "\n";
print "in hostgroup:\n";
foreach (@on) {
print GREEN;
if($i<3 and $_) { print "$_"; $i++;}
elsif ($_) { print "$_\n"; $i = 0;}
elsif ($#on eq 0) { print RED, "No node to remove yet",
RESET; }
print RESET;
}
print "\n";
print RED, "Press ".YELLOW."q".RED." to Get to main menu\n",
RESET;
my $index = getNumber("node index");
if($index =~ /q/i) {$end = 1}
else {
if ($hostgroup->getNode(NAME=>$nodes->{$index}->{NAME})) {
print MAGENTA, "$nodes->{$index}->{NAME}".RED." removed
from hostgroup.\n", RESET;
$hostgroup->delNode($nodes->{$index}->{NAME});
}else {
!!! IMPORTANT BIT !!!
$hostgroup->addNode(\$nodes->{$index});
!!! IMPORTANT BIT !!!
print MAGENTA, "$nodes->{$index}->{NAME}".RED." added
to hostgroup.\n", RESET;
}
}
if($end) {
if((keys %{$hostgroup->{NODES}}) eq 0) {
$end = 0;
print RED, "You need to add at least one node\n",
RESET;
}
}
} until ($end);
return $hostgroup;
}

package Hostgroup;
use Term::ANSIColor qwconstants);
use strict;

sub new {
my $type = shift;
my %params = @_;
my $self = {};
$self->{'NAME'} = $params{'NAME'};
if (defined($params{'NODES'})) {
$self->{'NODES'} = $params{'NODES'};
}else {
$self->{'NODES'} = {};
}
bless $self, $type;
return $self;
}

sub name {
my $self = shift;
if(@_) { $self->{'NAME'} = shift }
return $self->{'NAME'};
}
sub addNode {
my $self = shift;
my $node = shift;
bless($node);
$self->{'NODES'}->{$node->name()} = $$node;
return $self->{'NODES'}->{$node->name()};
}
sub getNode {
my $self = shift;
my %params = @_;
if (defined($params{'NAME'})) {
return $self->{'NODES'}->{$params{'NAME'}};
}
if (defined($params{'IP'})) {
for my $node_name ( keys %{$self->{ 'NODES' }} ) {
if ($self->{'NODES'}->{$node_name}->{'IP'} eq
$params{'IP'}) {
return $self->{'NODES'}->{$node_name};
}
}
}
return 0;
}


package Node;
use strict;
use Term::ANSIColor qwconstants);

sub new {
my $type = shift;
my %params = @_;
my $self = {};
$self->{'NAME'} = $params{'NAME'};
$self->{'IP'} = $params{'IP'};
bless $self, $type;
return $self;
}

sub name {
my $self = shift;
if(@_) { $self->{'NAME'} = shift }
return $self->{'NAME'};
}


I hope this would be of some help...

 

[alexandre.melard]

Hi again,
I tried to change that bit:

$hostgroup->addNode(\$nodes->{$index});

in sub addNodes{}

and sub addNode {
my $self = shift;
my $node = shift;
$self->{'NODES'}->{$$node->name()} = $$node;
return $self->{'NODES'}->{$$node->name()};
}

in package Hostgroup

but that does not change my problem, when I add nodes to
$hostgroups->{NODES} and when I modify them in $nodes{}, the
modifications are not reflected in $hostgroups->{NODES}...

Any idea?

 

[xhoster]

Ok, I post part of my code in order to be more explicit:

This dies all over the place. Don't post part of your code. Simplify your
code so that it actual runs, actually shows the error you say it does, and
yet is as small as possible. Then post this entire simplified code.

!!! IMPORTANT BIT !!!
$hostgroup->addNode(\$nodes->{$index});
!!! IMPORTANT BIT !!!

Why pass in a reference to node, rather than the node itself (which is a
reference already)?

package Hostgroup; ....
sub addNode {
my $self = shift;
my $node = shift;
bless($node);

What the heck is this supposed to do? You have now blessed a ref to
a Node (which is ref to a ref) into the Hostgroup class.

$self->{'NODES'}->{$node->name()} = $$node;

$node->name() bombs out, because Hostgroup::name is expecting to get
a hash ref, but instead it gets a ref ref.

return $self->{'NODES'}->{$node->name()};
}

Xho

 

[alexandre.melard]

Hi there

Ok, I have solved my problem....

The problem was not in the code, I new that, a good night of 6 hours
helped me to see the solution, as usual, "la nuit porte conseil".

I was trying to STORE a copy of the node in the nodegroup hash, this
was not the smartest move. Instead of copying the whole object to my
array, I needed a reference to the object. Then I rode about references
etc. But this was MUCH to complicated.

What I needed was just a reference to the object node, not in memory
but a hard reference that I could use after storing the nodegroup
object on database or filesystem...

The solution was right under my node and so obvious no one could spot
it (I know because of my buggy code).

What to do was to store a reference in the form of an index associated
with the node. Therefore if I change the characteristics of the node, I
am not going to modify its index, which is like our name, it is ok to
change it but no one can find us anymore ;-)

So I just stored an array of nodes indexes associated with a nodegroup.
Thus when changing the name of the node, The changes are reflected in
the nodegroup as welll...

I hope this problem can help someone out there.

Alexandre

 

[Anno Siegel]

Hi there

Ok, I have solved my problem....

The problem was not in the code, I new that, a good night of 6 hours
helped me to see the solution, as usual, "la nuit porte conseil".

I was trying to STORE a copy of the node in the nodegroup hash, this
was not the smartest move. Instead of copying the whole object to my
array, I needed a reference to the object. Then I rode about references
etc. But this was MUCH to complicated.

It isn't complicated at all, once you're comfortable with using
references.

What I needed was just a reference to the object node, not in memory
but a hard reference that I could use after storing the nodegroup
object on database or filesystem...

That would be a different problem that shouldn't be mixed into the
current one. Read about object persistence.

The solution was right under my node and so obvious no one could spot
it (I know because of my buggy code).

What to do was to store a reference in the form of an index associated
with the node. Therefore if I change the characteristics of the node, I
am not going to modify its index, which is like our name, it is ok to
change it but no one can find us anymore ;-)

I don't see how using an index is less "in memory" than a reference.
In fact, using an extra array to keep the objects is a complication.
It *is* sometimes done that way (see Flyweight Objects), but in your
situation I don't see an advantage.

So I just stored an array of nodes indexes associated with a nodegroup.
Thus when changing the name of the node, The changes are reflected in
the nodegroup as welll...

The situation that one object serves as a container for other objects
is a standard situation in OO. The code below shows a solution with
standard methods of Perl OO. It demonstrates that renaming a node
has an effect also on the node that is stored in the node group.

Anno

#!/usr/bin/perl
use strict; use warnings; $| = 1; # @^~`
use Vi::QuickFix;

my $node = Node->new( 'alpha');
my $ng = Nodegroup->new( $node);

print $ng->get_nodes( 0)->name, "\n";
$node->name( 'beta');
print $ng->get_nodes( 0)->name, "\n";


package Node;

sub new {
my ( $class, $name) = @_;
bless { name => $name }, $class;
}

sub name {
my ( $node, $newname) = @_;
$node->{ name} = $newname if $newname;
$node->{ name};
}


package Nodegroup;

sub new {
my ( $class, $name) = shift;
bless {
name => $name,
nodes => [ @_],
}, $class;
}

sub get_nodes { @{ $_[0]->{ nodes}}[ @_] }

__END__

 

[alexandre.melard]

Hi Anno and everybody
I modified your script in order to show a bit more clearly my problem.
When running the script, as you can guess, I get the following error:

jupiter ssms # perl toto.pl
alpha
beta
Can't call method "get_nodes" on unblessed reference at toto.pl
line 19.

modified script:

#!/usr/bin/perl
use strict; use warnings; $| = 1; # @^~`
use Vi::QuickFix;

my $node = Node->new( 'alpha');
my $ng = Nodegroup->new( $node);

print $ng->get_nodes( 0)->name, "\n";
$node->name( 'beta');
print $ng->get_nodes( 0)->name, "\n";

######## START OF MODIFICATION ##############################


unless (-e "toto.sto") { system "touch toto.sto"; }
store(\$ng, 'toto.sto');
$ng = undef;
my $toto = undef;
if (-e "toto.sto"){ $toto = retrieve('toto.sto'); }
print $toto->get_nodes( 0)->name, "\n";


######## END #############################################

package Node;

sub new {
my ( $class, $name) = @_;
bless { name => $name }, $class;

}

sub name {
my ( $node, $newname) = @_;
$node->{ name} = $newname if $newname;
$node->{ name};

}

package Nodegroup;

sub new {
my ( $class, $name) = shift;
bless {
name => $name,
nodes => [ @_],
}, $class;

}

sub get_nodes { @{ $_[0]->{ nodes}}[ @_] }

__END__

 

[Jay Tilton]

(e-mail address removed) wrote:

: Hi Anno and everybody
: I modified your script in order to show a bit more clearly my problem.
: When running the script, as you can guess, I get the following error:
:
: jupiter ssms # perl toto.pl
: alpha
: beta
: Can't call method "get_nodes" on unblessed reference at toto.pl
: line 19.

Adding "use diagnostics;" to your program generates error and warning
messages with more information. What it would tell you in this case is
that you have an unblessed reference, i.e. not an object.

: modified script:
:
: #!/usr/bin/perl
: use strict; use warnings; $| = 1; # @^~`
: use Vi::QuickFix;
:
: my $node = Node->new( 'alpha');
: my $ng = Nodegroup->new( $node);
:
: print $ng->get_nodes( 0)->name, "\n";
: $node->name( 'beta');
: print $ng->get_nodes( 0)->name, "\n";
:
: ######## START OF MODIFICATION ##############################
:
:
: unless (-e "toto.sto") { system "touch toto.sto"; }
: store(\$ng, 'toto.sto');
^
^
The program stores a reference to $ng.

: $ng = undef;
: my $toto = undef;
: if (-e "toto.sto"){ $toto = retrieve('toto.sto'); }

Then retrieves that previously stored reference.

: print $toto->get_nodes( 0)->name, "\n";

And that reference naturally does not behave as the referent would.

A Perl object is already a reference. Storing a reference to that
reference is where your program has gone off its rails.

 

[alexandre.melard]

Hi
I got the fact that I was storing the reference, I put this code in
order to demonstrate that the problem I had was not as simple as it
seemed and that the only solution I could find was to store a "hard"
reference to the object.

Alexandre

Jay Tilton a écrit :