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