view release on metacpan or  search on metacpan

lib/Bot/Cobalt/Plugin/Extras/Relay.pm  view on Meta::CPAN

  ## take a hash mapping From and To
  return unless $ref and ref $ref eq 'HASH';

  my $from = $ref->{From} // return;
  my $to   = $ref->{To}   // return;

  my $context0 = $from->{Context} // return;
  my $chan0    = $from->{Channel} // return;

  my $context1 = $to->{Context} // return;
  my $chan1    = $to->{Channel} // return;

  ## context0:chan0 is relayed to *1:
  push( @{ $self->{Relays}->{$context0}->{$chan0} },
    [ $context1, $chan1 ],
  );
  ## and vice-versa:
  push( @{ $self->{Relays}->{$context1}->{$chan1} },
    [ $context0, $chan0 ],
  );

  logger->debug(
    "relaying: $context0 $chan0 -> $context1 $chan1"
  );
  return 1
}

sub Cobalt_register {
  my ($self, $core) = splice @_, 0, 2;

  my $pcfg = $core->get_plugin_cfg($self);
  my $relays = $pcfg->{Relays};
  unless (ref $relays and reftype $relays eq 'ARRAY') {
    $core->log->warn("'Relays' conf directive not valid, should be a list");
  } else {
    for my $ref (@$relays) {
      $self->add_relay($ref);
    }
  }

  register( $self, 'SERVER',
    [
      'public_msg',
      'ctcp_action',

      'user_joined',
      'user_kicked',
      'user_left',
      'user_quit',
      'nick_changed',

      'public_cmd_relay',
      'public_cmd_rwhois',

      'relay_push_join_queue',
    ],
  );

  $core->log->info("Loaded relay system");

  $core->timer_set( 3,
    {
      Event => 'relay_push_join_queue',
      Alias => $core->get_plugin_alias($self),
    },
    'RELAYBOT_JOINQUEUE'
  );

  return PLUGIN_EAT_NONE
}

sub Cobalt_unregister {
  my ($self, $core) = splice @_, 0, 2;
  $core->log->info("Unloaded");
  return PLUGIN_EAT_NONE
}

sub Bot_relay_push_join_queue {
  my ($self, $core) = splice @_, 0, 2;

  $self->_push_left_queue;

  my $queue = $self->{JoinQueue}//{};

  SERV: for my $context (keys %$queue) {
    next SERV unless scalar keys %{ $self->{Relays}->{$context} };

    CHAN: for my $channel (keys %{ $queue->{$context} }) {
      my @relays = $self->get_relays($context, $channel);
      next CHAN unless @relays;

      my @pending = @{ $queue->{$context}->{$channel} };
      my $str = "[joined: ${context}:${channel}] ";

      if (@pending > 5) {
        $str .= join ', ', splice @pending, 0, 5;

        my $remaining = scalar @pending;
        $str .= " ($remaining more, truncated)";
      } else {
        $str .= join ', ', @pending;
      }

      ## clear queue
      $queue->{$context}->{$channel} = [];

      RELAY: for my $relay (@relays) {
        my ($to_context, $to_channel) = @$relay;
        broadcast( 'message',
          $to_context,
          $to_channel,
          $str
        );
      } # RELAY

    } # CHAN

  }  # SERV

  $self->{JoinQueue} = {};

  broadcast('relay_push_left_queue');

  $core->timer_set( 3,
    {
      Event => 'relay_push_join_queue',
      Alias => $core->get_plugin_alias($self),
    },
    'RELAYBOT_JOINQUEUE'
  );

  return PLUGIN_EAT_ALL
}

sub _push_left_queue {
  my ($self) = @_;

  my $queue = $self->{LeftQueue}//{};

  SERV: for my $context (keys %$queue) {
    next SERV unless scalar keys %{ $self->{Relays}->{$context} };
    CHAN: for my $channel (keys %{ $queue->{$context} }) {
      my @relays = $self->get_relays($context, $channel);
      next CHAN unless @relays;

      my @pending = @{ $queue->{$context}->{$channel} };
      my $str = "[left: ${context}:${channel}] ";

      if (@pending > 5) {
        $str .= join ', ', splice @pending, 0, 5;

        my $remaining = scalar @pending;
        $str .= " ($remaining more, truncated)";
      } else {
        $str .= join ', ', @pending;
      }

      RELAY: for my $relay (@relays) {
        my ($to_context, $to_channel) = @$relay;

        broadcast( 'message',
          $to_context,
          $to_channel,
          $str
        );
      } # RELAY

    } # CHAN

  }  # SERV

  $self->{LeftQueue} = {};

  return PLUGIN_EAT_ALL
}


sub Bot_public_msg {
  my ($self, $core) = splice @_, 0, 2;
  my $msg     = ${ $_[0] };
  my $context = $msg->context;

  my $channel = $msg->target;