libdeps-perl 0.13-1.1 / usr / share / perl5 / graphincludes / graph / grouped.pm

# This file is part of the DEPS/graph-includes package
#
# (c) 2006 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.

package graphincludes::graph::grouped;
use strict;
use warnings;

use base qw(graphincludes::graph);
use Set::Object qw();
use Hash::Util qw(lock_keys unlock_keys);
use Carp qw(croak);

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);

  unlock_keys (%$self);
  $self->{_REVGROUP} = undef;

  bless ($self, $class);
  lock_keys (%$self);
  return $self;
}

sub register_group_member {
  my $self = shift;
  my ($group, $member) = @_;

  if (defined $self->{_REVGROUP}{$member}) {
    # already registered: sanity check
    croak "Node '$member->{LABEL}' already member of group '$self->{_REVGROUP}{$member}{LABEL}'"
      if $self->{_REVGROUP}{$member} ne $group;
  } else {
    # do register
    $self->{_REVGROUP}{$member} = $group;
  }
}

sub who_contains {
  my $self = shift;
  my ($member) = @_;

  $self->{_REVGROUP}{$member};
}

sub register_intragroup_edge {
  my $self = shift;
  my ($group, $edge) = @_;

  $group->{intraedges} = new Set::Object
    unless defined $group->{intraedges};

  $group->{intraedges}->insert($edge);
}

1;