#!/usr/bin/perl
#
# queries blizzards server status page for wow
# at given intervals and is queriable in irc
#
# Copyright Eric Estabrooks 2005
#

use Net::IRC;
use IO::All;
use GDBM_File;

use threads;
use threads::shared;

my %status : shared;
my %items : shared;

tie %status, 'GDBM_File', "./server_status_gdbm", &GDBM_WRCREAT, 0600;
tie %items, 'GDBM_File', "./item_gdbm", &GDBM_WRCREAT, 0600;

$my_irc_name = "wowbot";

#$thr = threads->new(\&do_irc, "irc.insub.org", 6667, "#wow", "private");
#$thr->detach;

&do_irc("localhost", 6667, "#chat", "public");

sub do_irc {
    my $server = shift;
    my $port = shift;
    my $channel = shift;
    my $response = shift;
    my $irc;
    my $conn;

    $irc = new Net::IRC;
    $conn = $irc->newconn(Nick => 'WoWbot',
                          Server => $server,
                          Port => $port,
                          Ircname => $my_irc_name);
    
    $conn->add_global_handler('376', \&on_connect);
    $conn->add_handler('public', \&on_public);
    $conn->add_handler('msg', \&on_private);

    $conn->{'CHANNEL'} = $channel;
    $conn->{'RESPONSE'} = $response;

    print "starting $server:$port\n";
    $irc->start;
}

sub on_connect {
    my $self = shift;

    print "$self: joining channel $self->{'CHANNEL'}\n";
    $self->join($self->{'CHANNEL'});
}

sub on_private {
    my $self = shift;
    my $event = shift;
    my $current = $self->{'RESPONSE'};

    $self->{'RESPONSE'} = "private";
    $event->{'FROM_PRIVATE'} = 'yes';
    &on_public($self, $event);
    $self->{'RESPONSE'} = $current;
}

#sub on_public {
#    my $self = shift;
#    my $event = shift;
#   
#    my $thr = threads->new(\&__public_thread, $self, $event);
#    $thr->detach;
#
#    return;
#}

sub on_public {
    my $self = shift;
    my $event = shift;
    my $from = "";
    my $key = "";
    my $msg = "";

    my @to = @{$event->{'to'}};
    my @args = @{$event->{'args'}};

    ($from = lc($event->{'from'})) =~ s/(.*?)\!.*/$1/;
    if ($from eq $my_irc_name) {
        return;
    }
    if ($self->{'RESPONSE'} eq "private") {
        $to = $from;
    } else {
        $to = $to[0];
    }
    foreach $item (@args) {
        next if (($item !~ /\[.+?\]/) && ($event->{'FROM_PRIVATE'} ne "yes"));
        if (!(eval {($key = $item) =~ s/.*?\[(.+?)\].*/$1/;})) {
            if ($event->{'FROM_PRIVATE'} eq "yes") {
                $key = $item;
            } else {
                $self->privmsg($from, "sorry, couldn't process query\n");
                return;
            }
        }
        $key = lc($key);
        if ($key eq "update") {
            &get_status();
            $self->privmsg($to, "done updating\n");
        } elsif (($key eq "all servers") || ($key eq "all down") || ($key eq "all up")) {
            $n = 1;
            $msg = "";
            foreach $item (sort(keys(%status))) {
                next if $item eq 'STAMP';
                if ($status{$item} eq 'up') {
                    next if ($key eq "all down");
                    $msg .= sprintf("%-20s", uc($item));
                } else {
                    next if ($key eq "all up");
                    $msg .= sprintf("%-20s", $item);
                }
                if (($n % 5) == 0) {
                    $self->privmsg($from, $msg);
                    sleep(1);
                    $msg = "";
                }
                $n++;
            }
            $self->privmsg($from, $msg);
        } elsif (defined($status{$key})) {
            &get_status();
            $self->privmsg($to, "$key is $status{$key}\n");
        } elsif (defined($items{$key})) {
            @lines = split("\n", $items{$key});
            foreach $line (@lines) {
                if (length($line) > 240) {
                    send_message($self, $to, $line);
                } else {
                    $self->privmsg($to, "$line\n");
                }
                sleep(1);
            }
        } elsif ($key =~ /^http:\/\/www\.thott?bott?\.com\/?.*?=/) {
            &handle_url($self, $to, $key);
        } else { # try regexing the expression
            my @list;
            foreach $item (sort(keys(%items))) {
                $test = eval {
                    if ($item =~ /$key/) {
                        push @list, $item;
                    }
                }
            }
            $size = @list;
            if ($size == 1) {
                @lines = split("\n", $items{$list[0]});
                foreach $line (@lines) {
                    $self->privmsg($from, "$line\n");
                }
            } elsif ($size == 0) {
                $self->privmsg($from, "nothing found for your query\n");
            } else {
                $line = join (', ', @list);
                if (length($line) > 240) {
                    send_message($self, $from, $line); #always send it private when large
                } else {
                    $self->privmsg($from, "possibly: $line");
                }
            }
        }
    }
}

# attempt to get and parse a thotbott url
sub handle_url {
    my $self = shift;
    my $to = shift;
    my $key = shift;
    my $content;
    my @lines;
    my $line;
    my $value = "";

    $content < io($key);
    @lines = split(/\n/, $content);
    foreach $line (@lines) {
        next if ($line !~ /class=ttb/);
        @data = ($line =~ /\>([^\<]+?)(?=\<)/g);
        $key = lc($data[0]);
        foreach $item (@data) {
            next if ($item =~ /^Live/);
            if (($item eq "Use") || ($item eq "Equip")) {
                $value .= $item." ";
            } else {
                $value .= $item."\n";
            }
            last if ($item =~ /Source/);
        }
        $items{$key} = $value;
        $self->privmsg($to, "learned about $key\n");
        last;
    }
}

# send large message (don't flood) privately
sub send_message {
    my $self = shift;
    my $to = shift;
    my $message = shift;
    
    if (length($message) > 1000) {
        $self->privmsg($to, "generated response too large, please refine query\n");
        return;
    }
    for ($i = 0; $i < length($message); $i += 240) {
        $self->privmsg($to, substr($message, $i, 240));
        sleep(1);
    }
}

# fills the server hash with status
sub get_status {
    my $content;
    my $step;

    $stamp = time;
    if (($status{'STAMP'}+600) < $stamp) {
        print "scraping server status page\n";
        $content < io('http://www.worldofwarcraft.com/serverstatus/'); 
        
        $step = "status";
        @items = split(/\n/, $content);
        foreach $item (@items) {
            next if ($item !~ /\<td class = \"serverStatus/);
            if ($step eq "status") {
                next if ($item !~ /arrow/);
                ($current_status = $item) =~ s/.*\/(.*?)arrow.gif.*/$1/;
                $step = "server";
            } elsif ($step eq "server") {
                ($server = $item) =~ s/.*color.*?\>(.*?)\<.*/$1/;
                $server =~ s/(.*?)\&\#039\;(.*)/$1\'$2/;
                $step = "status";
                $status{lc($server)} = $current_status;
            }
        }
        $status{'STAMP'} = $stamp;
    }
}
