#!/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";