PerlでSkypeボットを作る

結構前にNet::DBus::Skype::Liteというモジュールを書き始めました。一応、自分のやりたいことはできるようになったので、今では未完成のまま開発停止中です。
akiym/Net-DBus-Skype-Lite · GitHub
ドキュメントがなく、コードも微妙、そしてテストもないので使わないほうがいいですね。また、プラットフォームはLinuxのみです。
実際、Skypeボットを作るのなら、Skype4Pyがいいと思います(僕も使っています)。
以下、Skypeボットのサンプルです。

use strict;
use warnings;
{
    package Net::DBus::Reactor;
    use Coro::Select qw/select/;
    use Net::DBus::Reactor;
}
use Net::DBus::Skype::Lite;
use LWP::UserAgent;
use XML::Simple;
use Log::Minimal;

my $ua = LWP::UserAgent->new();
sub get_info {
    my ($video_id) = @_;
    my $res = $ua->get("http://ext.nicovideo.jp/api/getthumbinfo/$video_id");
    my $info = XMLin($res->decoded_content);
    return unless $info->{status} eq 'ok';
    my $thumb = $info->{thumb};
    my $message = "$thumb->{title}\n$thumb->{description}";
}

my $skype = Net::DBus::Skype::Lite->new(notify => sub { debugf($_[1]) });
$skype->message_received(sub {
    my ($msg) = @_;
    my $body = $msg->body;
    if (my ($video_id) = $body =~ /([sn]m\d+)/) {
        my $message = get_info($video_id);
        return unless $message;
        infof($msg->from_dispname . ': ' . $body);
        if ($msg->body =~ /@俺/) {
            $skype->user($msg->from_handle)->send_message($message);
        } else {
            $msg->chat->send_message($message);
        }
    }
});

my $reactor = Net::DBus::Reactor->main();
$reactor->run();
local $SIG{INT} = sub {
    $reactor->shutdown();
};

これはニコニコ動画のURLもしくはsm*、nm*といった動画IDを書きこむと動画タイトルを取ってきてくれる便利ボット。
会議チャットのときに「@俺」をURLと一緒に書き込むと自分だけに動画タイトルを取ってきてくれます。

use strict;
use warnings;
{
    package Net::DBus::Reactor;
    use Coro::Select qw/select/;
    use Net::DBus::Reactor;
}
use Net::DBus::Skype::Lite;
use Encode;
use Encode::Guess qw/euc-jp shiftjis iso-2022-jp/;
use LWP::UserAgent;
use Log::Minimal;

my $ua = LWP::UserAgent->new();

my $skype = Net::DBus::Skype::Lite->new();
$skype->message_received(sub {
    my ($msg) = @_;
    if (my ($url) = $msg->body =~ m{(https?://.+)}) {
        infof($url);
        my $res = $ua->get($url);
        if (my $title = decode('Guess', $res->header('title'))) {
            $msg->chat->send_message(encode_utf8($title));
        }
    }
});

my $reactor = Net::DBus::Reactor->main();
$reactor->run();
local $SIG{INT} = sub {
    $reactor->shutdown();
};

これはURLを書き込むとタイトルを取ってきてくれる便利ボット。先ほどのニコニコ動画ボットと合わせるとちょー便利ですね。

最後に爽やかな気持ちでニッコリできるボットを紹介します。ニッコリさせたい人をコマンドライン引数に渡しましょう。

use strict;
use warnings;
{
    package Net::DBus::Reactor;
    use Coro::Select qw/select/;
    use Net::DBus::Reactor;
}
use Net::DBus::Skype::Lite;

my $username = shift or die;

my $skype = Net::DBus::Skype::Lite->new();
while (1) {
    $skype->user($username)->send_message(':)');
}

my $reactor = Net::DBus::Reactor->main();
$reactor->run();
local $SIG{INT} = sub {
    $reactor->shutdown();
};