Perlific

2003-10-22

Užmačiau pas godzhirra idėją apie linkų
gaudymą IRC kanaluose, tad
ėmiau ir sukodinau Perlinį sprendimą. Tas ant greitųjų sumestas botukas
vadinasi Perlific, ir dabar gaudo adresus #perl ir
#php kanaluose bei kiša juos į MySQL duombazę. Štai šio
boto kodas:

#!/usr/bin/perl -w
$|++;
use strict;
use Data::Dumper;
use Net::IRC;
use DBI;

my $config = {
        'db' => {
                'duombaze' => 'duombaze',
                'user'     => 'root',
                'password' => ''},
        'irc'=> {
                'nick'     => 'perlific',
                'server'   => 'irc.delfi.lt',
                'kanalai'  => [ '#perl', '#php' ],
                'ircname'  => 'use Perl;',
                'port'     => 6667 },
        'nickserv' => 'nickserv_identify_passwordas'
        };
my $dbh = DBI->connect('DBI:mysql:'.$config->{'db'}->{'duombaze'},
                       $config->{'db'}->{'user'},
                       $config->{'db'}->{'password'});

my $dbinsert = $dbh->prepare("INSERT INTO links
                             SET linkas = ?,
                                 nick = ?,
                                 kanalas = ?");

my $irc = new Net::IRC;
my $conn = $irc->newconn(Nick    => $config->{'irc'}->{'nick'},
                         Server  => $config->{'irc'}->{'server'},
                         Port    => $config->{'irc'}->{'port'},
                         Ircname => $config->{'irc'}->{'ircname'});

$conn->add_global_handler('public', \&on_public);
$conn->add_global_handler('376', \&on_connect);

$irc->start;

sub on_connect {
        my $self = shift;
        $self->privmsg("nickserv", "identify ".$config->{'nickserv'});
        for my $c (@{$config->{'irc'}->{'kanalai'}}) {
                $self->join($c);
        }
}

sub on_public {
        my $self = shift;
        my $msg = shift;
        my $txt = $msg->{'args'}->[0];
        $txt =~ /(http:\/\/\S+)/
                && prideti_linka($1,
                                 $msg->{'nick'},
                                 $msg->{'to'}->[0]);
}

sub prideti_linka {
        $dbinsert->execute(@_) or warn $dbh->errstr;
}

Boto sugautus adresus galima rasti adresu http://moxliukas.esu.as/perlific.
Ateity turbūt reikės dar visokių featurų pridėt ;-)