3 # $Id: inpath2dot.pl,v 1.3 2001/08/28 19:21:23 cord Exp $
5 # DESCRIPTION: inpath2dot.pl - parses inpath-data to a format usuable by graphviz
7 # Copyright (C) 2001 Cord Beermann
9 # URL: http://Cord.de/tools/news/
11 # AUTHOR: Cord Beermann (Cord@Wunder-Nett.org)
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
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/)
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)
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
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.
38 # A Perl script is "correct" if it gets the job done before your boss fires
40 # -- 'Programming Perl Second Edition'
41 # by Larry Wall, Tom Christiansen & Randal L. Schwartz
43 # If you have to remove this, read the README!
45 use vars qw($opt_C $opt_f $opt_h $opt_p $opt_s $opt_V $opt_w);
48 getopts('Cf:hps:Vw:');
50 $VERSION='inpath2dot.pl $Revision: 1.3 $';
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/';
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)
61 -f n factor (defines how verbose the graphic will be. Defaults to 1.)
63 -w pattern watch (perl-regexp-pattern to highlight in the result)
64 -s pattern skip (perl-regexp-pattern to ignore in the result)
66 -p pedantic (activates some sanity-checks)
68 -C copyright (prints the copyright)
69 -h help (prints out this message)
70 -V Version (prints version-info)
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);
77 exit 0 if (($opt_h) or ($opt_C) or ($opt_V));
79 $opt_f = 1 unless ($opt_f);
80 $opt_w = '______' unless ($opt_w);
81 $opt_s = '_' unless ($opt_s);
83 while ($line = <STDIN>) {
85 if ($line =~ /^ZCZC begin inhosts [\d\.]+ (\S+) \d+ (\d+) [\d\.]+$/) {
87 $reported_articles=$2;
88 $reporting_hosts{$reporting_host} = 1;
89 while ($line = <STDIN>) {
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));
99 die("$0: garbled input file: $line\n") if ($line =~ /^ZCZC/);
101 } elsif ($line =~ /^ZCZC begin inpaths [\d\.]+ (\S+) \d+ \d+ [\d\.]+$/) {
103 while ($line = <STDIN>) {
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;
123 die("$0: garbled input file: $line\n") if ($line =~ /^ZCZC/);
128 print "digraph \"news relations\" {\n";
130 print "node [style=filled]\n";
132 for $name (sort {$host{$b} <=> $host{$a}} keys %host) {
133 ($hue,$sat,$val)=(360,0,101);
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);
142 if ($number <= $opt_f) {
148 } elsif ($number <= ($opt_f)) {
154 } elsif ($number <= ($opt_f * 2)) {
160 } elsif ($number <= ($opt_f * 4)) {
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);
169 print "node [style=solid]\n";
172 for $peering (sort {$peer{$b} <=> $peer{$a}} keys %peer) {
174 if ($number <= ($opt_f * 5)) {
176 } elsif ($number <= ($opt_f * 10)) {
178 } elsif ($number <= ($opt_f * 20)) {
180 } elsif ($number <= ($opt_f * 40)) {
182 } elsif ($peering =~ /$opt_w/i) {
187 print "$peering [label=$peer{$peering} weight=$peer{$peering} minlen=3 style=$style]\n";