logo
Автор: ksurent
Описание: bash bot
Язык: Perl
#!/usr/bin/env perl

use utf8;

use Modern::Perl;
use HTML::Entities;
use LWP::UserAgent;
use AnyEvent::IRC::Client;
use Encode qw(encode decode);

my $nick         = '';
my $user         = $nick;
my $real         = $nick;
my $timeout      = 3;
my $password     = '';
my $channel      = '';
my $codepage     = '';

my $c   = AnyEvent->condvar;
my $irc = AnyEvent::IRC::Client->new;

$SIG{INT} = sub {
    $irc->disconnect if $irc->is_connected;
    sleep 1;
    exit;
};

$irc->reg_cb(
    registered => sub {
        my $self = shift;

        $self->enable_ping(60);
        $self->send_srv(JOIN => $channel);
        $self->send_srv(PRIVMSG => $channel, e('Всем темного пива!'));
    },
    privatemsg => sub {
        my($self, undef, $msg) = @_;

        my $sender = (split /!/, $msg->{prefix})[0];
        my $text   = d($msg->{params}[-1]);
        if($text eq '!b') {
            $self->event('quote', $sender);
        }
    },
    publicmsg => sub {
        my($self, undef, $msg) = @_;

        my $text = d($msg->{params}[-1]);
        if($text eq '!b') {
            $self->event('quote', $msg->{params}[0]);
        }
    },
    quote => sub {
        my($self, $send_to) = @_;

        my $quote = get_quote();
        if(defined $quote) {
            $self->send_long_message($codepage, 0, PRIVMSG => $send_to, $quote);
        }
        else {
            $self->event('quote_fail', $send_to);
        }
    },
    quote_fail => sub {
        my($self, $send_to) = @_;

        $self->send_srv(PRIVMSG => $send_to, e('Нету'));
    },
    disconnect => sub {
        my $self = shift;

        $self->send_srv(PRIVMSG => $channel, e('Пака-пака'));
        $c->broadcast;
    },
);

$irc->enable_ssl;
$irc->connect(
    'ghc.ru',
    6697,
    {
        nick     => $nick,
        user     => $user,
        real     => $real,
        timeout  => $timeout,
        password => $password,
    },
);
$c->wait;
$c->disconnect;

sub e {
    encode($codepage, shift);
}

sub d {
    decode($codepage, shift);
}

sub get_quote {
    state $ua = LWP::UserAgent->new(
        timeout               => $timeout,
        max_redirect          => 0,
        requests_redirectable => [],
    );
    my $res = $ua->get("http://bash.org.ru/random");
    return unless $res->is_success;

    state $re = qr{<div class="vote">.+?</div>.+?<div>(.+?)</div>}s;
    my @quotes = $res->decoded_content =~ /$re/g;
    return unless scalar @quotes;

    my $text = $quotes[int rand scalar @quotes];
    $text = decode_entities $text;
    $text =~ s{<br ?/?>}{\012}g;
    $text .= "\012" . ('-' x 10) . "\012";

    $text;
}
Последние размещения:
antonivanov (SQL)
antonivanov (PHP)
brinza (PHP)
ilyhamas (Delphi)
Riateche (PHP)
otherlight (Java)
otherlight (JavaScript)
otherlight (CSS)
otherlight (CSS)
biophreak (JavaScript)
n4n (Perl)
prostoHz (Java)
ndubinkin (XML)
Riateche (Plain Text)
Slapotam (Perl)
ksurent (Perl)
John_Wein (Java)
John_Wein (HTML)
Riateche (HTML)
netsago.paste.β © 2009 Neunica