File Coverage

blib/lib/Graph/MoreUtils/Replace.pm

Criterion	Covered	Total	%
statement	9	21	42.8
branch	0	8	0.0
condition	0	6	0.0
subroutine	3	4	75.0
pod	0	1	0.0
total	12	40	30.0

package Graph::MoreUtils::Replace;

# ABSTRACT: Replace one on more vertices with a given one.
our $VERSION = '0.3.0'; # VERSION

use strict;
use warnings;

use Set::Object qw( set );

sub replace
{
    my( $graph, $new, @old ) = @_;

    $graph->add_vertex( $new );

    my $old = set( @old );
    for my $edge (grep { ($old->has( $_->[0] ) && !$old->has( $_->[1] )) ||
                         ($old->has( $_->[1] ) && !$old->has( $_->[0] )) }
                       $graph->edges) {
        my( $vertex, $neighbour ) = $old->has( $edge->[0] ) ? @$edge : reverse @$edge;
        next if $graph->has_edge( $new, $neighbour );
        $graph->add_edge( $new, $neighbour );
        next unless $graph->has_edge_attributes( @$edge );
        $graph->set_edge_attributes( $new, $neighbour, $graph->get_edge_attributes( @$edge ) );
    }
    $graph->delete_vertices( @old );

    return $graph;
}

1;