File Coverage

lib/Graph/Convert.pm

Criterion	Covered	Total	%
statement	101	104	97.1
branch	33	38	86.8
condition	4	11	36.3
subroutine	8	9	88.8
pod	4	4	100.0
total	150	166	90.3

############################################################################
# Convert between Graph::Easy and Graph.
#
#############################################################################

package Graph::Convert;

use 5.008001;
use Graph::Easy;
use Graph;

$VERSION = '0.09';

use strict;

#############################################################################
# conversion

sub _add_basics
  {
  # Add the graph and class attributes from $in to $out
  # Add all the nodes
  # Add the groups as pseudo_attributes to the graph (so we can recover them)
  my ($self, $in, $out) = @_;

  # add the graph attributes
  my $att = $in->{att};

  for my $class (keys %$att)
    {
    my $c = $att->{$class};
    for my $attr (keys %$c)
      {
      $out->set_graph_attribute($class.'_'.$attr, $c->{$attr});
      }
    }

  # add all nodes (sorted by ID so we can workaround the bug in Graph
  # for undirected graphs)
  for my $n (sort { $a->{id} <=> $b->{id} } $in->nodes())
    {
    # the node name is unique, so we can use it as the "vertex id"
    $out->add_vertex($n->{name});
    my $attr = $n->raw_attributes();
    # store also the node's group
    my $ng = $n->group();
    if (defined $ng)
      {
      $attr->{group} = $ng->name();
      }
    $out->set_vertex_attributes($n->{name}, $attr);
    }

  # add all groups as a special attribute list
  for my $g ($in->groups())
    {
    my $attr = $g->raw_attributes();
    # "group_" is already used by the class attribute
    my $prefix = 'grp_' . $g->id() . '_';
    # store the group name, too
    $out->set_graph_attribute($prefix.'name', $g->name());
    my $group_group = $g->group();
    if (defined $group_group)
      {
      $out->set_graph_attribute($prefix.'group', $group_group->name());
      }
    for my $k (keys %$attr)
      {
      $out->set_graph_attribute($prefix.$k, $attr->{$k});
      }
    }

  $out;
  }

#############################################################################
# from Graph::Easy to Graph:

sub as_graph
  {
  # convert a Graph::Easy object to a Graph object
  my ($self, $in, $opt) = @_;

  $self->error(
    "as_graph needs a Graph::Easy object, but got '". ref($in). "'" )
   unless ref($in) && $in->isa('Graph::Easy');

  $opt = {} unless defined $opt;
  $opt->{undirected} = 1 if $in->attribute('type') eq 'undirected';

  return $self->as_multiedged_graph($in, $opt) unless $in->is_simple();

  my $out = Graph->new( %$opt );

  $self->_add_basics($in,$out);

  # add all edges
  for my $e ($in->edges())
    {
    my $from = $e->{from}->{name}; my $to = $e->{to}->{name};
    if ($opt->{undirected})
      {
      # swap the arguments to avoid creating a spurious edge
      ($from,$to) = ($to,$from) if $e->{to}->{id} < $e->{from}->{id};
      }
    my $edge = $out->add_edge($from,$to);
    my $attr = $e->raw_attributes();
    $out->set_edge_attributes($from, $to, $attr);
    }

  $out;
  }

sub as_undirected_graph
  {
  # convert a Graph::Easy object to an undirected Graph object
  my ($self, $in, $opt) = @_;

  $opt->{undirected} = 1;
  $self->as_graph($in,$opt);
  }

sub as_multiedged_graph
  {
  my ($self, $in, $opt) = @_;

  $self->error(
    "as_multiedged_graph needs a Graph::Easy object, but got '". ref($in). "'" )
   unless ref($in) && $in->isa('Graph::Easy');

  $opt = {} unless defined $opt;
  $opt->{multiedged} = 1;
  my $out = Graph->new( %$opt );

  $self->_add_basics($in,$out);

  # add all edges
  for my $e ($in->edges())
    {
    # Adding an edge more than once will result in a new ID
    my $from = $e->{from}->{name}; my $to = $e->{to}->{name};
    if ($opt->{undirected})
      {
      # swap the arguments to avoid creating a spurious edge
      ($from,$to) = ($to,$from) if $e->{to}->{id} < $e->{from}->{id};
      }
    my $id = $out->add_edge_get_id($from,$to);
    my $attr = $e->raw_attributes();
    $out->set_edge_attributes_by_id($from, $to, $id, $attr);
    }

  $out;
  }

#############################################################################
# from Graph to Graph::Easy:

sub as_graph_easy
  {
  # convert a Graph object to a Graph::Easy object
  my ($self,$in) = @_;

  $self->error(
    "as_graph_easy needs a Graph object, but got '". ref($in). "'" )
   unless ref($in) && $in->isa('Graph');

  my $out = Graph::Easy->new();

  my $group_ids = {};
  # restore the graph attributes (and create all the group objects)
  my $att = $in->get_graph_attributes();
  for my $key (keys %$att)
    {
    if ($key =~ /^grp_([0-9]+)_([A-Za-z_-]+)/)
      {
      my ($id,$a) = ($1,$2);
      # create the group unless we already created it
      if (!exists $group_ids->{$id})
        {
        my $group_name = $att->{"grp_${id}_name"} || 'unknown group name';
        $group_ids->{$id} = $out->add_group( $group_name );
        }
      my $grp = $group_ids->{$id};
      # set the attribute on the appropriate group object
      $grp->set_attribute($a, $att->{$key}) unless $a eq 'name';
      }
    next unless $key =~ /^((graph|(node|edge|group))(\.\w+)?)_(.+)/;

    my $class = $1; my $name = $5;

    $out->set_attribute($1,$5, $att->{$key});
    }

  for my $n ($in->vertices())
    {
    my $node = $out->add_node($n);
    my $attr = $in->get_vertex_attributes($n);
    $node->set_attributes($attr);
    }

  if ($in->is_multiedged())
    {
    # for multiedged graphs:
    for my $e ($in->unique_edges())
      {
      # get all the IDs in case of the edge existing more than once:
      my @ids = $in->get_multiedge_ids($e->[0], $e->[1]);
      for my $id (@ids)
        {
        my $edge = $out->add_edge($e->[0],$e->[1]);
        my $attr = $in->get_edge_attributes_by_id($e->[0], $e->[1], $id);
        $edge->set_attributes($attr);
        }
      }
    }
  else
    {
    # for simple graphs
    for my $e ($in->edges())
      {
      my $edge = $out->add_edge($e->[0],$e->[1]);
      my $attr = $in->get_edge_attributes($e->[0], $e->[1]);
      $edge->set_attributes($attr);
      }
    }
  $out->set_attribute('type','undirected') if $in->is_undirected();

  $out;
  }

1;
__END__