#!/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";
}