File Coverage

blib/lib/Map/Tube/GraphViz.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Map::Tube::GraphViz;

# Pragmas.
use strict;
use warnings;

# Modules.
use Class::Utils qw(set_params);
use English;
use Error::Pure qw(err);
use GraphViz2;
use List::MoreUtils qw(none);
use Map::Tube::GraphViz::Utils qw(node_color);
use Scalar::Util qw(blessed);

# Version.
our $VERSION = 0.06;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Edge callback.
	$self->{'callback_edge'} = sub {
		my ($self, $from, $to) = @_;
		$self->{'g'}->add_edge(
			'from' => $from,
			'to' => $to,
		);
		return;
	};

	# Node callback.
	$self->{'callback_node'} = \&node_color;

	# Driver.
	$self->{'driver'} = 'neato';

	# Name of map.
	$self->{'name'} = undef;

	# GraphViz2 object.
	$self->{'g'} = undef;

	# Output.
	$self->{'output'} = 'png';

	# Map::Tube object.
	$self->{'tube'} = undef;

	# Process params.
	set_params($self, @params);

	# Check Map::Tube object.
	if (! defined $self->{'tube'}) {
		err "Parameter 'tube' is required.";
	}
	if (! defined &UNIVERSAL::DOES) {
		eval {
			require UNIVERSAL::DOES;
		};
		if ($EVAL_ERROR) {
			err 'Cannot load UNIVERSAL::DOES module.';
		}
	}
	if (! blessed($self->{'tube'})
		|| ! $self->{'tube'}->DOES('Map::Tube')) {

		err "Parameter 'tube' must be 'Map::Tube' object.";
	}

	# GraphViz2 object.
	if (defined $self->{'g'}) {
		if (defined $self->{'name'}) {
			err "Parameter 'name' cannot be used with ".
				"'g' parameter.";
		}

		# Check GraphViz2 object.
		if (! blessed($self->{'g'})
			|| ! $self->{'g'}->isa('GraphViz2')) {

			err "Parameter 'g' must be 'GraphViz2' object.";
		}
	} else {
		my $name = $self->{'name'};
		if (! defined $name) {
			$name = $self->{'tube'}->name;
		}
		$self->{'g'} = GraphViz2->new(
			'global' => {
				'directed' => 0,
			},
			$name ? (
				'graph' => {
					'label' => $name,
					'labelloc' => 'top',
				},
			) : (),
		);
	}

	# Check output format.
	if (! defined $self->{'output'}) {
		err "Parameter 'output' is required.";
	}
	if (none { $self->{'output'} eq $_ }
		keys %{$self->{'g'}->valid_attributes->{'output_format'}}) {

		err "Unsupported 'output' parameter '$self->{'output'}'.";
	}

	# Object.
	return $self;
}

# Get graph.
sub graph {
	my ($self, $output_file) = @_;
	foreach my $node (values %{$self->{'tube'}->nodes}) {
		$self->{'callback_node'}->($self, $node);
	}
	my @processed;
	foreach my $node (values %{$self->{'tube'}->nodes}) {
		foreach my $link (split m/,/ms, $node->link) {
			if (none {
				($_->[0] eq $node->id && $_->[1] eq $link)
				||
				($_->[0] eq $link && $_->[1] eq $node->id)
				} @processed) {

				$self->{'callback_edge'}->($self, $node->id,
					$link);
				push @processed, [$node->id, $link];
			}
		}
	}
	eval {
		$self->{'g'}->run(
			'driver' => $self->{'driver'},
			'format' => $self->{'output'},
			'output_file' => $output_file,
		);
	};
	if ($EVAL_ERROR) {
		err 'Cannot create GraphViz output.',
			'Error', $EVAL_ERROR,
			'Dot input', $self->{'g'}->dot_input;
	}
	return;
}

1;

__END__