#!/usr/bin/perl

##$Id: dottr.pl,v ac49839c1b85 2014/10/03 12:46:32 grin $

#

# (c) Peter 'grin' Gervai, 2012-2014

# Released under CreativeCommons-Attribution-ShareAlike-4.0

#

# create .dot from racktables links

#

#  ./dottr.pl > map.dot

#

# create graphic from dot: 

#  dot -Tpng -o map.png map.dot

#  dot -Tsvg -o map.svg map.dot

use DBI;

use Encode;

# if 1 we do not list reserved port descriptions

my $SKIP_RESERVATION_LABELS = 1;

$|=1;

use DatabaseLoginData; # $db_user; $db_pw; $db_host

my ($db_name, $db_port) = ("racktables_db", 3306);

&d("connect db dbi:mysql:database=$db_name;host=$DatabaseLoginData::db_host;port=$db_port");

my $dbh = DBI->connect( "dbi:mysql:database=$db_name;host=$DatabaseLoginData::db_host;port=$db_port",

                           $DatabaseLoginData::db_user, $DatabaseLoginData::db_pw, 

                           { RaiseError =>1, AutoCommit => 1 } );

$dbh->do('set names utf8');	# from Alexandr Alakin

&d("db ok");

#########################################################################

my $sth_links = $dbh->prepare("

SELECT ro1.name AS obj1, p1.name AS port1, Link.cable, p2.name AS port2, ro2.name AS obj2, d.dict_value AS obj1type

 FROM RackObject AS ro1 

   JOIN Port AS p1 ON(ro1.id=p1.object_id)

   JOIN Link       ON(p1.id=Link.porta)

   JOIN Port AS p2 ON(Link.portb=p2.id)

   JOIN RackObject AS ro2 ON(p2.object_id=ro2.id)

   LEFT JOIN Dictionary AS d ON(ro1.objtype_id=d.dict_key)

 ORDER BY obj1, port1");

my $sth_reservations = $dbh->prepare("

SELECT ro.name AS obj1, p.name AS port1, 'RESERVE' AS cable, '' AS port2, 

 CONCAT(reservation_comment,' #',ROUND(RAND()*1000))  AS obj2,  d.dict_value AS obj1type

 FROM RackObject AS ro

   JOIN Port AS p  ON(ro.id=p.object_id)

   LEFT JOIN Dictionary AS d ON(ro.objtype_id=d.dict_key)

     WHERE p.reservation_comment IS NOT NULL

 ORDER BY obj1, port1");

&d("Start query.");

my $res = $sth_links->execute;

&d("Fetch query.");

my $a = $sth_links->fetchall_arrayref;

my @data = @$a;

if( !$SKIP_RESERVATION_LABELS ) {

      $res = $sth_reservations->execute;

      $a = $sth_reservations->fetchall_arrayref;

      @data = (@data, @$a);

} else {

      print STDERR "Skipping reservation label mapping.\n";

}

# header

print '

graph rackspace_topo {

label = "Tarr Racktables topo";

rankdir = LR;

       edge [ color="#0000a0", decorate=true, fontsize=9, headclip=false ];

       node [ shape=box, headport=n, tailport=n ];

';

# generate edges

foreach $a (@data) {

  # node+interface 1

  $node{$a->[0]} = $a->[1];

  $nodetype{$a->[0]} = $a->[5];

  # node+interface 2

  $node{$a->[4]} = $a->[3];

  # 

  push @link, $a;

}

# output the nods first

foreach my $n (keys %node) {

  # nodes with empty or "space" names

  next if $n =~ /^\s*$/;

  $ntyp = $nodetype{$n};

  # color/style depends on node type

  my $color="";

  if( $ntyp eq "Server" ) {

    $color='color="black"';

  } elsif( $ntyp eq "Network switch" ) {

    $color='color="red" style="bold"';

  } elsif( $ntyp eq "Server chassis" ) {

    $color='color="blue" style="dotted"';

  } elsif( $ntyp eq "Network chassis" ) {

    $color='color="lightblue"';

  } elsif( $ntyp eq "MediaConverter" ) {

    $color='color="gold"';

  } elsif( $ntyp eq "Router" ) {

    $color='color="darkgreen"';

  } else {

    #$color='color="pink"';			# Barbie syndrome FTW

  }

  print '"' . $n . "\" [ $color ];\n";

  if( !defined($node_color{$n}) ) { $node_color{ $n } = &gen_color; }

}

# and print the edges

foreach my $i (0 .. $#link) {

  my $l = $link[$i];

  # skip empty...

  next if $l->[0] =~ /^\s*$/;

  if( defined( $link{ $l->[0] }{ $l->[4] } ) && $link{ $l->[0] }{ $l->[4] } == $l->[2] ) {

    # skip duplicate

    # if you need warnings... here you can.

  } else {

#    print '"', $l->[0], '" -- "', $l->[4], '" [ label="', $l->[2], "\" color=\"grey\"];\n";

    my $color = $node_color{ $l->[0] } or 'grey';

    print '"', $l->[0], '" -- "', $l->[4], '" [ label="', $l->[2], "\" color=\"$color\"];\n";

    $link{ $l->[0] }{ $l->[4] } = $l->[2];

  }

}

print "\n};\n\n";

# generate random html colors

sub gen_color {

  my $c = "#";

  for (1..3) {

    $c .= sprintf "%02x", rand(256);

  }

  return $c;

}

sub d {

  print STDERR scalar(localtime), ' [$$] ', (shift), "\n";

}