Listing 1 db2dot

#!/usr/bin/perl

package main;

use strict;
use warnings;
$|++;

use GraphViz;
use NetAddr::IP;
use Getopt::Std;
use lib 'scripts';
use MyConfigCDBI;
require nodes;

use vars qw/%device_node %interface_node %subnet_node %if_edge
%subnet_node %sighting_edge %endpoint_node %addr_edge %graph_options
%addr_edge %assignment_edge $opt_3 $opt_e $opt_E $opt_s $opt_S $opt_d
$opt_D $opt_h $opt_i $opt_I $opt_N $opt_n $opt_v $opt_V/;

getopts('3d:D:e:E:hi:I:s:S:Nnv:V:');

die <<DIE if $opt_h;
db2dot [opts]

Where opts is up to one of

  -h: This help screen
  -d regexp: Perl regexp that the device must match to be added
  -D regexp: If the device matches this endpoint, is not added
  -e regexp: Perl regexp that the endpoint name must match to be added
  -E regexp: If the endpoint matches this regexp, is not added
  -i regexp: Perl regexp that the interface name must match to be added
  -I regexp: If the interface matches this regexp, is not added
  -s regexp: Perl regexp that the os of the endpoint must match to be added
  -S regexp: If the os matches this regexp, is not added
  -v regexp: Perl regexp that the vendor of the endpoint must match to be added
  -V regexp: If the vendor matches this regexp, is not added
  -3: Only include interfaces with IP addresses
  -n: Do not include subnets in the diagrams
  -N: Include only subnets with endpoints
  

DIE
    ;

my $g = GraphViz->new(%graph_options);
MyConfig::CDBI->connection('dbi:SQLite:dbname=config.db');

my %dev = ();
my %int = ();
my %eps = ();
my %subnets = ();
my %sightings = ();
my %assignments = ();

sub _ifname ($) { $_[0]->device . '|' . $_[0]->interface }

sub _store_dev
{
    my $dev = shift;
    return if exists $dev{$dev->device};
    $dev{$dev->device} = $dev;
}

sub _store_ep
{
    my $ep = shift;
    return if exists $eps{$ep};
    $eps{$ep} = $ep;
}

sub _store_int
{
    my $int = shift;
    my $l3 = shift;
    return if exists $int{_ifname $int};
    my @addrs = MyConfig::CDBI::Address->search
    (
     interface => $int->interface,
     device => $int->device,
    );
    return if $l3 and !@addrs;
    $int{_ifname $int} = { if => $int, addr => \@addrs };
}

if ($opt_d)
{
    for my $dev (MyConfig::CDBI::Device->retrieve_all)
    {
    next unless $dev->device =~ m/$opt_d/i;
    if ($opt_D) { next if $dev->device =~ m/$opt_D/i }
    _store_dev($dev);

    for my $ifs ($dev->interfaces)
    {
        if ($opt_i) { next unless $ifs->interface =~ m/$opt_i/i }
        if ($opt_I) { next if $ifs->interface =~ m/$opt_I/i }
        _store_int($ifs, $opt_3);
    }
    }
}

if ($opt_e or $opt_s or $opt_v)
{
    for my $ep (MyConfig::CDBI::Endpoint->retrieve_all)
    {
    if ($opt_e) { next unless $ep->endpoint =~ m/$opt_e/i }
    if ($opt_s) { next unless $ep->os and $ep->os =~ m/$opt_s/i }
    if ($opt_v) { next unless $ep->vendor and $ep->vendor =~ m/$opt_v/i }
    if ($opt_E) { next if $ep->endpoint =~ m/$opt_E/i }
    if ($opt_S) { next if $ep->os and $ep->os =~ m/$opt_S/i }
    if ($opt_V) { next if $ep->vendor and $ep->vendor =~ m/$opt_V/i }

    _store_ep($ep);

    for my $sight ($ep->all_sightings({order_by => 'time DESC'}))
    {
        $sightings{$ep}->{_ifname $sight} ||= [ $sight, 0 ];
        $sightings{$ep}->{_ifname $sight}->[1]++;
        _store_dev($sight->device);
        _store_int(MyConfig::CDBI::Interface->retrieve(
               interface => $sight->interface,
               device => $sight->device,
               ), 0);
    }

    for my $assign ($ep->all_assignments({order_by => 'time DESC'}))
    {
        $assignments{$ep}->{$assign->ip} ||= [ $assign, 0 ];
        $assignments{$ep}->{$assign->ip}->[1]++;
    }
    }
}

unless ($opt_n)
{
    unless ($opt_N)
    {
    for my $if (keys %int)
    {
        for my $a (@{$int{$if}->{addr}})
        {
        my $sn = $a->cidr;
        if ($sn) { $subnets{$sn->cidr} = $sn }
        else { 
            warn "Missing or unknown subnet from interface $if...\n";
        }
        }
    }
    }
    
    for my $ep (keys %assignments)
    {
    for my $ip (keys %{$assignments{$ep}})
    {
        my $sn = $assignments{$ep}->{$ip}->[0]->cidr;
        if ($sn) { $subnets{$sn->cidr} = $sn }
        else { warn "Missing or unknown subnet from assignment ", 
           $assignments{$ep}->{$ip}->[0], "...\n" }
    }
    }

    $g->add_node($_, label => $_, %subnet_node)
    for keys %subnets;
}

$g->add_node($_, label => $dev{$_}->device, dev_image($dev{$_}->class),
         %device_node) 
    for keys %dev;

for my $if (keys %int)
{
    $g->add_node($if, label => $int{$if}->{if}->interface, %interface_node);
    $g->add_edge($int{$if}->{if}->device => $if,
         ($int{$if}->{if}->description ? 
          (label => $int{$if}->{if}->description) : ()),
         %if_edge);
    unless ($opt_n)
    {
    for my $a (@{$int{$if}->{addr}})
    {
        next if $opt_N and not exists $subnets{$a->get('cidr')};
        $g->add_edge($if => $a->get('cidr') || '?',
             label => NetAddr::IP->new($a->ip)->addr,
             %addr_edge);
    }
    }
}

for my $ep (keys %eps)
{
    $g->add_node($ep, label => $eps{$ep}->endpoint . "\n" . $eps{$ep}->vendor, 
         %endpoint_node);
    if (exists $sightings{$ep})
    {
    my $sight = $sightings{$ep};
    for my $if (keys %$sight)
    {
        $g->add_edge(
        $ep => $if,
        label => $sight->{$if}->[1] . "x " 
        . scalar(localtime($sight->{$if}->[0]->time)),
        %sighting_edge
        );
    }
    }

    if (!$opt_n and exists $assignments{$ep})
    {
    my $assign = $assignments{$ep};
    for my $a (keys %$assign)
    {
        $g->add_edge(
        $ep => $assign->{$a}->[0]->get('cidr') || '?',
        label => $assign->{$a}->[1] . "x " 
        . NetAddr::IP->new($assign->{$a}->[0]->ip)->addr,
        %assignment_edge
        );
    }
    }
}

print $g->as_debug;