Este script é um modelo de ircbot, usando SQLite, modulos extras que podem ser instalados via CPAN e expressões regulares. Este ircbot não está 100% funcional e pode apresentar alguns problemas, mas nada que irá prejudicar a sua maquina ou sistema. Um arquivo de banco de dados do SQLite deve ser criado e colocado junto ao script, logo abaixo estão as variaveis de configurações...

• Download bot.pl
• Enviar nova versão

Esconder código-fonte

#!/usr/bin/perl -w

# Este script é um modelo de ircbot, usando SQLite,
# modulos extras que podem ser instalados via CPAN e
# expressões regulares. Este ircbot não está 100%
# funcional e pode apresentar alguns problemas, mas
# nada que irá prejudicar a sua maquina ou sistema.
# Um arquivo de banco de dados do SQLite deve ser
# criado e colocado junto ao script, logo abaixo
# estão as variaveis de configurações...
#
# by Adão Raul (dark_on_weed)

######### /CONFIGURAÇÔES\ #########

my $Server = 'irc.alternet.com.br';
my $Port = 6667;
my $Nick = 'darkbot';
my $Ircname = 'darkbot by dark_on_weed';
my $Username = 'darkbot';
my $DB = 'bot.db';

######### \CONFIGURAÇÔES/ #########

use Net::IRC;
use DBI;
use strict;

my $irc = new Net::IRC;

my $conn = $irc->newconn( Server   =>   $Server,
           Port      =>   $Port,
           Nick      =>   $Nick,
           Ircname  =>   $Ircname,
           Username =>   $Username);

$conn->{channel} = '#vol';

sub on_connect
{
    my $conn = shift;
    print STDERR "Entrando no #canoas\n";
    $conn->join($conn->{channel});
    $conn->{connected} = 1;
}

sub on_join
{
    my ($conn, $event) = @_;
    my $nick = $event->nick;
    if ($nick ne $Nick)
    {
      $conn->privmsg($conn->{channel}, "Olá, $nick!");
    }
}

sub on_public
{
  my ($conn, $event) = @_;
   my $text = $event->{args}[0];
    my $nick = $event->nick;
    
    if ($text =~ /(^hehe(.+)|^haha(.+))/)
    {
        $conn->privmsg($event->{to}[0], "hehehehehehe quase me mijei de tanto rir!");
    }
    
    elsif ($text =~ /(^darkbot(.+))/)
    {
        $conn->privmsg($event->{to}[0], "$nick, não fale comigo...");
    }
    
    elsif ($text =~ /^\!addquote (.+)/)
    {
        my $dbc = DBI->connect("dbi:SQLite:dbname=$DB","","");
        $text =~ s/(_[^_]*_[^_]*_)|(!addquote )//;
        my $query = "INSERT INTO quotes VALUES ('$text')";
        my $sth = $dbc->prepare($query);
        $sth->execute;
        $dbc->disconnect();
    }
    
    elsif ($text =~ /^\!quote (.+)/)
    {
        my $dbc = DBI->connect("dbi:SQLite:dbname=$DB","","");
        $text =~ s/(_[^_]*_[^_]*_)|(!quote )//;
        my $query = "SELECT * FROM quotes WHERE one LIKE '%$text%' LIMIT 1";
        my $sth = $dbc->prepare($query);
        $sth->execute;
        while (my $ref = $sth->fetchrow_hashref())
        {
            $conn->privmsg($event->{to}[0], "quote: $ref->{'one'}");
        }
        $dbc->disconnect();
    }
}

sub on_quit
{
  my ($conn, $event) = @_;
  my $quitmsg = $event->{args}[0]; 
  my $nick = $event->nick;
  print STDERR "*** $nick has quit IRC $quitmsg\n";  
}

sub on_msg
{
   my ($conn, $event) = @_;
   my $text = $event->{args}[0];
   if ($text =~ /(ola(.+)|(.+) ola(.+)|(.+) ola|ola)/)
    {
        $conn->privmsg($event->{nick}, "Olá amigo...");
   }
    elsif ($text =~ /(oi(.+)|(.+) oi(.+)|(.+) oi|oi)/)
    {
        $conn->privmsg($event->{nick}, "Oiiii, como vai?");
   }
}

sub on_version {
    my ($conn, $event) = @_;
    my $nick = $event->nick;
    $conn->ctcp_reply($nick, 'DarkBot v0.64 by dark_on_weed');
    print STDERR "*** CTCP VERSION request from $nick received\n";
}

sub on_ping {
    my ($conn, $event) = @_;
    my $nick = $event->nick;
    $conn->ctcp_reply($nick, 'PING ' . join (' ', ($event->args)));
    print STDERR "*** CTCP PING request from $nick received\n";
}

$conn->add_handler('quit', \&on_quit);
$conn->add_handler('cping', \&on_ping);
$conn->add_handler('cversion', \&on_version);
$conn->add_handler('public', \&on_public);
$conn->add_handler('msg', \&on_msg);
$conn->add_handler('join', \&on_join);
$conn->add_handler('376', \&on_connect);
$irc->start();

Troca palavras em Perl

data e hora

Agenda em Perl

Script que mostra a temperatura do processador

Substituir palavras em arquivos