view release on metacpan or  search on metacpan

lib/Bot/Pastebot/Client/Irc.pm  view on Meta::CPAN

  irc => {
    name          => SCALAR | REQUIRED,
    server        => LIST   | REQUIRED,
    nick          => LIST   | REQUIRED,
    uname         => SCALAR | REQUIRED,
    server_pass   => SCALAR,
    iname         => SCALAR | REQUIRED,
    away          => SCALAR | REQUIRED,
    flags         => SCALAR,
    join_cfg_only => SCALAR,
    channel       => LIST   | REQUIRED,
    quit          => SCALAR | REQUIRED,
    cuinfo        => SCALAR | REQUIRED,
    cver          => SCALAR,
    ccinfo        => SCALAR | REQUIRED,
    localaddr     => SCALAR,
    use_ssl       => SCALAR,
    nickserv_pass => SCALAR,
  },
);

sub get_conf { return %conf }

#------------------------------------------------------------------------------

sub initialize {

  # Build a map from IRC name to web server name I could add an extra
  # key to the irc sections but that would be redundant

  my %irc_to_web;
  foreach my $webserver (get_names_by_type('web_server')) {
    my %conf = get_items_by_name($webserver);
    $irc_to_web{$conf{irc}} = $webserver;
  }

  foreach my $server (get_names_by_type('irc')) {
    my %conf = get_items_by_name($server);

    my $version_string = $conf{cver};
    unless (defined $version_string and length $version_string) {
      $version_string = (
        "Bot::Pastebot $main::VERSION " .
        "<https://github.com/rcaputo/bot-pastebot>"
      );
    }

    my $web_alias = $irc_to_web{$server};
    my $irc = POE::Component::IRC::State->spawn();

    POE::Session->create(
      inline_states => {
        _start => sub {
          my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];

          $kernel->alias_set( "irc_client_$server" );
          $irc->yield( register => 'all' );

          $heap->{server_index} = 0;

          # Keep-alive timer.
          $kernel->delay( autoping => 300 );

          $kernel->yield( 'connect' );
        },

        autoping => sub {
          my ($kernel, $heap) = @_[KERNEL, HEAP];
          $irc->yield( userhost => $heap->{my_nick})
            unless $heap->{seen_traffic};
          $heap->{seen_traffic} = 0;
          $kernel->delay( autoping => 300 );
        },

        connect => sub {
          my ($kernel, $heap) = @_[KERNEL, HEAP];

          my $chosen_server = $conf{server}->[$heap->{server_index}];
          my $chosen_port = 6667;
          if ($chosen_server =~ s/[\s\:]+(\S+)\s*$//) {
            $chosen_port = $1;
          }

          # warn "server($chosen_server) port($chosen_port)";

          $heap->{nick_index} = 0;
          $heap->{my_nick} = $conf{nick}->[$heap->{nick_index}];

          $irc->yield(
            connect => {
              Debug     => 1,
              Nick      => $heap->{my_nick},
              Server    => $chosen_server,
              Port      => $chosen_port,
              Username  => $conf{uname},
              Password  => $conf{server_pass},
              UseSSL    => $conf{use_ssl},
              Ircname   => $conf{iname},
              LocalAddr => $conf{localaddr},
            }
          );

          $heap->{server_index}++;
          $heap->{server_index} = 0 if $heap->{server_index} >= @{$conf{server}};
        },

        join => sub {
          my ($kernel, $channel) = @_[KERNEL, ARG0];
          $irc->yield( join => $channel );
        },

        irc_msg => sub {
          my ($kernel, $heap, $sender, $msg) = @_[KERNEL, HEAP, ARG0, ARG2];

          my ($nick) = $sender =~ /^([^!]+)/;
          print "Message $msg from $nick\n";

          $msg = remove_colors($msg);

          if ($msg =~ /^\s*help(?:\s+(\w+))?\s*$/) {
            my $what = $1 || 'help';