File Coverage

lib/GraphViz/Traverse.pm

Criterion	Covered	Total	%
statement	15	42	35.7
branch	0	10	0.0
condition	1	6	16.6
subroutine	5	10	50.0
pod	3	4	75.0
total	24	72	33.3

# $Id: Traverse.pm,v 1.8 2006/05/06 18:56:21 gene Exp $
package GraphViz::Traverse;
use strict;
use warnings;
use base qw( GraphViz );
use Carp;
our $VERSION = '0.02';
our $AUTOLOAD;

sub new {
    my( $proto, %args ) = @_;
    my $class = ref( $proto ) || $proto;
    my $self = $proto->SUPER::new( %args );

    $self->{_DEBUG} = $args{_DEBUG};

    $self->{_attributes} = {
        ( map { 'node_' . $_ => undef } qw(
            color
            distortion
            fillcolor
            fixedsize
            fontcolor
            fontname
            fontsize
            height
            href
            label
            layer
            orientation
            peripheries
            regular
            shape
            sides
            skew
            style
            target
            tooltip
            URL
            width
        ) ),
        ( map { 'edge_' . $_ => undef } qw(
            arrowhead
            arrowsize
            arrowtail
            color
            constraint
            decorate
            dir
            fontcolor
            fontname
            fontsize
            headURL
            headclip
            headhref
            headlabel
            headtarget
            headtooltip
            href
            label
            labelangle
            labeldistance
            layer
            minlen
            port_label_distance
            samehead
            sametail
            style
            tailURL
            tailclip
            tailhref
            taillabel
            tailtooltip
            target
            tooltip
            URL
            weight
        ) )
    };

    bless $self, $class;
    return $self;
}

sub DESTROY {}

sub AUTOLOAD {
    my $self = shift;
    my $type = ref( $self ) || croak "$self is not an object";
    ( my $method = $AUTOLOAD ) =~ s/.*://;
    my $superior = "SUPER::$method";
    return exists $self->{_attributes}{$method}
        ? undef : $self->$superior(@_);
}

sub build_attributes {
    my( $self, $A, $B ) = @_;
    my $type = $B ? 'edge' : 'node';
    my %attributes = ();
    for my $method ( keys %{ $self->{_attributes} } ) {
        $self->{_attributes}{$method} = $B
            ? $self->$method( $A => $B )
            : $self->$method( $A );
    }
    return %{ $self->{_attributes} };
}

sub mark_item {
    my( $self, $node, $parent ) = @_;
    if( $parent ) {
        $self->add_edge( $parent => $node,
            $self->build_attributes( $node, $parent )
        );
    }
    else {
        $self->add_node( $node, $self->build_attributes( $node ) );
    }
}

sub traverse {
    my $self = shift;
    warn "traverse() must be overridden.\n" if $self->{_DEBUG};
    return undef;
}

1;

__END__