File Coverage

blib/lib/Graph/SomeUtils.pm

Criterion	Covered	Total	%
statement	30	41	73.1
branch	2	2	100.0
condition			n/a
subroutine	9	12	75.0
pod	7	7	100.0
total	48	62	77.4

package Graph::SomeUtils;

use 5.012000;
use strict;
use warnings;
use base qw(Exporter);
use Graph;

our $VERSION = '0.02';

our %EXPORT_TAGS = ( 'all' => [ qw(
	graph_delete_vertices_fast
  graph_delete_vertex_fast
  graph_all_successors_and_self
  graph_all_predecessors_and_self
  graph_vertices_between
  graph_get_vertex_label
  graph_set_vertex_label
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
);

sub graph_get_vertex_label {
  my ($g, $v) = @_;
  return $g->get_vertex_attribute($v, 'label');
}

sub graph_set_vertex_label {
  my ($g, $v, $label) = @_;
  $g->set_vertex_attribute($v, 'label', $label);
}

sub graph_delete_vertex_fast {
  my $g = shift;
  $g->expect_non_unionfind;
  my $V = $g->[ Graph::_V ];
  return $g unless $V->has_path( @_ );
  $g->delete_edge($_[0], $_) for $g->successors($_[0]);
  $g->delete_edge($_, $_[0]) for $g->predecessors($_[0]);
  $V->del_path( @_ );
  $g->[ Graph::_G ]++;
  return $g;
}

sub graph_delete_vertices_fast {
  my $g = shift;
  graph_delete_vertex_fast($g, $_) for @_;
}

sub graph_vertices_between {
  my ($g, $src, $dst) = @_;
  my %from_src;

  $from_src{$_}++ for graph_all_successors_and_self($g, $src);

  return grep {
    $from_src{$_}
  } graph_all_predecessors_and_self($g, $dst);
}

sub graph_all_successors_and_self {
  my ($g, $v) = @_;
  return ((grep { $_ ne $v } $g->all_successors($v)), $v);
}

sub graph_all_predecessors_and_self {
  my ($g, $v) = @_;
  return ((grep { $_ ne $v } $g->all_predecessors($v)), $v);
}

1;

__END__