#!/usr/bin/perl -w
# irclinkmap by yanek & Liskni_si, GNU GPL
# $Id$
# Synopsis: ./irc_mapper.pl irc.somewhere.net 6667 Operator operpass

use strict;
use IO::Socket::INET;

my %servers;
my $server;
my @skeys;
my @tkeys;
my $edge;
my $links;
my %admins;

my $host = shift || die;
my $port = shift || die;

my $conn = IO::Socket::INET->new("$host:$port");
$conn->autoflush(1);
$| = 1;

my $oper = shift || undef;
my $operpass = shift || undef;

print $conn "USER mapper 8 * :irc network mapper\n";
print $conn "NICK mapper\n";
if ($oper) {
  print $conn "OPER $oper $operpass\n";
}
print $conn "MODE mapper +F\n";

use Data::Dumper;

while (chomp(my $line = <$conn>)) {
  chop($line);

  print $line,"\n";
  if ($line =~ /^\:([^\s]+) 001/) {
      &addserver($1,0);
  }
  elsif ($line =~ /^\:([^\s]+) 376/) { # end of motd
    print $conn "LINKS\n";
    print " + LINKS!\n";
    &addserver($1);
  }
  elsif (my (@ar) = $line =~ /^\:([^\s]+) 364 ([^\s]+) ([^\s]+) ([^\s]+) \:(\d+) (.*)/) { # server
#    print " + SERVER: $1, $2, $3, $4, $5, $6\n";
    &addserver($3,int($5));
    &addserver($4,-1);
    &addlink($3,$4);
  }
  elsif ($line =~ /^\:([^\s]+) 365/) {
    print " + SERVERLIST COMPLETE\n";
    print "   ",join(", ",keys %servers),"\n\n";
    @skeys = keys %servers;
    &callget;
  }
  elsif ((@ar) = $line =~ /^\:([^\s]+) 213 ([^\s]+) ([^\s]+) ([^\s]+) ([^\s]+) ([^\s]+) ([^\s]+) (.*)/) {
#    print "214: ", join(", ",@ar), "\n";
    $edge->{$ar[0]}->{$ar[5]}++;
    &addserver($ar[5],$servers{$ar[0]}+1);
  }
  elsif (my ($srv) = $line =~ /^\:([^\s]+) 219/) {
    my @tmp;
    foreach(@tkeys) {
      push(@tmp,$_) if $_ ne $srv;
    }
    @tkeys = @tmp;
    print " + OKAY, NEXT\n";
    print "   TODO: ",join(", ",@tkeys),"\n\n";
    
    last if ($#tkeys == -1);
    
    &callget;
  }
  elsif ($line =~ /^\:([^\s]+) 263/) {
    print " + PFFF! SLEEP 30!\n";
    unshift(@skeys,$server);
    sleep(30);
    &callget;
  }
  elsif ($line =~ /^\:([^\s]+) 25[89] ([^\s]+) :(.*)/) {
      my $srv = $1;
      my $info = $3;
      if ($info =~ /(.*)(<.+>)/) {
	  my $nick = $1;
	  my $mail = $2;
	  $nick =~ s/^\s*(.*?)\s*$/$1/;

	  #if (length($nick)) {
	  #    $admins{$srv} = $nick;
	  #} elsif length($mail) {
	  #    $admins{$srv} = $mail;
	  #}
	  $admins{$srv} = $nick . " " . $mail;
      } elsif ($info =~ /(\S+\@\S+\.\S+)/) {
	  $admins{$srv} = "<".$1.">";
      }
  }
  if ($line =~ /mapper offline now/) {
    last;
  }
  
#:irc1.cassnet.sk 214 mapper N *@10.1.1.1 * irc.cassnet.sk 0 :3
# :irc1.cassnet.sk 213 mapper c *@10.1.1.1 * irc.cassnet.sk 6667 :3
# :irc1.cassnet.sk 219 mapper C :End of STATS report
  
    
}
print $conn "QUIT :Bye, bye :(\n";
close($conn);

print " + DONE!\n";

my $date = `LANG=C date`;
chomp $date;
open(TMP,">irc_mapper.last");
print TMP Dumper($edge,$links,\%servers,$date,\%admins);
print TMP "\n1;\n";
close(TMP);

sub callget {
  while ( $server = pop(@skeys) ) {
    print $conn "ADMIN $server\n";
    print $conn "STATS C $server\n";
    push(@tkeys,$server);
  }
  return 0 unless defined $server;
  return 1;
}

sub addserver {
  my $server = shift;
  my $hop = shift;
  if (defined $servers{$server} && $servers{$server} != -1) {
      return;
  }
  $servers{$server} = $hop;
}

sub addlink {
  my $from = shift;
  my $to = shift;

  $links->{$from}->{$to}++;
  $links->{$to}->{$from}++; 
}