inpath2dot.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # $Id: inpath2dot.pl,v 1.3 2001/08/28 19:21:23 cord Exp $
   4 #
   5 # DESCRIPTION: inpath2dot.pl - parses inpath-data to a format usuable by graphviz
   6 #
   7 # Copyright (C) 2001 Cord Beermann
   8 #
   9 # URL: http://Cord.de/tools/news/
  10 #
  11 # AUTHOR: Cord Beermann (Cord@Wunder-Nett.org)
  12 #
  13 # This software is inspired by
  14 # sig2dot v0.9 (c) Darxus@ChaosReigns.com, released under the GPL
  15 # Download from: http://www.chaosreigns.com/debian-keyring
  16 #
  17 # to use this script you'll need
  18 # * perl V5 to run this script
  19 # * inpath-output (inpath can be found in the  contrib-directory of inn, or
  20 #   at http://sites.inka.de/bigred/sw/ninpaths-3.1.1.tar.gz)
  21 # * graphviz (http://www.research.att.com/sw/tools/graphviz/ or
  22 #   http://www.graphviz.org/)
  23 #
  24 # This program is free software; you can redistribute it and/or modify it
  25 # under the terms of the GNU General Public License as published by the Free
  26 # Software Foundation; either version 2 of the License, or (at your option)
  27 # any later version.
  28 #
  29 # This program is distributed in the hope that it will be useful, but WITHOUT
  30 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  31 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
  32 # more details.
  33
  34 # You should have received a copy of the GNU General Public License along with
  35 # this program; if not, write to the Free Software Foundation, Inc., 59 Temple
  36 # Place - Suite 330, Boston, MA 02111-1307, USA.
  37
  38 # A Perl script is "correct" if it gets the job done before your boss fires
  39 # you.
  40 #   -- 'Programming Perl Second Edition'
  41 #       by Larry Wall, Tom Christiansen & Randal L. Schwartz
  42
  43 # If you have to remove this, read the README!
  44 require 5.002;
  45 use vars qw($opt_C $opt_f $opt_h $opt_p $opt_s $opt_V $opt_w);
  46 use Getopt::Std;
  47
  48 getopts('Cf:hps:Vw:');
  49
  50 $VERSION='inpath2dot.pl $Revision: 1.3 $';
  51
  52 $COPYRIGHT='Copyright (C) 2001 Cord Beermann.
  53 inpath2dot.pl comes with ABSOLUTELY NO WARRANTY. It is free software, and you
  54 are welcome to redistribute it under certain conditions. See source for details.
  55 Homepage: http://cord.de/tools/news/';
  56
  57 $USAGE='Usage: cat inpath.data | ' . $0 . ' [switches] > inpath.dot
  58 (neato -Tps inpath.dot > inpath.neato.dot.ps)
  59 (dot -Tps inpath.dot > inpath.dot.dot.ps)
  60
  61 -f n       factor (defines how verbose the graphic will be. Defaults to 1.)
  62
  63 -w pattern watch (perl-regexp-pattern to highlight in the result)
  64 -s pattern skip (perl-regexp-pattern to ignore in the result)
  65
  66 -p         pedantic (activates some sanity-checks)
  67
  68 -C         copyright (prints the copyright)
  69 -h         help    (prints out this message)
  70 -V         Version (prints version-info)
  71 ';
  72
  73 print("$USAGE\n\n$COPYRIGHT\n\n") if ($opt_h);
  74 print("$COPYRIGHT\n\n") if ($opt_C);
  75 print("$VERSION\n\n$COPYRIGHT\n\n") if ($opt_V);
  76
  77 exit 0 if (($opt_h) or ($opt_C) or ($opt_V));
  78
  79 $opt_f = 1 unless ($opt_f);
  80 $opt_w = '______' unless ($opt_w);
  81 $opt_s = '_' unless ($opt_s);
  82
  83 while ($line = <STDIN>) {
  84   chomp $line;
  85   if ($line =~ /^ZCZC begin inhosts [\d\.]+ (\S+) \d+ (\d+) [\d\.]+$/) {
  86     $reporting_host=$1;
  87     $reported_articles=$2;
  88     $reporting_hosts{$reporting_host} = 1;
  89     while ($line = <STDIN>) {
  90       chomp $line;
  91       last if ($line =~ /^ZCZC end inhosts $reporting_host$/);
  92       if ($line =~ /^(\d+)\s+(\S+)$/) {
  93         ($count, $host) = split(/\s+/, $line);
  94         next if ($host eq $reporting_host and defined($opt_p));
  95         next if ($host =~ /^$opt_s$/);
  96         $host{$host} += $count
  97           unless (($count / $reported_articles) >= .99 and defined($opt_p));
  98       }
  99       die("$0: garbled input file: $line\n") if ($line =~ /^ZCZC/);
 100     }
 101   } elsif ($line =~ /^ZCZC begin inpaths [\d\.]+ (\S+) \d+ \d+ [\d\.]+$/) {
 102     $reporting_host=$1;
 103     while ($line = <STDIN>) {
 104       chomp $line;
 105       last if ($line =~ /^ZCZC end inpaths $reporting_host$/);
 106 #      print STDERR "skipping: $line\n" unless $line =~ /^\S+ H (\d+ Z \S+ U )+$/;
 107       next unless $line =~ /^\S+ H (\d+ Z \S+ U )+$/;
 108       ($to_host, $rest) = split(/ H /, $line);
 109       next if ($to_host eq $reporting_host and defined($opt_p));
 110       next if ($to_host =~ /^$opt_s$/);
 111       @from_hosts = split(/ U /, $rest);
 112       foreach $from_host (@from_hosts) {
 113         next if ($from_host eq $reporting_host and defined($opt_p));
 114         ($count, $from_host2) = split(/ Z /, $from_host);
 115         next if ($from_host2 eq $to_host and defined($opt_p));
 116         next if ($from_host2 =~ /^$opt_s$/);
 117         $peer{"\"$from_host2\"" . " -> " . "\"$to_host\""} += $count
 118           unless (($count / $reported_articles) >= .99 and defined($opt_p));
 119         if ($to_host =~ /$opt_w/i) {
 120           $peers{$from_host2} = 1;
 121         }
 122       }
 123       die("$0: garbled input file: $line\n") if ($line =~ /^ZCZC/);
 124     }
 125   }
 126 }
 127
 128 print "digraph \"news relations\" {\n";
 129
 130 print "node [style=filled]\n";
 131 $number=0;
 132 for $name (sort {$host{$b} <=> $host{$a}} keys %host) {
 133   ($hue,$sat,$val)=(360,0,101);
 134   $number++;
 135   if ($name =~ /$opt_w/i) {
 136     ($hue,$sat,$val)=(0,20,100);
 137   } elsif (defined($reporting_hosts{$name})) {
 138     ($hue,$sat,$val)=(240,20,100);
 139   } elsif (defined($peers{$name})) {
 140     ($hue,$sat,$val)=(120,20,100);
 141   }
 142   if ($number <= $opt_f) {
 143     if ($hue == 360) {
 144       $val -= 80;
 145     } else {
 146       $sat += 80;
 147     }
 148   } elsif ($number <= ($opt_f)) {
 149     if ($hue == 360) {
 150       $val -= 60;
 151     } else {
 152       $sat += 60;
 153     }
 154   } elsif ($number <= ($opt_f * 2)) {
 155     if ($hue == 360) {
 156       $val -= 40;
 157     } else {
 158       $sat += 40;
 159     }
 160   } elsif ($number <= ($opt_f * 4)) {
 161     if ($hue == 360) {
 162       $val -= 20;
 163     } else {
 164       $sat += 20;
 165     }
 166   }
 167   printf "\"%s\" [label=\"%s\\n%d\" color=black fillcolor=\"%f %f %f\"]\n", $name, $name, $host{$name}, $hue / 360, $sat /100 , $val /100 unless ($val == 101);
 168 }
 169 print "node [style=solid]\n";
 170
 171 $number = 0;
 172 for $peering (sort {$peer{$b} <=> $peer{$a}} keys %peer) {
 173   $number++;
 174   if ($number <= ($opt_f * 5)) {
 175     $style='bold';
 176   } elsif ($number <= ($opt_f * 10)) {
 177     $style='solid';
 178   } elsif ($number <= ($opt_f * 20)) {
 179     $style='dashed';
 180   } elsif ($number <= ($opt_f * 40)) {
 181     $style='dotted';
 182   } elsif ($peering =~ /$opt_w/i) {
 183     $style='dotted';
 184   } else {
 185     next;
 186   }
 187   print "$peering [label=$peer{$peering} weight=$peer{$peering} minlen=3 style=$style]\n";
 188 }
 189
 190 print "}\n";