inpath2dot.pl downloaded

diff --git a/inpath2dot.pl b/inpath2dot.pl
new file mode 100755 (executable)
index 0000000..2b6edaa
--- /dev/null
+++ b/inpath2dot.pl
@@ -0,0 +1,190 @@
+#!/usr/bin/perl -w 
+#
+# $Id: inpath2dot.pl,v 1.3 2001/08/28 19:21:23 cord Exp $
+#
+# DESCRIPTION: inpath2dot.pl - parses inpath-data to a format usuable by graphviz
+#
+# Copyright (C) 2001 Cord Beermann
+#
+# URL: http://Cord.de/tools/news/
+#
+# AUTHOR: Cord Beermann (Cord@Wunder-Nett.org)
+# 
+# This software is inspired by 
+# sig2dot v0.9 (c) Darxus@ChaosReigns.com, released under the GPL
+# Download from: http://www.chaosreigns.com/debian-keyring
+#
+# to use this script you'll need
+# * perl V5 to run this script
+# * inpath-output (inpath can be found in the  contrib-directory of inn, or
+#   at http://sites.inka.de/bigred/sw/ninpaths-3.1.1.tar.gz)
+# * graphviz (http://www.research.att.com/sw/tools/graphviz/ or
+#   http://www.graphviz.org/)
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+# more details.
+
+# You should have received a copy of the GNU General Public License along with
+# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+# Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# A Perl script is "correct" if it gets the job done before your boss fires
+# you.
+#   -- 'Programming Perl Second Edition'
+#       by Larry Wall, Tom Christiansen & Randal L. Schwartz
+
+# If you have to remove this, read the README!
+require 5.002;
+use vars qw($opt_C $opt_f $opt_h $opt_p $opt_s $opt_V $opt_w);
+use Getopt::Std;
+
+getopts('Cf:hps:Vw:');
+
+$VERSION='inpath2dot.pl $Revision: 1.3 $';
+
+$COPYRIGHT='Copyright (C) 2001 Cord Beermann.
+inpath2dot.pl comes with ABSOLUTELY NO WARRANTY. It is free software, and you
+are welcome to redistribute it under certain conditions. See source for details.
+Homepage: http://cord.de/tools/news/';
+
+$USAGE='Usage: cat inpath.data | ' . $0 . ' [switches] > inpath.dot
+(neato -Tps inpath.dot > inpath.neato.dot.ps)
+(dot -Tps inpath.dot > inpath.dot.dot.ps)
+
+-f n      factor (defines how verbose the graphic will be. Defaults to 1.)
+
+-w pattern watch (perl-regexp-pattern to highlight in the result)
+-s pattern skip (perl-regexp-pattern to ignore in the result)
+
+-p        pedantic (activates some sanity-checks)
+
+-C         copyright (prints the copyright)
+-h         help    (prints out this message)
+-V         Version (prints version-info)
+';
+
+print("$USAGE\n\n$COPYRIGHT\n\n") if ($opt_h);
+print("$COPYRIGHT\n\n") if ($opt_C);
+print("$VERSION\n\n$COPYRIGHT\n\n") if ($opt_V);
+
+exit 0 if (($opt_h) or ($opt_C) or ($opt_V));
+
+$opt_f = 1 unless ($opt_f);
+$opt_w = '______' unless ($opt_w);
+$opt_s = '_' unless ($opt_s);
+
+while ($line = <STDIN>) {
+  chomp $line;
+  if ($line =~ /^ZCZC begin inhosts [\d\.]+ (\S+) \d+ (\d+) [\d\.]+$/) {
+    $reporting_host=$1;
+    $reported_articles=$2;
+    $reporting_hosts{$reporting_host} = 1;
+    while ($line = <STDIN>) {
+      chomp $line;
+      last if ($line =~ /^ZCZC end inhosts $reporting_host$/);
+      if ($line =~ /^(\d+)\s+(\S+)$/) {
+       ($count, $host) = split(/\s+/, $line);
+       next if ($host eq $reporting_host and defined($opt_p));
+       next if ($host =~ /^$opt_s$/);
+       $host{$host} += $count
+         unless (($count / $reported_articles) >= .99 and defined($opt_p));
+      }
+      die("$0: garbled input file: $line\n") if ($line =~ /^ZCZC/);
+    }
+  } elsif ($line =~ /^ZCZC begin inpaths [\d\.]+ (\S+) \d+ \d+ [\d\.]+$/) {
+    $reporting_host=$1;
+    while ($line = <STDIN>) {
+      chomp $line;
+      last if ($line =~ /^ZCZC end inpaths $reporting_host$/);
+#      print STDERR "skipping: $line\n" unless $line =~ /^\S+ H (\d+ Z \S+ U )+$/;
+      next unless $line =~ /^\S+ H (\d+ Z \S+ U )+$/;
+      ($to_host, $rest) = split(/ H /, $line);
+      next if ($to_host eq $reporting_host and defined($opt_p));
+      next if ($to_host =~ /^$opt_s$/);
+      @from_hosts = split(/ U /, $rest);
+      foreach $from_host (@from_hosts) {
+       next if ($from_host eq $reporting_host and defined($opt_p));
+       ($count, $from_host2) = split(/ Z /, $from_host);
+       next if ($from_host2 eq $to_host and defined($opt_p));
+       next if ($from_host2 =~ /^$opt_s$/);
+       $peer{"\"$from_host2\"" . " -> " . "\"$to_host\""} += $count
+         unless (($count / $reported_articles) >= .99 and defined($opt_p));
+       if ($to_host =~ /$opt_w/i) {
+         $peers{$from_host2} = 1;
+       }
+      }
+      die("$0: garbled input file: $line\n") if ($line =~ /^ZCZC/);
+    }
+  }
+}
+
+print "digraph \"news relations\" {\n";
+
+print "node [style=filled]\n";
+$number=0;
+for $name (sort {$host{$b} <=> $host{$a}} keys %host) {
+  ($hue,$sat,$val)=(360,0,101);
+  $number++;
+  if ($name =~ /$opt_w/i) {
+    ($hue,$sat,$val)=(0,20,100);
+  } elsif (defined($reporting_hosts{$name})) {
+    ($hue,$sat,$val)=(240,20,100);
+  } elsif (defined($peers{$name})) {
+    ($hue,$sat,$val)=(120,20,100);
+  }
+  if ($number <= $opt_f) {
+    if ($hue == 360) {
+      $val -= 80;
+    } else {
+      $sat += 80;
+    }
+  } elsif ($number <= ($opt_f)) {
+    if ($hue == 360) {
+      $val -= 60;
+    } else {
+      $sat += 60;
+    }
+  } elsif ($number <= ($opt_f * 2)) {
+    if ($hue == 360) {
+      $val -= 40;
+    } else {
+      $sat += 40;
+    }
+  } elsif ($number <= ($opt_f * 4)) {
+    if ($hue == 360) {
+      $val -= 20;
+    } else {
+      $sat += 20;
+    }
+  }
+  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);
+}
+print "node [style=solid]\n";
+
+$number = 0;
+for $peering (sort {$peer{$b} <=> $peer{$a}} keys %peer) {
+  $number++;
+  if ($number <= ($opt_f * 5)) {
+    $style='bold';
+  } elsif ($number <= ($opt_f * 10)) {
+    $style='solid';
+  } elsif ($number <= ($opt_f * 20)) {
+    $style='dashed';
+  } elsif ($number <= ($opt_f * 40)) {
+    $style='dotted';
+  } elsif ($peering =~ /$opt_w/i) {
+    $style='dotted';
+  } else {
+    next;
+  }
+  print "$peering [label=$peer{$peering} weight=$peer{$peering} minlen=3 style=$style]\n";
+}
+
+print "}\n";