# HG changeset patch
# User Peter Gervai <grin@grin.hu>
# Date 1412341277 -7200
# Node ID 26fed0d59d7ceb91cb2eccfa7a5fa02aeee66f0e
# Parent  624a9ab34425b79b4ecf4131713afd371e65e5ac
Add dottr.pl, a Racktables topology to GraphViz converter

diff -r 624a9ab34425 -r 26fed0d59d7c dottr.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/dottr.pl	Fri Oct 03 15:01:17 2014 +0200
@@ -0,0 +1,156 @@
+#!/usr/bin/perl
+##$Id: dottr.pl,v ac49839c1b85 2014/10/03 12:46:32 grin $
+#
+# (c) Peter 'grin' Gervai, 2012
+# Released under CreativeCommons-Attribution-ShareAlike-3.0-Unported
+#
+# create .dot from racktables links
+#
+
+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";
+}