Just make sure than one of your link creation functions bails out if its already been set. For instance in the code below if the node is already in the taxon the taxon doesn't bother trying to set itself as that nodes taxon. The other option could be to have one more layer of inderiction. So you have set_taxon($taxon) that users use, it would automaticaly create the link, it would then call $taxon->_add_node($node) The private (underscored) versions of add_node and set_taxon don't automaticaly do anything.
use strict;
use warnings;
{
package Taxon;
sub new { bless {nodes=>[]}, shift; };
sub add_node {
my $self = shift;
my $node = shift;
return 1 if $self->has_node($node);
push @{$self->{nodes}}, $node;
$node->set_taxon($self);
}
sub has_node {
my $self = shift;
my $node = shift;
return grep { $_ eq $node } $self->get_nodes();
}
sub get_nodes { @{shift->{nodes}} };
}
{
package Node;
sub new { bless {_taxon=>''}, shift; };
sub taxon {
my $self = shift;
return $self->{'_taxon'};
}
sub set_taxon {
my $self = shift;
my $taxon = shift;
return if $self->{'_taxon'} eq $taxon;
$self->{'_taxon'} = $taxon;
$self->{'_taxon'}->add_node($self);
}
}
my $node = new Node;
my $taxon = new Taxon;
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
$node->set_taxon($taxon);
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
$node = new Node;
$taxon = new Taxon;
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
$taxon->add_node($node);
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
Or the second way
use strict;
use warnings;
{
package Taxon;
sub new { bless {nodes=>[]}, shift; };
sub add_node {
my $self = shift;
my $node = shift;
$self->_add_node($node);
$node->_set_taxon($self);
}
sub _add_node {
my $self = shift;
my $node = shift;
return 1 if $self->has_node($node);
push @{$self->{nodes}}, $node;
}
sub has_node {
my $self = shift;
my $node = shift;
return grep { $_ eq $node } $self->get_nodes();
}
sub get_nodes { @{shift->{nodes}} };
}
{
package Node;
sub new { bless {_taxon=>''}, shift; };
sub taxon {
my $self = shift;
return $self->{'_taxon'};
}
sub set_taxon {
my $self = shift;
my $taxon = shift;
$self->_set_taxon($taxon);
$taxon->_add_node($self);
}
sub _set_taxon {
my $self = shift;
my $taxon = shift;
$self->{'_taxon'} = $taxon;
}
}
my $node = new Node;
my $taxon = new Taxon;
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
$node->set_taxon($taxon);
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
$node = new Node;
$taxon = new Taxon;
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
$taxon->add_node($node);
print '$node->taxon() = ', $node->taxon(), "\n";
print '$taxon->get_nodes() = ', $taxon->get_nodes(), "\n";
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.