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;
