view release on metacpan or  search on metacpan

lib/App/Netdisco/Util/Graph.pm  view on Meta::CPAN

    # Count number of nodes in each subgraph
    my %S_count;
    for (my $i=0;$i< scalar @S;$i++){
        $S_count{$i} = scalar @{$S[$i]};
    }

    foreach my $subgraph (sort { $S_count{$b} <=> $S_count{$a} } keys %S_count){
        my $SUBG = $G->copy;
        print "\$S[$subgraph] has $S_count{$subgraph} nodes.\n";

        # Remove other subgraphs from this one
        my %S_notme = %S_count;
        delete $S_notme{$subgraph};
        foreach my $other (keys %S_notme){
            print "Removing Non-connected nodes: ",join(',',@{$S[$other]}),"\n";
            $SUBG->delete_vertices(@{$S[$other]})
        }

        # Create the subgraph
        my $timeout = defined $CONFIG{graph_timeout} ? $CONFIG{graph_timeout} : 60;

        eval {
            alarm($timeout*60);
            graph_each($SUBG,'');
            alarm(0);
        };
        if ($@) {
            if ($@ =~ /timeout/){
                print "! Creating Graph timed out!\n";
            } else {
                print "\n$@\n";
            }
        }

        # Facility to create subgraph for each non-connected network segment.
        # Right now, let's just make the biggest one only.
        last;
    }
}

=head1 EXPORT_OK

=over 4

=item graph_each($graph_obj, $name)

Generates subgraph. Does actual GraphViz calls.

=cut

sub graph_each  {
    my ($G, $name) = @_;
    my %CONFIG = %{ setting('graph') };
    info "Creating new Graph";

    my $graph_defs = {
                     'bgcolor' => $CONFIG{graph_bg}         || 'black',
                     'color'   => $CONFIG{graph_color}      || 'white',
                     'overlap' => $CONFIG{graph_overlap}    || 'scale',
                     'fontpath'=> _homepath('graph_fontpath',''),
                     'ranksep' => $CONFIG{graph_ranksep}    || 0.3,
                     'nodesep' => $CONFIG{graph_nodesep}    || 2,
                     'ratio'   => $CONFIG{graph_ratio}      || 'compress',
                     'splines' => ($CONFIG{graph_splines} ? 'true' : 'false'),
                     'fontcolor' => $CONFIG{node_fontcolor} || 'white',
                     'fontname'  => $CONFIG{node_font}      || 'lucon',
                     'fontsize'  => $CONFIG{node_fontsize}  || 12,
                     };
    my $edge_defs  = {
                     'color' => $CONFIG{edge_color}         || 'wheat',
                     };
    my $node_defs  = {
                     'shape'     => $CONFIG{node_shape}     || 'box',
                     'fillcolor' => $CONFIG{node_fillcolor} || 'dimgrey',
                     'fontcolor' => $CONFIG{node_fontcolor} || 'white',
                     'style'     => $CONFIG{node_style}     || 'filled',
                     'fontname'  => $CONFIG{node_font}      || 'lucon',
                     'fontsize'  => $CONFIG{node_fontsize}  || 12,
                     'fixedsize' => ($CONFIG{node_fixedsize} ? 'true' : 'false'),
                     };
    $node_defs->{height} = $CONFIG{node_height} if defined $CONFIG{node_height};
    $node_defs->{width}  = $CONFIG{node_width}  if defined $CONFIG{node_width};

    my $epsilon = undef;
    if (defined $CONFIG{graph_epsilon}){
        $epsilon = "0." . '0' x $CONFIG{graph_epsilon} . '1';
    }

    my %gv = (
               directed => 0,
               layout   => $CONFIG{graph_layout} || 'twopi',
               graph    => $graph_defs,
               node     => $node_defs,
               edge     => $edge_defs,
               width    => $CONFIG{graph_x}      || 30,
               height   => $CONFIG{graph_y}      || 30,
               epsilon  => $epsilon,
              );

    my $gv = GraphViz->new(%gv);

    my %node_map = ();
    my @nodes = $G->vertices;

    foreach my $dev (@nodes){
        my $node_name = graph_addnode($gv,$dev);
        $node_map{$dev} = $node_name;
    }

    my $root_ip = defined $CONFIG{root_device}
      ? (ipv4_from_hostname($CONFIG{root_device}) || $CONFIG{root_device})
      : undef;

    if (defined $root_ip and defined $node_map{$root_ip}){
        my $gv_root_name = $gv->_quote_name($root_ip);
        if (defined $gv_root_name){
            $gv->{GRAPH_ATTRS}->{root}=$gv_root_name;
        }
    }

    my @edges = $G->edges;

    while (my $e = shift @edges){
        my $link = $e->[0];
        my $dest = $e->[1];
        my $speed = $GRAPH_SPEED{$link}->{$dest}->{speed};

        if (!defined($speed)) {
            info "  ! No link speed for $link -> $dest";
            $speed = 0;
        }

        my %edge = ();
        my $val = ''; my $suffix = '';

        if ($speed =~ /^([\d.]+)\s+([a-z])bps$/i) {
            $val = $1; $suffix = $2;
        }