#!/usr/bin/perl
#
# ircmapR-asciitree.pl - v2.0pre2
#
# Make a pretty image with tree of some IRC network
#
# This one will parse dump of IRC network masks, servers and lists and outputs
# source for graphviz-generated diagram.
#
# (c) Petr Baudis <pasky@pasky.ji.cz> 2001, 2002
#
# Other authors: yanek <janek@isse.lipniknb.cz>
#        Thanks: ZZyZZ, jv, pht
#
# No warranty, and so on... distributed under GPL.
# Get it on http://pasky.ji.cz/~pasky/irc
#
# You need to have (as with a lot of my other scripts) IHash.pm
# (case-insensitive hash support) module also now. Please download it at
# http://pasky.ji.cz/~pasky/cp/IHash.pm.
#


###############################################################################
#
# Defaults:
#
## Superverbose?
$v = 1;

## The root mask - server from which the tree will be drawn on
$rm = "*";

$brackets = 1;

use lib "/home/pasky/ircmap";
	      # replace with the dir where you've IHash.pm (http://pasky.ji.cz/~pasky/cp/IHash.pm)

###############################################################################
#
# If you are not interested in code itself, you should stop here.
#
###############################################################################
#
# Details:
#
$ve="2.0pre4";
$ver="ircmap-$ve";

use IHash;

#
# Read the dump
#

print STDERR "Reading the dump...\n" if ($v);

tie (%tree, "IHash");
tie (%servername, "IHash");
tie (%mask, "IHash");
tie (%note, "IHash");
tie (%r00t, "IHash");

while (<>) {
  chomp;

  @input = split(/ /);
  $t = shift(@input);

  if ($t eq 'S') {
    my ($m) = shift(@input);
    my ($s) = shift(@input);
    
    $mask{$s} = $m;
    $servername{$s} = join(' ', @input);
    
  } elsif ($t eq 'M') {
    my ($m) = shift(@input);
    my ($r) = shift(@input);
    my ($n) = shift(@input);
    
    $note{$m} = $n;
    $r00t{$m} = $r;
    
    push(@masks, $m)
      if (!(member($m, @masks) + 1));
    
  } elsif ($t eq 'L') {
    my ($s) = shift(@input);
    my ($d) = shift(@input);
    
    if (!(member($d, @{$tree{$s}}) + 1)) {
      push(@{$tree{$s}}, $d);
      ############################################ $maps{$m}->{"$d!parent"} = $s;
    }

  } elsif ($t eq 'X') {
    my ($k) = shift(@input);

    $X{$k} = join(' ', @input);
    
  } else {

#    print STDERR "Syntax error: $t ", @input, "\n";
#    exit -1;
  }
}

#
# Dump the results
#

print STDERR "Dumping the results...\n" if ($v);

print "di" if ($gif_form eq 'dot');
print "graph ircmap {\nedge [color=\"green\"]\n";
print "edge [w=5.0, len=1.5, fontsize=10]\nnode [fontsize=10]\n"
  if ($gif_form eq 'neato');

$rm = "*" if (! $r00t{$rm});

print "\"$r00t{$rm}\" [label=\"$r00t{$rm} (start)\"]\n";

print_branch($r00t{$rm}, 0);

print "}\n";

#
# Main program ends here
#
###############################################################################
#
# Now support functions follow
#

sub debugmsg {
  my($msg);

  print STDERR @_, "\n" if (0);
}

###############################################################################
#
# Paint the tree's branch - has to be re-entrant
# @_: <root-server> <level>
# uses the global variable @branches
#

sub print_branch {
  my ($field);
  my ($from) = @_;

  foreach $field (@{$tree{$from}}) {
    if ($mask{$field} ne $mask{$from}) {
      $mask = $mask{$field};
      $mask .= " " . $note{$mask{$field}} if ($note{$mask{$field}});
    } else {
      $mask = "";
    }

    print "\"$field\" [label=\"$field";
    print " ($mask{$field})" if ($mask{$field} ne $mask{$from});
    print "\"]\n";
    
    print "\"$from\" -";
    
    if ($gif_form eq 'dot') {
      print ">";
    } else {
      print "-";
    }
    
    print " \"$field\"";
    
    if ($note{$mask{$field}}) {
      print " [label=\"$note{$mask{$field}}\"";
      
      if ($note{$mask{$field}} eq "split") {
	print " color=\"red\"";
      } elsif ($note{$mask{$field}} eq "lagged") {
	print " color=\"gray\"";
      }
      
      print "]";
    }
    
    print "\n";
    
    print_branch($field, $level + 1);
  }
}

###############################################################################
#
# member of an array?
#

sub member {
  my($pos, $f);
  $f=shift;
  
  for ($pos=0; $pos<@_; $pos++) {
    if (uc($_[$pos]) eq uc($f)) {
      return $pos;
    }
  }
  
  debugmsg("-- $f not a member of @_") if (0);
  
  return -1;
}

###############################################################################
#
# No more interesting stuff :-(r)
#