へんなIRCBot

banana.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use AnyEvent;
use AnyEvent::Twitter::Stream;
use AnyEvent::IRC::Client;
use Encode;
use Net::Twitter::Lite;
use Text::MeCab;

binmode 'STDOUT', ':utf8';

my %twitter_identity = (
    consumer_key    => '**************',
    consumer_secret => '**************',
    token           => '**************',
    token_secret    => '**************',
);

my @channels = qw/ some_channel /;

my $mecab = Text::MeCab->new;

my $tw_lite = Net::Twitter::Lite->new(
    %twitter_identity,
    legacy_lists_api => 0,
);

my @tweets = ();

my $cv = AE::cv;

my $irc = AnyEvent::IRC::Client->new;
$irc->reg_cb(connect => sub {
    my ( $con, $err ) = @_;
    if ( defined $err ) {
        warn "connect error : $err\n";
        return;
    }
    $con->register( 'banana', 'banana', 'banana' );
});
$irc->reg_cb(registered => sub { 
    for my $ch ( @channels ) {
        sleep 4;
        $irc->send_srv(JOIN => '#'.$ch);
    }
});
$irc->reg_cb('irc_*' => sub {
    my $post = $_[1];
    my $work = $post->{params}[1] =~ /(banana|バナナ|ばなな|ﾊﾞﾅﾅ|Banana)/ ? 1 : 0;
    $work = 1 if rand(100) > 75;
    if ( $post->{command} =~ /^(PRIVMSG|NOTICE)$/ && $work ) {
        if ( my @nouns = pickup_noun($post->{params}[1]) ) {
            my $noun = $nouns[int(rand($#nouns + 1))];
            if ( my $tweet = search_tweet( $noun ) ) {
                my $text = trim_tweet($tweet->{text});
                my ($ch) = $post->{params}[0] =~ /^\#(.+)$/;
                say_irc( $ch, $text );
            }
        }
    }
});
$irc->connect('chat.freenode.net', 6667, { nickname => 'banana' });

my $timer = AE::timer 5, 75, sub {
    if ( @tweets && rand(100) > 70 ) {
        my $mes = pick_tweet();
        my $ch = $channels[int(rand($#channels + 1))];
        say_irc( $ch => $mes );
        @tweets = ();
    }
};

my $tw = AnyEvent::Twitter::Stream->new(
    %twitter_identity,
    method          => 'userstream',
    on_tweet => sub {
        my $tweet = shift;
        if( $tweet->{text} ) {
            my $text = trim_tweet( $tweet->{text} );
            if ( length($text) > 0 ) {
                push @tweets, $text;
            }
        }
    },
);

sub say_irc {
    my ($channel, $str) = @_;
    $channel = '#'.$channel;
    $irc->send_chan( $channel => 'NOTICE', $channel => Encode::encode_utf8($str) );
    printf "%s\n", $str;
}

sub pick_tweet {
    return $tweets[int(rand($#tweets + 1))];
}

sub search_tweet {
    my $word = shift;
    my $r = $tw_lite->search( $word );
    return $r->{results}[int(rand($#{$r->{results}} + 1))];
}

sub trim_tweet {
    my $text = shift;
    $text =~ s/http(s)?:\/\/(.+)//g;
    $text =~ s/RT \@\w+//g;
    $text =~ s/\@\w+//g;
    $text =~ s/(#|＃)\w+//g;
    $text =~ s/^://;
    $text =~ s/^(\s|　)+//;
    return $text;
}

sub pickup_noun {
    my $text = shift;
    my @nouns = ();
    my $node = $mecab->parse($text);
    if ( my $word = is_noun($node) ) {
        push @nouns, $word;
    }
    while ( $node = $node->next ) {
        my $word = is_noun($node);
        push @nouns, $word if $word;
    }
    return @nouns;
}

sub is_noun {
    my $node = shift;
    my $feature = Encode::decode_utf8($node->feature);
    my $surface = Encode::decode_utf8($node->surface);
    return $surface if $feature =~ /^名詞,/;
}

$cv->recv;