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::Component::IRC::Common qw/irc_to_utf8/;
  28 use POE::Session;
  29 use POE::Kernel;
  30 use POE::Component::IRC::Plugin::Logger;
  31 use POE::Component::IRC::Plugin::BotTraffic;
  32 use POE::Component::IRC::Plugin::Connector;
  33 use POE::Component::IRC::Plugin::AutoJoin;
  34 use POE::Component::IRC::Plugin::NickReclaim;
  35
  36 use Mojo::Discord;
  37 use Mojo::IOLoop;
  38
  39 use NDIRC::Dispatcher;
  40 use NDIRC::IrcContext;
  41
  42 use IO::File;
  43
  44 has disp => (
  45         is => 'rw',
  46         isa => 'Object',
  47         lazy_build => 1
  48 );
  49
  50 has discord => (
  51         is => 'rw',
  52         isa => 'Object'
  53 );
  54
  55 has discord_name => (
  56         is => 'rw',
  57         isa => 'Str'
  58 );
  59
  60 has discord_id => (
  61         is => 'rw',
  62         isa => 'Str'
  63 );
  64
  65 has discord_channels => (
  66         is => 'rw',
  67         isa => 'HashRef',
  68         default => sub { {} }
  69 );
  70
  71 has targets => (
  72         is => 'ro',
  73         isa => 'HashRef[ArrayRef[Str]]',
  74         default => sub{ {} },
  75 );
  76
  77 # We registered for all events, this will produce some debug info.
  78 sub _default {
  79         my ($event, $args) = @_[ARG0 .. $#_];
  80         my @output = ( "$event: " );
  81
  82         for my $arg (@$args) {
  83                 if ( ref $arg eq 'ARRAY' ) {
  84                         push( @output, '[' . join(', ', @$arg ) . ']' );
  85                 }
  86                 else {
  87                         push ( @output, "'$arg'" );
  88                 }
  89         }
  90         print join ' ', @output, "\n";
  91         return 0;
  92 }
  93
  94 my $irc;
  95 sub irc {
  96         return $irc;
  97 }
  98
  99 sub _start {
 100         my ($self,$kernel,$heap,$session) = @_[OBJECT,KERNEL,HEAP,SESSION];
 101
 102         # retrieve our component's object from the heap where we stashed it
 103         $irc = $heap->{irc};
 104         $kernel->sig( DIE => 'sig_DIE' );
 105         $kernel->sig( USR1 => 'sig_usr1' );
 106         $kernel->sig( USR2 => 'sig_usr2' );
 107         $kernel->sig( INT => 'signal_handler' );
 108
 109         $irc->plugin_add( 'NickReclaim', POE::Component::IRC::Plugin::NickReclaim->new() );
 110         $irc->plugin_add( 'AutoJoin', POE::Component::IRC::Plugin::NickReclaim->new() );
 111         $irc->plugin_add( 'BotTraffic', POE::Component::IRC::Plugin::BotTraffic->new() );
 112         $irc->plugin_add('Logger', POE::Component::IRC::Plugin::Logger->new(
 113                 Path    => 'irclogs',
 114                 DCC     => 0,
 115                 Private => 1,
 116                 Public  => 1,
 117                 Sort_by_date => 1,
 118                 Strip_color => 1,
 119                 Strip_formatting => 1,
 120                 Notices => 1,
 121         ));
 122
 123         $heap->{connector} = POE::Component::IRC::Plugin::Connector->new(
 124                 servers => [['chronos.fr.eu.netgamers.org'], ['underworld.no.eu.netgamers.org']]
 125         );
 126         $irc->plugin_add( 'Connector' => $heap->{connector} );
 127
 128         $irc->yield( register => 'all' );
 129         #$irc->yield( connect => { server => 'chronos.fr.eu.netgamers.org' } );
 130
 131         $kernel->delay( refresh => 60 );
 132
 133         if (my $f =  new IO::File 'discord'){
 134                 my $user = <$f>;
 135                 chomp $user;
 136                 my $token = <$f>;
 137                 chomp $token;
 138
 139                 $self->discord(Mojo::Discord->new(
 140                                 'token'     => $token,
 141                                 'name'      => $user,
 142                                 'url'       => 'https://nd.ruin.nu',
 143                                 'version'   => '1.0',
 144                                 'reconnect' => 1,
 145                                 'verbose'   => 1,
 146                                 'logdir'   => '/tmp',
 147                         ));
 148
 149                 $self->discord->gw->on('MESSAGE_CREATE' => sub { $self->discord_message_create(@_) });
 150                 $self->discord->gw->on('MESSAGE_UPDATE' => sub { $self->discord_message_create(@_) });
 151                 $self->discord->gw->on('READY'          => sub { $self->discord_ready(@_) });
 152                 $self->discord->gw->on('GUILD_CREATE'   => sub { $self->discord_guild_create(@_) });
 153                 $self->discord->gw->on('CHANNEL_CREATE' => sub { $self->discord_channel_create(@_) });
 154
 155                 $self->discord->init();
 156         }
 157         return;
 158 }
 159
 160 sub auth {
 161         my $heap = $_[HEAP];
 162
 163         if (my $f =  new IO::File 'auth'){
 164                 my $user = <$f>;
 165                 chomp $user;
 166                 my $pass = <$f>;
 167                 chomp $pass;
 168                 $heap->{irc}->yield(qbot_auth => $user => $pass);
 169         }
 170 }
 171
 172 sub sig_usr1 {
 173         my ($kernel,$heap) = @_[KERNEL,HEAP];
 174
 175         $kernel->yield( 'refresh' );
 176 }
 177
 178 sub clear_constraint {
 179         my $tc = shift;
 180
 181         while (1) {
 182                 if (ref $tc eq 'MooseX::Meta::TypeConstraint::Structured'){
 183                         for my $t (@{$tc->{type_constraints}}){
 184                                 clear_constraint($t);
 185                         }
 186
 187                 }
 188                 if (ref $tc eq 'Moose::Meta::TypeConstraint::Parameterized'){
 189                         clear_constraint($tc->{type_parameter});
 190                 }
 191                 last if ref $tc eq 'HASH';
 192                 last if ref $tc eq '';
 193                 if (defined $tc->{_type_constraint}){
 194                         $tc = $tc->{_type_constraint};
 195                 }elsif(defined $tc->{__type_constraint}){
 196                         $tc = $tc->{__type_constraint};
 197                 }else{
 198                         last;
 199                 }
 200         }
 201 }
 202
 203 sub clear_metains {
 204         my $ins = shift;
 205
 206         for my $a (@{$ins->{attributes}}){
 207                 for my $m (@{$a->{associated_methods}}){
 208                         $m->{body} = undef;
 209                 }
 210                 clear_constraint($a->{isa});
 211         }
 212 }
 213
 214 sub clear_cycles {
 215         my $c = shift;
 216
 217         for my $m (values %{$c->meta->{methods}}){
 218                 clear_constraint($m->{type_constraint});
 219
 220                 my $ps = $m->{parsed_signature};
 221                 for my $p (@{$ps->{_positional_params}->{params}}){
 222                         clear_metains($p->{__MOP__}->{_meta_instance});
 223                 }
 224
 225                 $m->{body} = undef;
 226         }
 227         clear_metains($c->meta->{_meta_instance});
 228 }
 229
 230
 231 sub sig_usr2 {
 232         my $self = shift @_;
 233
 234         for my $c (values %{$self->disp->commands}){
 235                 clear_cycles($c);
 236         }
 237
 238         $self->disp($self->_build_disp);
 239 }
 240
 241 sub _build_disp {
 242         my ($self) = @_;
 243         my $disp = NDIRC::Dispatcher->new;
 244
 245         if (my $commands = IO::File->new('commands')){
 246                 my @commands = split /\W+/, do{local $/; <$commands>};
 247                 say "Loading commands from: @commands";
 248                 $disp->load(@commands);
 249         }
 250
 251         %{$self->targets} = ();
 252         my $channels = IO::File->new('channels') or die $!;;
 253         while (<$channels>){
 254                 my ($chan, @types) = split /\s+/;
 255                 say "$chan - @types";
 256                 if ($chan =~ /^(.*):(.*)$/){
 257                         $chan = $1;
 258                         $self->targets->{$2} = [] unless exists $self->targets->{$2};
 259                         push @{$self->targets->{$2}},lc $chan;
 260                         say "$2 - @{$self->targets->{$2}}";
 261                 }
 262                 $disp->add_channel($chan,\@types);
 263         }
 264
 265         return $disp;
 266 }
 267
 268 sub sig_DIE {
 269         my( $kernel,$sig, $ex ) = @_[ KERNEL,ARG0, ARG1 ];
 270         say "DIED!!!!!!!!!!!!!!";
 271         # $sig is 'DIE'
 272         # $ex is the exception hash
 273         warn "$$: error in event: $ex->{error_str}";
 274         $kernel->sig_handled();
 275
 276         # Send the signal to session that sent the original event.
 277         #if( $ex->{source_session} ne $_[SESSION] ) {
 278         #$kernel->signal( $ex->{source_session}, 'DIE', $sig, $ex );
 279         #}
 280 }
 281
 282 sub signal_handler {
 283         my ($kernel, $signal_name, $heap) = @_[KERNEL, ARG0, HEAP];
 284         print "First session caught SIG$signal_name\n";
 285
 286         given($signal_name){
 287                 when ('INT') {
 288                         exit unless $heap->{irc}->connected;
 289                         $heap->{INT} = 1;
 290                         $heap->{irc}->yield(quit => 'Bye!');
 291                         $kernel->sig_handled();
 292                 }
 293         }
 294         #$kernel->sig_handled();
 295 }
 296
 297 sub irc_disconnected {
 298         my ($sender,$heap) = @_[SENDER,HEAP];
 299
 300         exit if $heap->{INT};
 301 }
 302
 303 sub irc_001 {
 304         my ($self,$sender,$kernel) = @_[OBJECT,SENDER,KERNEL];
 305
 306         # Since this is an irc_* event, we can get the component's object by
 307         # accessing the heap of the sender. Then we register and connect to the
 308         # specified server.
 309         my $irc = $sender->get_heap();
 310
 311         print "Connected to ", $irc->server_name(), "\n";
 312
 313         $kernel->yield( 'auth' );
 314         $irc->yield( mode => $irc->nick_name, '+ix');
 315
 316         # we join our channels
 317         $irc->yield( join => $_ ) for grep /^#/, keys %{$self->disp->channels};
 318         return;
 319 }
 320
 321 sub irc_invite {
 322         my ($self,$sender, $who, $channel) = @_[OBJECT,SENDER, ARG0 .. ARG1];
 323         my $irc = $sender->get_heap();
 324
 325         $irc->yield( join => $_ ) for grep /^$channel$/i, keys %{$self->disp->channels}
 326 }
 327
 328 sub irc_public {
 329         $_[ARG2] = irc_to_utf8 $_[ARG2];
 330 }
 331
 332 sub irc_msg {
 333         $_[ARG2] = irc_to_utf8 $_[ARG2];
 334 }
 335
 336 sub  refresh {
 337 }
 338
 339 sub irc_join {
 340 }
 341
 342 sub discord_ready {
 343         my ($self, $gw, $hash) = @_;
 344
 345         $self->discord_id($hash->{user}{id});
 346         $self->discord_name($hash->{user}{username});
 347
 348         say localtime(time) . " - Connected to Discord. $self->{discord_id}";
 349 }
 350
 351 sub discord_message_create {
 352 }
 353
 354 sub discord_guild_create {
 355         my ($self, $gw, $hash) = @_;
 356
 357         for my $chan (@{$hash->{channels}}) {
 358                 say localtime(time) . " - $chan->{id} - $chan->{name}";
 359                 $self->discord_channels->{$chan->{id}} = $chan;
 360         }
 361 }
 362
 363 sub discord_channel_create {
 364         my ($self, $gw, $chan) = @_;
 365
 366         for my $key (keys %{$chan}) {
 367                 say localtime(time) . " - $key - $chan->{$key}";
 368         }
 369         $self->discord_channels->{$chan->{id}} = $chan;
 370 }
 371
 372 sub handleCommand {
 373         my ($self, $c, $msg) = @_;
 374
 375         my ($p,$command,$args) = ($msg =~ /^([.!])(\S+)(?: (.+))?/);
 376
 377         if ($msg =~ m{https?://[\w.]+/.+?scan(_id|_grp)?=(\w+)}){
 378                 if (!$command || $command =~ m{^https?://}){
 379                         ($p,$command,$args) = ('.','addscan',$msg);
 380                 }elsif($command ne 'addscan'){
 381                         $self->handleCommand ($c, ".addscan $msg")
 382                 }
 383         }
 384
 385         return 0 unless $self->disp->has_command($command,$c->channel);
 386
 387         say localtime(time) . " - $msg";
 388
 389         $c->dm_reply(1) if $p eq '!';
 390
 391         return $self->disp->run_command($c,$command,$args);
 392 }
 393
 394 sub parseCommand {
 395         my ($self, $msg, $server, $nick, $address, $channel, $model) = @_;
 396
 397         return if $channel !~ /^#/ && $msg =~ /^~/;
 398         $msg = ".$msg"  if $channel !~ /^#/ && $msg =~ /^[^.!]/;
 399
 400         my ($p,$command,$args) = ($msg =~ /^([.!~])(\S+)(?: (.+))?/);
 401
 402         if ($msg =~ m{https?://[\w.]+/.+?scan(_id|_grp)?=(\w+)}){
 403                 if (!$command || $command =~ m{^https?://}){
 404                         ($p,$command,$args) = ('.','addscan',$msg);
 405                 }elsif($command ne 'addscan'){
 406                         $self->parseCommand (".addscan $msg", $server, $nick, $address, $channel, $model)
 407                 }
 408         }
 409
 410         return 0 unless $self->disp->has_command($command,$channel);
 411
 412         my $reply_string;
 413         given ($p){
 414                 when ('!'){
 415                         $reply_string = "privmsg $nick";
 416                 }
 417                 when ('~'){
 418                         $reply_string = "privmsg $channel";
 419                 }
 420                 default {
 421                         $reply_string = "notice $nick";
 422                 }
 423         }
 424
 425         $address =~ s/.*@(.*)/$1/;
 426         my $c = NDIRC::IrcContext->new({
 427                         host => $address,
 428                         nick => $nick,
 429                         channel => $channel,
 430                         disp => $self->disp,
 431                         model => $model,
 432                         server => $server,
 433                         bot => $self,
 434                         reply_string => $reply_string,
 435                 });
 436
 437         return $self->disp->run_command($c,$command,$args);
 438 }
 439
 440 sub toTarget {
 441         my ($self, $target, $msg) = @_;
 442
 443         return unless exists $self->targets->{$target};
 444
 445         $self->message($msg, @{$self->targets->{$target}});
 446
 447 }
 448
 449 sub message {
 450         my ($self, $msg, @targets) = @_;
 451
 452         for (@targets) {
 453                 when (/^D-(\d+)$/i) {
 454                         $self->discordMessage($1, $msg);
 455                 }
 456                 default {
 457                         $self->ircMessage(privmsg => $_, $msg);
 458                 }
 459         }
 460 }
 461
 462 sub ircMessage {
 463         my ($self, $command, $target, $msg) = @_;
 464
 465         $msg =~ s`<b>(.*?)</b>`${\(chr(2))}$1${\(chr(15))}`gi;
 466         $msg =~ s`<c(\d+)>(.*?)</c>`${\(chr(3))}$1$2${\(chr(15))}`gi;
 467
 468         $self->irc->yield($command, $target, $msg);
 469 }
 470
 471 sub discordMessage {
 472         my ($self, $target, $msg) = @_;
 473
 474         $msg =~ s`<b>(.*?)</b>`**$1**`gi;
 475         $msg =~ s`<c(\d+)>(.*?)</c>`*$2*`gi;
 476
 477         $self->discord->send_message($target, $msg );
 478 }
 479
 480 1;