Bot.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2009 by Michael Andreen <harvATruinDOTnu>               *
   3 #                                                                         *
   4 #   This program is free software; you can redistribute it and/or modify  *
   5 #   it under the terms of the GNU General Public License as published by  *
   6 #   the Free Software Foundation; either version 2 of the License, or     *
   7 #   (at your option) any later version.                                   *
   8 #                                                                         *
   9 #   This program is distributed in the hope that it will be useful,       *
  10 #   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  11 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  12 #   GNU General Public License for more details.                          *
  13 #                                                                         *
  14 #   You should have received a copy of the GNU General Public License     *
  15 #   along with this program; if not, write to the                         *
  16 #   Free Software Foundation, Inc.,                                       *
  17 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
  18 #**************************************************************************/
  19 package NDIRC::Bot;
  20
  21 use strict;
  22 use warnings;
  23 use feature ':5.10';
  24
  25 use Moose;
  26
  27 use POE::Session;
  28 use POE::Component::IRC::Plugin::Logger;
  29 use POE::Component::IRC::Plugin::BotTraffic;
  30 use POE::Component::IRC::Plugin::Connector;
  31 use POE::Component::IRC::Plugin::AutoJoin;
  32 use POE::Component::IRC::Plugin::NickReclaim;
  33
  34 use NDIRC::Dispatcher;
  35
  36 use IO::File;
  37
  38 # We registered for all events, this will produce some debug info.
  39 sub _default {
  40         my ($event, $args) = @_[ARG0 .. $#_];
  41         my @output = ( "$event: " );
  42
  43         for my $arg (@$args) {
  44                 if ( ref $arg eq 'ARRAY' ) {
  45                         push( @output, '[' . join(', ', @$arg ) . ']' );
  46                 }
  47                 else {
  48                         push ( @output, "'$arg'" );
  49                 }
  50         }
  51         print join ' ', @output, "\n";
  52         return 0;
  53 }
  54
  55 sub _start {
  56         my ($kernel,$heap,$session) = @_[KERNEL,HEAP,SESSION];
  57
  58         # retrieve our component's object from the heap where we stashed it
  59         my $irc = $heap->{irc};
  60         $kernel->sig( DIE => 'sig_DIE' );
  61         $kernel->sig( USR1 => 'sig_usr1' );
  62         $kernel->sig( USR2 => 'sig_usr2' );
  63         $kernel->sig( INT => 'signal_handler' );
  64
  65         $irc->plugin_add( 'NickReclaim', POE::Component::IRC::Plugin::NickReclaim->new() );
  66         $irc->plugin_add( 'AutoJoin', POE::Component::IRC::Plugin::NickReclaim->new() );
  67         $irc->plugin_add( 'BotTraffic', POE::Component::IRC::Plugin::BotTraffic->new() );
  68         $irc->plugin_add('Logger', POE::Component::IRC::Plugin::Logger->new(
  69                 Path    => 'irclogs',
  70                 DCC     => 0,
  71                 Private => 1,
  72                 Public  => 1,
  73                 Sort_by_date => 1,
  74                 Strip_color => 1,
  75                 Strip_formatting => 1,
  76         ));
  77
  78         $heap->{connector} = POE::Component::IRC::Plugin::Connector->new(
  79                 servers => ['irc.netgamers.org', 'underworld.no.eu.netgamers.org'
  80                         ,'firefly.no.eu.netgamers.org', 'underworld.ca.us.netgamers.org' ]
  81         );
  82         $irc->plugin_add( 'Connector' => $heap->{connector} );
  83
  84         $kernel->signal($session => 'USR2');
  85
  86         $irc->yield( register => 'all' );
  87         $irc->yield( connect => { server => 'irc.netgamers.org' } );
  88
  89         $kernel->delay( refresh => 60 );
  90         return;
  91 }
  92
  93 sub auth {
  94         my $heap = $_[HEAP];
  95
  96         if (my $f =  new IO::File 'auth'){
  97                 my $user = <$f>;
  98                 chomp $user;
  99                 my $pass = <$f>;
 100                 chomp $pass;
 101                 $heap->{irc}->yield(qbot_auth => $user => $pass);
 102         }
 103 }
 104
 105 sub sig_usr1 {
 106         my ($kernel,$heap) = @_[KERNEL,HEAP];
 107
 108         $kernel->yield( 'refresh' );
 109 }
 110
 111 sub sig_usr2 {
 112         my $heap = $_[HEAP];
 113
 114         my $disp = new NDIRC::Dispatcher;
 115
 116         if (my $commands = new IO::File 'commands'){
 117                 my @commands = split /\W+/, do{local $/; <$commands>};
 118                 say "Loading commands from: @commands";
 119                 $disp->load(@commands);
 120         }
 121
 122         my $channels = new IO::File 'channels';
 123         while (<$channels>){
 124                 my ($chan, @types) = split /\s+/;
 125                 say "$chan - @types";
 126                 if ($chan =~ /^(.*):(.*)$/){
 127                         $chan = $1;
 128                         $disp->set_target($2,$chan);
 129                 }
 130                 $disp->add_channel($chan,\@types);
 131         }
 132
 133         $heap->{disp} = $disp;
 134 }
 135
 136 sub sig_DIE {
 137         my( $kernel,$sig, $ex ) = @_[ KERNEL,ARG0, ARG1 ];
 138         say "DIED!!!!!!!!!!!!!!";
 139         # $sig is 'DIE'
 140         # $ex is the exception hash
 141         warn "$$: error in event: $ex->{error_str}";
 142         $kernel->sig_handled();
 143
 144         # Send the signal to session that sent the original event.
 145         #if( $ex->{source_session} ne $_[SESSION] ) {
 146         #$kernel->signal( $ex->{source_session}, 'DIE', $sig, $ex );
 147         #}
 148 }
 149
 150 sub signal_handler {
 151         my ($kernel, $signal_name, $heap) = @_[KERNEL, ARG0, HEAP];
 152         print "First session caught SIG$signal_name\n";
 153
 154         given($signal_name){
 155                 when ('INT') {
 156                         exit unless $heap->{irc}->connected;
 157                         $heap->{INT} = 1;
 158                         $heap->{irc}->yield(quit => 'Bye!');
 159                         $kernel->sig_handled();
 160                 }
 161         }
 162         #$kernel->sig_handled();
 163 }
 164
 165 sub irc_disconnected {
 166         my ($sender,$heap) = @_[SENDER,HEAP];
 167
 168         exit if $heap->{INT};
 169 }
 170
 171 sub irc_001 {
 172         my ($sender,$heap,$kernel) = @_[SENDER,HEAP,KERNEL];
 173
 174         # Since this is an irc_* event, we can get the component's object by
 175         # accessing the heap of the sender. Then we register and connect to the
 176         # specified server.
 177         my $irc = $sender->get_heap();
 178
 179         print "Connected to ", $irc->server_name(), "\n";
 180
 181         $kernel->yield( 'auth' );
 182         $irc->yield( mode => $irc->nick_name, '+ix');
 183
 184         # we join our channels
 185         $irc->yield( join => $_ ) for grep /^#/, keys %{$heap->{disp}->channels};
 186         return;
 187 }
 188
 189 sub irc_invite {
 190         my ($sender, $heap, $who, $channel) = @_[SENDER, HEAP, ARG0 .. ARG1];
 191         my $irc = $sender->get_heap();
 192
 193         $irc->yield( join => $_ ) for grep /^$channel$/i, keys %{$heap->{disp}->channels}
 194 }
 195
 196 sub irc_public {
 197 }
 198
 199 sub irc_msg {
 200 }
 201
 202 sub  refresh {
 203 }
 204
 205 sub irc_join {
 206 }
 207
 208 1;