#!/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 draw
# pretty-looking ASCII tree from it.
#
# (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);

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

print "$r00t{$rm}";
if ($servern) { print $servername{$r00t{$rm}}; }
print "\n";
print_branch($r00t{$rm}, 0);

print "
|
|--
|
!Generated between $X{'time.start'} and $X{'time.end'}
|
";# $lusers|
 print <<EOF;
|$ver (c) pasky <pasky\@ji.cz>
|Another author: yanek <janek\@isse.lipniknb.cz>
|
|Free to download under GPL at http://pasky.ji.cz/~pasky/irc
|
|Many thanks to jv, pht and nico (see source for more).
|Any tips/fixes really welcomed. Tested on IRCnet and TAIN (hybrid net),
|known maybe to work on Undernet.
EOF

#
# 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, $no);
  my ($from, $level) = @_;

  $no = 0;

  foreach $field (@{$tree{$from}}) {
    $no++;
    
    $branches[$level] = 0;
    spaces($level);
    
    if ($no < @{$tree{$from}}) {
      $branches[$level] = 1;
    } else {
      $branches[$level] = 0;
    }
    
    if ($no < @{$tree{$from}}) {
      print '|';
    } else {
      print '`';
    }
    
    if ($brackets) {
      print "--[$field] ";
    } else {
      print "--$field ";
    }
    
    if ($mask{$field} ne $mask{$from}) {
      $mask = $mask{$field};
      $mask .= " " . $note{$mask{$field}} if ($note{$mask{$field}});
    } else {
      $mask = "";
    }
    
    if ($mask) {
      if (! $brackets) { print '('; }
      print $mask;
      if (! $brackets) { print ')'; }
    }
    
    if ($servern) {
      print $servername{$field};
    }
    
    print "\n";
    
    print_branch($field, $level + 1);
  }
}

###############################################################################
#
# Indent the tree's branch
# @_: <level>
#

sub spaces {
  my ($c);
  for ($c=0; $c<=$_[0]; $c++) {
    if ($c == 0) { print '  '; } else { print '    '; }
    if ($branches[$c]) { print '|'; }
  }
}

###############################################################################
#
# 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)
#