view release on metacpan or  search on metacpan

lib/BalanceOfPower/Relations/RelPack.pm  view on Meta::CPAN

has links => (
    is => 'rw',
    default => sub { [] }
);
has links_grid => (
    is => 'rw',
    default => sub { {} }
);
has distance_cache => (
    is => 'rw',
    default => sub { {} }
);


sub all
{
    my $self = shift;
    return @{$self->links};
}
sub reset
{
    my $self = shift;
    $self->links([]);
    $self->links_grid({});
    $self->distance_cache({});
}

sub exists_link
{
    my $self = shift;
    my $node1 = shift;
    my $node2 = shift;
    if(exists $self->links_grid->{$node1}->{$node2})
    {
        return $self->links_grid->{$node1}->{$node2} 
    }
    else
    {
        return undef;
    }
}

sub add_link
{
    my $self = shift;
    my $link = shift;
    my $node1 = $link->node1;
    my $node2 = $link->node2;
    if(! $self->exists_link($node1, $node2))
    {
        push @{$self->links}, $link;
        $self->links_grid->{$node1}->{$node2} = $link;
        $self->links_grid->{$node2}->{$node1} = $link;
        return 1;
    }
    else
    {
        return 0;
    }
}
sub update_link
{
    my $self = shift;
    my $link = shift;
    $self->delete_link($link->node1, $link->node2);
    $self->add_link($link);
}
sub delete_references
{
    my $self = shift;
    my $node1 = shift;
    my $node2 = shift;
    $self->links_grid->{$node1}->{$node2} = undef;
    $self->links_grid->{$node2}->{$node1} = undef;
}
sub delete_references_for_node
{
    my $self = shift;
    my $node1 = shift;
    foreach my $k (%{$self->links_grid->{$node1}})
    {
        if($k)
        {
            $self->links_grid->{$k}->{$node1} = undef;
        }
    }
    $self->links_grid->{$node1} = undef;
}
sub delete_link
{
    my $self = shift;
    my $node1 = shift;
    my $node2 = shift;
    @{$self->links} = grep { ! $_->involve($node1, $node2) } @{$self->links};
    $self->delete_references($node1, $node2);
}

sub delete_link_for_node
{
    my $self = shift;
    my $n1 = shift;
    @{$self->links} = grep { ! $_->has_node($n1) } @{$self->links};
    $self->delete_references_for_node($n1);
}
sub garbage_collector
{
    my $self = shift;
    my $query = shift;
    my @new = ();
    for(@{$self->links})
    {
        if(! $query->($_))
        {
            push @new, $_;
        }
        else
        {
            $self->delete_references($_->node1, $_->node2);
        }
    }
    @{$self->links} = @new;