1 #!/usr/bin/perl

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

     3 #

     4 # (c) Peter 'grin' Gervai, 2012

     5 # Released under CreativeCommons-Attribution-ShareAlike-3.0-Unported

     6 #

     7 # create .dot from racktables links

     8 #

     9 

    10 use DBI;

    11 use Encode;

    12 

    13 # if 1 we do not list reserved port descriptions

    14 my $SKIP_RESERVATION_LABELS = 1;

    15 

    16 $|=1;

    17 

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

    19 

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

    21 

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

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

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

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

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

    27 &d("db ok");

    28 #########################################################################

    29 

    30 my $sth_links = $dbh->prepare("

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

    32  FROM RackObject AS ro1 

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

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

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

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

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

    38  ORDER BY obj1, port1");

    39 

    40 my $sth_reservations = $dbh->prepare("

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

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

    43  FROM RackObject AS ro

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

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

    46      WHERE p.reservation_comment IS NOT NULL

    47  ORDER BY obj1, port1");

    48 

    49 &d("Start query.");

    50 my $res = $sth_links->execute;

    51 

    52 &d("Fetch query.");

    53 my $a = $sth_links->fetchall_arrayref;

    54 my @data = @$a;

    55 

    56 if( !$SKIP_RESERVATION_LABELS ) {

    57       $res = $sth_reservations->execute;

    58       $a = $sth_reservations->fetchall_arrayref;

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

    60 } else {

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

    62 }

    63 

    64 # header

    65 print '

    66 graph rackspace_topo {

    67 

    68 label = "Tarr Racktables topo";

    69 rankdir = LR;

    70 

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

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

    73        

    74 ';

    75 

    76 

    77 # generate edges

    78 foreach $a (@data) {

    79   # node+interface 1

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

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

    82   # node+interface 2

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

    84   # 

    85   push @link, $a;

    86 }

    87 

    88 # output the nods first

    89 foreach my $n (keys %node) {

    90   # nodes with empty or "space" names

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

    92 

    93   $ntyp = $nodetype{$n};

    94 

    95   # color/style depends on node type

    96   my $color="";

    97   if( $ntyp eq "Server" ) {

    98     $color='color="black"';

    99     

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

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

   102     

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

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

   105     

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

   107     $color='color="lightblue"';

   108     

   109   } elsif( $ntyp eq "MediaConverter" ) {

   110     $color='color="gold"';

   111     

   112   } elsif( $ntyp eq "Router" ) {

   113     $color='color="darkgreen"';

   114     

   115   } else {

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

   117     

   118   }

   119   

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

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

   122 }

   123 

   124 # and print the edges

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

   126   my $l = $link[$i];

   127   # skip empty...

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

   129 

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

   131     # skip duplicate

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

   133   } else {

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

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

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

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

   138   }

   139 }

   140 

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

   142 

   143 

   144 # generate random html colors

   145 sub gen_color {

   146   my $c = "#";

   147   for (1..3) {

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

   149   }

   150   return $c;

   151 }

   152 

   153 

   154 sub d {

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

   156 }