logo
Author: ksurent
Description: bash bot
Language: 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;
}
Recent pastes:
prostoHz (Java)
ndubinkin (XML)
Riateche (Plain Text)
Slapotam (Perl)
ksurent (Perl)
John_Wein (Java)
John_Wein (HTML)
Riateche (HTML)
Riateche (JavaScript)
Riateche (JavaScript)
Lisenish (C++)
Lisenish (C++)
cramur (C++)
netsago.paste.β © 2009 Neunica