IRC/Bot moderador

De Hackmeeting

Version 0.1 by meskio, queda aqui para el futuro.

#!/usr/bin/perl
# Este es un Bot de IRC preparado para hacer de moderador en asambleas

use warnings;
use strict;
use POE;
use POE::Component::IRC;
use Getopt::Long;


# información de conexion
my $nickname = 'moderador';
my $username = 'moderador';
my $ircname  = 'El sumo moderador';
my $server   = 'irc.freenode.net';
my $port     = '6667';
my $channel  = '#hackmeeting';

# textos
my $welcome = "<</me pide la palabra>> para esperar turno para hablar
<</me pide frase>> para pedir frase
tu turno de palabra termina cuando escribes un mensaje con <<.>>
tu turno de frase te permite enviar un solo mensage, pero tienes prioridad.";
my $msg      = '';
my $help;

# orden de palabras y frases pedidas
my @palabras = ();
my @frases = ();
my $fue_frase = 2; # bool indica si la última peticion era frase, 2 indica que nadie esta hablando

# regexp de los comandos
my $palabra = '.*palabr.';
my $fin_escritura = '^\.$';
my $frase = '.*frase.*';


# parsear los parametros
usage() if ( ! GetOptions('help|h'      => \$help,
		                  'nick|n=s'    => \$nickname,
						  'user|u=s'    => \$username,
						  'irc|i=s'     => \$ircname,
						  'server|s=s'  => \$server,
						  'port|p=s'    => \$port,
						  'channel|c=s' => \$channel,
						  'msg|m=s'     => \$msg)
			or defined $help );
sub usage {
	print "usage: moderador [--nick|-n nickname] [--user|-u username] [--irc|-i ircname] [--server|-s server] [--port|-p port] [--channel|-c channel] [--msg|-m mensage] [--help|-h]\n";
	exit;
}

print "Iniciando conexión......\n";

# Crea el componente de IRC
my ($irc) = POE::Component::IRC->spawn();

# Crea la sesión, indicandole los eventos que queremos que atienda
POE::Session->create(
  inline_states => {
    _start     => \&bot_start,
    irc_001    => \&on_connect,
    irc_public => \&on_public,
	irc_join   => \&on_join,
	irc_nick   => \&on_nick,
	irc_part   => \&on_part,
	irc_quit   => \&on_part,
	irc_ctcp_action   => \&on_me,
  },
);


# Al iniciar la sesion, conectarse al servidor
sub bot_start {
  $irc->yield(register => "all");
  $irc->yield(
    connect => {
      Nick     => $nickname,
      Username => $username,
      Ircname  => $ircname,
      Server   => $server,
      Port     => $port,
    }
  );
  print "Conectado a: $server\n";
}

# Una vez este conectado al servidor conectarse al canal y enviar mensaje
sub on_connect {
	$irc->yield(join => $channel);

	envia_texto($channel, $welcome);
	if ($msg)
	{
		envia_texto($channel, $msg);
	}
	print "Conectado a: $channel\n";
}

# Interpretar los mensajes de los usuarios
sub on_public {
  my ($kernel, $who, $where, $msg) = @_[KERNEL, ARG0, ARG1, ARG2];
  my $nick    = (split /!/, $who)[0];

  if ($fue_frase == 1) {
	  if ($nick eq $frases[0]) {
		  shift(@frases);
		  asignar_voz();
	  }
  } elsif ($fue_frase == 0) {
	  if (($msg =~ /$fin_escritura/) and ($nick eq $palabras[0])) {
		  shift(@palabras);
		  asignar_voz();
	  }
  }
}

# Enviar mensage de info cuando se conecte alguien nuevo
sub on_join {
    my ($kernel, $who, $where) = @_[KERNEL, ARG0, ARG1];
    my $nick    = (split /!/, $who)[0];

	envia_texto($nick, $welcome);
	if ($msg)
	{
		envia_texto($nick, $msg);
	}
}

# Cuando alguien cambia de nick hay que actualizar
sub on_nick {
  my ($kernel, $prev, $now) = @_[KERNEL, ARG0, ARG1];
  my $prev_nick    = (split /!/, $prev)[0];
  my $now_nick    = (split /!/, $now)[0];

  for (my $i = 0; $i < @palabras; $i++) {
	  if ($palabras[$i] eq $prev_nick) {
		  $palabras[$i] = $now_nick;
	  }
  }
  for (my $i = 0; $i < @frases; $i++) {
	  if ($frases[$i] eq $prev_nick) {
		  $frases[$i] = $now_nick;
	  }
  }
}

# Si se va pierde sus palabras
# FIXME: si me caigo y me reconecto también las pierdo
sub on_part {
  my ($kernel, $who) = @_[KERNEL, ARG0];
  my $nick    = (split /!/, $who)[0];

  my $tengo_que_asignar = 0;
  if (@frases > 0) {
	  if ($frases[0] eq $nick) {
		  $tengo_que_asignar = 1;
	  }
  } elsif ((@palabras > 0) and ($palabras[0] eq $nick)) {
	  $tengo_que_asignar = 1;
  }

  my $j = 0;
  for (my $i = 0; $i < @palabras; $i++) {
	  # Deslizar para eliminar el nick
	  if ($j != $i) {
		  $palabras[$j] = $palabras[$i];
	  }
	  if ($palabras[$i] ne $nick) {
		  $j++;
	  }
  }
  while ($#palabras >= $j) {
	  pop(@palabras);
  }

  $j = 0;
  for (my $i = 0; $i < @frases; $i++) {
	  # Deslizar para eliminar el nick
	  if ($j != $i) {
		  $frases[$j] = $frases[$i];
	  }
	  if ($frases[$i] ne $nick) {
		  $j++;
	  }
  }
  while ($#frases >= $j) {
	  pop(@frases);
  }

  if ($tengo_que_asignar) {
	  asignar_voz();
  }
}

# /me para pedir palabra
sub on_me {
  my ($kernel, $who, $where, $msg) = @_[KERNEL, ARG0, ARG1, ARG2];
  my $nick    = (split /!/, $who)[0];

  if ($msg =~ /$palabra/)
  {
	  push(@palabras, $nick);
	  print "$nick ha pedido palabra\n";
  }
  if ($msg =~ /$frase/)
  {
	  push(@frases, $nick);
	  print "$nick ha pedido frase\n";
  }
  print "frases: " . join(", ", @frases) . ".\n";
  print "palabras: " . join(", ", @palabras) . ".\n";

  if ($fue_frase == 2)
  {
	  asignar_voz();
  }
}

sub asignar_voz {
	my $str = "";

	if (@frases > 0) {
		$str = "da frase a $frases[0]";
	    if (@frases > 1) {
			$str .= " otras frases pedidas: " . 
					join(', ', @frases[1..$#frases]) . ".";
		}
		$fue_frase = 1;
	} elsif (@palabras > 0) {
		$str = "da la palabra a $palabras[0].";
	    if (@palabras > 1) {
			$str .= " otras palabras pedidas: " . 
					join(', ', @palabras[1..$#palabras]) . ".";
		}
		$fue_frase = 0;
	} else {
		$fue_frase = 2;
	}

	if ($str ne "") {
	   	$irc->yield(ctcp => $channel => "ACTION $str");
	}
}

sub envia_texto {
	my ($who, $txt) = @_[0, 1];

	foreach (split("\n", $txt)) {
		$irc->yield(privmsg => $who, $_);
	}
}

# Ejecutar el bot hasta que termine
$poe_kernel->run();
exit 0;