schtarrbot

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Net::IRC;
   7
   8 my %botinfo = (
   9         Nick => "schtarrbot",
  10         Ircname => "schtarrbot",
  11         Server => "shiar.net",
  12         Port => 6667,
  13 );
  14 my @chaninfo = ("#schtarr");
  15 my %loginfo = (
  16         filename => "/var/log/pvpgn/bnetd.log",
  17         debug => 1,
  18 );
  19
  20 my $irc = new Net::IRC;
  21 my $conn = $irc->newconn(%botinfo) or die "couldn't connect to server";
  22 my $joined = 0;
  23
  24 $conn->add_global_handler('join', sub {
  25         $joined = 1;
  26 });
  27
  28 $conn->add_global_handler('376', sub {
  29         # connect
  30         $_[0]->join(@chaninfo) or die "couldn't connect to channel";
  31 });
  32
  33 $conn->add_global_handler('public', sub {
  34         my ($self, $event) = @_;
  35         $event->args =~ m/^!(\w+)/ or next;
  36         handle_cmd($1);
  37 });
  38
  39 open my $log, "<", $loginfo{filename} or die $!;
  40 seek $log, 0, 2;  # eof
  41
  42 sub handle_cmd {
  43 }
  44
  45 sub handle_log {
  46         my ($func, $msg) = @_;
  47
  48         if ($func eq "_client_loginreq2" and $line =~ m{
  49                 "([^"]+)" \Q logged in (correct password)\E $
  50         }x) {
  51                 my $nick = $1;
  52                 print "* login $nick\n";
  53                 $conn->privmsg($chaninfo[0], "$nick entered bnet");
  54         }
  55
  56         elsif ($func eq "conn_destroy" and $line =~ m{
  57                 "([^"]+)" \Q logged out\E $
  58         }x) {
  59                 my $nick = $1;
  60                 print "* logout $nick\n";
  61                 $conn->privmsg($chaninfo[0], "$nick left bnet");
  62         }
  63
  64         elsif ($func eq "game_create" and $line =~ m{
  65                 \Qgame "\E ([^"]*) \Q" (pass "\E([^"]*)\Q") type \E(\d*)\(([^)]*)\)\Q startver \E(\d+)\Q created\E $
  66         }x) {
  67                 my ($name, $pass, $typeid, $type, $version) = ($1, $2, $3, $4, $5);
  68                 print "* game created\n";
  69                 $conn->privmsg($chaninfo[0], "$type game '$name' created");
  70         }
  71
  72         elsif ($func eq "_client_startgame4" and $line =~ m{
  73                 \Qgot startgame4 status for game "\E([^"]*)\Q" is 0x\E
  74         }) {
  75                 my $game = $1;
  76                 print "* game started\n";
  77                 $conn->privmsg($chaninfo[0], "game '$game' started");
  78         }
  79
  80         if ($func eq "game_report" and $line =~ m{
  81                 \Qgame report saved as "\E([^"]*)" $
  82         }) {
  83                 my $report = $1;
  84                 print "* game reported\n";
  85         }
  86
  87         elsif (not $loginfo{debug} and $func eq "game_destroy" and $line =~ m{
  88                 \Qgame deleted\E $
  89         }x) {
  90                 print "* game deleted\n";
  91                 $conn->privmsg($chaninfo[0], "game closed");
  92         }
  93 }
  94
  95 while (1) {
  96         sleep 1.5;
  97         $irc->do_one_loop();
  98         $joined or next;
  99
 100         seek $log, 0, 1; # clear eof condition
 101         while (defined (my $line = readline $log)) {
 102                 my ($date, $level, $func, $msg) = $line =~ m{
 103                         ^ (\S+\s\S+\s\S+) \s \[([^\]\s]+)\s*\] \s ([^\s:]+): \s (.*) $
 104                 }x or warn("Invalid line: $line"), next;
 105                 $msg =~ s/(?:\[\d+\])+\s//g;
 106 #               print ". $func ($msg)\n";
 107                 handle_log($func, $msg);
 108         }
 109 }
 110