User:HighInBC/MCP/IRCFeed

This is a plugin, not a stand alone program.

This program is licensed under the GFDL

package HBCPlugins::IRCFeed;
use     strict;
use     Data::Dumper;
use     Net::IRC;
our     $self;

sub new
  {
  shift;
  $self = shift;
  bless($self);
  $self->{irc_obj} = new Net::IRC;                                      # Net::IRC our master IRC object
  $self->{on_server} = 0;
  $self->{hooks} = [];

  warn "Connecting to IRC...\n";
  my $conn = $self->{irc_obj}->newconn
                        (                                       #|Connect to the server
                         Nick           => $self->{params}->{bot_name},        #|
                         Server         => $self->{params}->{server},          #|
                         Port           => $self->{params}->{port},            #|
                        );
  $conn->add_handler    ('endofmotd'    => \&on_connect);       # Set off by a connect to server
  $conn->add_handler    ('disconnect'   => \&on_disconnect);    # Set off when connection to server is lost
  $conn->add_handler    ('public'       => \&on_public);        # Set off by public messages
  &{$self->{shared}{add_job}}(\&event_loop , 0);
  #warn Dumper({'internal',$self});
  return $self;
  }

sub event_loop
  {
  $self->{irc_obj}->do_one_loop();
  &{$self->{shared}{add_job}}(\&event_loop , 0);
  return;
  }

sub add_hook
  {
  my $self = shift;
  my $hook = shift;
  push(@{$self->{hooks}},$hook);
  }

#___________________IRC_triggered_subs___________________#

sub on_connect  # triggered when motd is done... otherwords when you connect to server.
  {
  my $irc_self  = shift;
  my $event     = shift;

  my $server    = $self->{params}->{server};
  my $port      = $self->{params}->{port};
  my $bot_name  = $self->{params}->{bot_name};

  warn "Connected to IRC server '$server:$port' as '$bot_name'.\n";
  foreach my $chan (@{$self->{params}->{channels}})
    {
    &{$self->{shared}{add_job}}([\&get_on_channel , $irc_self , lc($chan)] , 0);
    }
  $self->{params}->{on_server} = 1;
  }

sub get_on_channel
  {
  my $irc_self  = shift;
  my $chan      = shift;
  $chan = lc($chan);
  warn "Attempting to join $chan.\n";
  my $response = $irc_self->join($chan);                                       # try to join channel
  die("Got join response of: $response\n") unless ($response == 20);
  warn "Joined.\n\n";
  }

sub on_disconnect # triggered when server connection is lost.
  {
  my $irc_self  = shift;
  my $event     = shift;

  my $reconnect_delay = $self->{params}->{reconnect_delay};
  my $server    = $self->{params}->{server};
  my $port      = $self->{params}->{port};

  my $reason = ${$event->{'args'}}[0];
  warn "Connection lost:".$reason."\n";
  warn "Waiting $reconnect_delay seconds before reconnecting to avoid hammering.\n";
  $self->{params}->{on_server} = undef;
  sleep($reconnect_delay);      # Avoid getting hammer-blocked by waiting before reconnect.
  warn "Attempting to reconnect to $server:$port\n";
  until ($irc_self->connect()){print "Retry...\n"}  # Start again from the beggining by reconnecting, uses same logfile
  }

sub on_public
  {
  my $irc_self  = shift;
  my $event     = shift;

  my $statement = ${$event->{'args'}}[0];
  foreach my $rh_hook (@{$self->{hooks}})
    {
    if (my $resp = &{${$rh_hook}{check}}($statement))
      {
      my $r_job = ${$rh_hook}{callback};
      if (ref($r_job) eq 'ARRAY')       # Callback style, reference to an array with a sub followed by paramaters
        {
        my @callback = @{$r_job};
        my $cmd = shift(@callback);
        &{$cmd}($statement,$resp,@callback);
        }
      elsif (ref($r_job) eq 'CODE')     # Otherwise just the reference to the sub
        {
        &{$r_job}($statement,$resp);
        }
      }
    }
  }

1;