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