#!/usr/bin/perl
#
# ircmapC.pl - v2.0pre2
#
# Make a pretty image with tree of some IRC network
#
# This one will parse dump of all links around whole IRC network from an IRC
# server and combine them all together in one tree as seen from * mask. It
# outputs its result in format:
# M <mask> <root> [<note>]
# S <mask> <server> <sname>
# L <from> <to>
# ...
#
# (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 links will be wired from
$rm = "*";

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="ircmapC-$ve";

use IHash;

#
# Read the dump
#

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

tie (%maps, "IHash");
tie (%tree, "IHash");
tie (%servername, "IHash");

while (<>) {
  chomp;

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

  if ($t eq 'S') {
    my ($s) = shift(@input);
    
    $servername{$s} = join(' ', @input);
    
  } elsif ($t eq 'M') {
    my ($m) = shift(@input);
    
    $maps{$m}->{"!root"} = shift(@input);
    $maps{$m}->{"!note"} = shift(@input);
    
    push(@masks, $m)
      if (!(member($m, @masks) + 1));

#    tie (%{$maps{$m}}, "IHash");
    
  } elsif ($t eq 'L') {
    my ($m) = shift(@input);
    my ($s) = shift(@input);
    my ($d) = shift(@input);
    
    if (!(member($d, @{$maps{$m}->{$s}}) + 1)) {
      push(@{$maps{$m}->{$s}}, $d);
      $maps{$m}->{"$d!parent"} = $s;
    }
    
  } else {

    print "$t @input\n";
  }
}

#
# Compose one tree from the read data
#

print STDERR "Walking thru the tree...\n" if ($v);

walk($maps{$rm}->{"!root"}, $rm);

#
# Dump the results
#

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

foreach (keys %servername) {
  print "S ".$tree{"$_!mask"}." ".$_." ".$servername{$_}."\n";
}

foreach (@masks) {
  print "M ".$_." ".$maps{$_}->{"!root"}." ".$maps{$_}->{"!note"}."\n";
}
  
foreach (keys %tree) {
  next if (/!/);
  next if (/\*/);

  $s = $_;

  foreach (@{$tree{$s}}) {
    print "L ".$s." ".$_."\n";
  }
}

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

sub debugmsg {
  my($msg);

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

sub walk {
  my $srv = shift;
  my $mask= shift;

  debugmsg("\n\n[$srv] walk in $mask");
  $tree{"$srv!mask"} = $mask;

  foreach ($maps{$mask}->{"$srv!parent"}, @{$maps{$mask}->{$srv}}) {
    debugmsg("\n[$srv] Probing $_ (don't touch @_, and beware @{$tree{$_}})");
    
    # additional parameters are servers which we shouldn't see
    next if (member($_, @_) + 1);
    next if (@{$tree{$_}});
    next if (not $_);

    debugmsg("[$srv] Passed the test");
    
    if (/\*\./) {
      # we will substitute this mask AND LEAFS by the tree as seen from
      # $_, except the thread thru $srv

      debugmsg("[$srv] Mask");
      
      push(@{$tree{$_}}, 1);
      unmask($srv, $_);
      
    } else {
      # we add the leaf into the tree and ask for the leafs

      debugmsg("[$srv] Ordinary server");
      debugmsg("[$srv] My mask info [$tree{\"$srv!mask\"}]");
      
      push(@{$tree{$srv}}, $_);
      walk($_, $mask);
    }
  }
}

sub unmask {
  my($from, $mask) = @_;

  debugmsg(":: Ask for unmask of $mask from $from");

  # look up the from server, check what's leading there
  foreach (keys %{$maps{$mask}}) {
    my @list = @{$maps{$mask}->{$_}};
    
    next if (/!/);

    debugmsg(":> probe $_ (@list)") if (1);
    
    if (($x = rmember($from, @list)) + 1) {
      # walk from there _on_

      debugmsg(":: Got it, first is @list[$x]");

      push(@{$tree{$from}}, $_);
      walk($_, $mask, @list[$x]);

      last;
    }
  }
}


###############################################################################
#
# 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;
}

sub rmember {
  my($pos, $f);
  $f=shift;
  
  for ($pos=0; $pos<@_; $pos++) {
    $x = $_[$pos];
    next unless ($x);
    $x =~ s/\./\./g;
    $x =~ s/\*/.*/g;
    if ($f =~ /^$x$/i) {
      debugmsg("-- $f matched :$x:") if (1);
      return $pos;
    }
  }
  
  debugmsg("-- $f not a member of @_") if (1);
  
  return -1;
}

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