Dar vieno analitiko svetainė

Petras Kudaras

Perlific

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 ;-)