Perlific

Užmačiau pas godzhirra href="http://god.aurus.lt/blog.php/28#comments">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 href="http://moxliukas.esu.as/perlific">http://moxliukas.esu.as/perlific.
Ateity turbūt reikės dar visokių featurų pridėt ;-)

Komentarų: 7

  1. GameBit > October 22, 2003

    padaryk kad tu paciu linku nerodytu http://moxliukas.esu.as/perlific/ bu daba shvln|php linka pakartojau ir 2 kartus jis ten ;]

  2. moxliukas > October 22, 2003

    Done.

  3. Lakunas > October 22, 2003

    hakerey ;) o kaip su linku spamu? :)

  4. dmns > October 22, 2003

    grazus kodas :)

  5. Liuksas > October 27, 2003

    radau pora riktu:]

    pirma nepagauna jeigu yra linas be http:// o tik www (www.php.lt)

    antra parasius su /me visai nepagauna liko!

    vat…

    labankt:]

  6. NB > October 27, 2003

    be http:// tai net ne linkas

  7. Дверкин Павлег > April 29, 2009

    Докажите, что всё вот так то? Исследую, как нам прояснить данную тему.

Palik komentarą