fuba_recorderについて

経緯

• 2008年秋　friioを使った録画ツール
• 2009å¹´1月　twitterを使って録画予約したい！と思い制作
• 無茶振りを採用しまくって片っ端から機能追加

開発ポリシー

• アンチ人工知能
  • 要求の分類はすべてパターンマッチで
  • 会話はステートレスに
  • 用意された発言しかしない
• 高速開発
  • タイムラインをみて要求パターンどんどん採用
  • 新機能は忘れられないうちに実装
  • テストせずに即運用

キャラ付けポリシー

• 信頼できる相方として、基本的に想定の範囲内の返答を返す
  • 話しかけられないと話さない
• たまに頭がおかしくなる
  • 検索してきた情報の意外性
  • text converter
  • バグ
  • 2分以内に要望に対応して機能追加

fuba_recorderの基本動作

• 1つの要求に対して、1つの回答を返す
  • ボクサー
  • 木之本桜
  • おやすみ
  • レシピ提案
  • HDD残量通知
  • 録画予約
    • 番組録画
    • 録画要約
  • 番組提案
• 自動follow

ひとつの要求が処理されるまでの流れ

• タイムラインのクロール
• tweetを各要求タイプに分類
• 要求タイプに応じて返信を生成
• 返信のpost
  • text converter

タイムラインのクロール

• Perl Net::Twitterモジュール
• 2分に1回、cronで。
• friend_timelineとtimelineから、自分への要求であろうtweetに対して返信する。

my @msgs = reverse (@{$twit->replies}, @{$twit->friends_timeline});

自分への要求かどうかを判別

    for my $nickname (@nicknames) {
        if (($text =~ s/^\@$nickname//) || (
            ($msg->{in_reply_to_screen_name})
            && ($msg->{in_reply_to_screen_name} eq $nickname)
        )) {
            return $text;
        }
    }

my @nicknames = qw/
    fuba＿recorder
    fuba_recoder
    fuba＿recoder
    fuba_ピカァァッ
    フバコレ ﾌﾊﾞｺﾚ
    フバレコ ﾌﾊﾞﾚｺ
    プパペポ
    フバレコたん フバレコちゃん
    フコレバ ﾌｺﾚﾊﾞ
    フコバレ ﾌｺﾊﾞﾚ
    フレコバ ﾌﾚｺﾊﾞ
    フレバコ ﾌﾚﾊﾞｺ
    フヴァレコ ﾌｳﾞｧﾚｺ
    ふゔゃれこ ふびゃれきょ
    フバ様のマシーン
    トウモロコシ小麦粉レコーダー
    フバリコーダー
    fuba_recorder
/;

要求タイプの分類

• 全部パターンマッチで

reply、かつ録画の要求の場合

        if ($text =~ /^(.*?)(?:毎回|全部)(?:録画|予約|(?:録|と)っといて)/) {
            $keyword = $1;
            $is_repeat = 1;
        }
        elsif ($text =~ /^(.*?)(?:(?:、(?:なんとか)お願い)|(?:の|が|に)?(?:関する|出てる|録画|予約|(?:(?:で|出)る)?番組|(?:録|と)っといて))+/) {
            $keyword = $1;
        }
        elsif (($text !~ /(飲|の)みたい/) && ($text =~ /^(.*?)(?:いつやるの|(?:が|を)?(?:見|み|観)たい)/)) {
            $is_qa = 1;
            $keyword = $1;
        }

reply、かつ録画関連の要求でない場合

• レシピ推薦

    if ($m =~ /(?:(?:なに|なん|何)か)?(.*)(?:が|を)?(?:(?:(?:飲|の)(?:み|ま)|(?:た|食)べさ?|(?:喰|食|く)(?:い|わ))(?:た(?:い|く)|せ(?:ろ|て)))/) {
        if (my $str = $1) {
            if (server_avail($avail_dir, 'cookpad')) {
                my $recipe = retrieve_keyword_cookpad($str);
                if ($recipe) {
                    $new_message = join('、', @{$recipe->{ingredients}}).'とか買ってきて'.$recipe->{title}.'を作れ '.$recipe->{url};
                }
                else {
                    $new_message = '何か違うもの食べたほうがいいですよ';
                }
            }
            else {
                $new_message = '検索しすぎ';
            }
        }
    }

• reply版ボクシング

    elsif (my $boxing = text_boxing(
        message => $m,
        ngwords => \@ngwords
    )) {
        $new_message = $boxing->{dump_message}; 
    }

• おやすみ

    elsif ($m =~ /ペプ|行動を?開始|ねる|ねむ|ねて|眠|おやすみ|寝|バタリ|スヤ|ネルソン/) {
        $new_message = $goodnights[floor(rand(scalar(@goodnights)))];
    }

• 黙る

    elsif ($m =~ /黙れ/) {
        $new_message = '...';
    }

• ぜったいだいじょうぶだよ

    elsif ($m =~ /血が.*出る|失業|原君|痛い|進まない|ハァ|＼\(＾o＾\)／|着る服が無い|あー|ねむい|鬱|ヘルプ|へるぷ|help|諦め|苦しい|つらい|希望がない|だめ|ダメ|駄目|死|しぬ|しにたい|自殺|たすけて|助けて|働きたくない|やだ|むり|無理|やめたい/) {
        $new_message = $cheerups[floor(rand(scalar(@cheerups)))];
    }

• 謙遜

    elsif ($m =~ /おめでと|やればできる|でかした|(?:えら|偉)い|お(?:疲|つか)れ|すごい|いい(?:です)?ね|ありがと|thx|サンクス|サンキュー|thank/) {
        $new_message = $yourwelcomes[floor(rand(scalar(@yourwelcomes)))];
    }

• reply回数制限の確認

    elsif ($m =~ /回|制限/) {
        my $avail = server_avail($avail_dir, 'twitter_'.$req->{user});
        $new_message = ($avail - 1);
    }

• HDD残量あいまいに確認

    if (!$new_message) {
        if (int(rand(6))) {
            my $disk = disk_rest();
            if ($disk < 10) { # 10GB未満
                $new_message = $dies[floor(rand(scalar(@dies)))];
            }
            elsif ($disk < 40) { # 40GB未満
                $new_message = $noes[floor(rand(scalar(@noes)))];
            }
            else {
                $new_message = $yeses[floor(rand(scalar(@yeses)))];
            }
        }
    }
    
    $req->{dump_message} = $new_message;
    return $req;
}

replyじゃない場合

• 非reply版ボクシング
• just_do_quizのクイズにこたえる

    if ($req->{message} =~ /^\[quiz\]/) {
        if ($req->{message} =~ /\[\s+\]|次の選択肢/) {
            $req->{is_quiz} = 1;
            return $req;
        }
    }

返信の生成

録画関連

            if ($req->{is_quiz}) {
                post('@'.$req->{user}.' '.answer_quiz(map {$_->{message}} @quiz[0..1], $ua), $mid);
            }
            if ($req->{too_many}) {
                post('@'.$req->{user}.' 検索結果多すぎ、もうちょっと絞ってください', $mid);
            }
            elsif ($req->{is_forbidden}) {
                post('@'.$req->{user}.' そのiepg偽物っぽい', $mid);
            }
            elsif ($req->{has_collision}) {
                post('@'.$req->{user}.' '.$req->{collision_title}.'とかぶるのでむり', $mid);
            }
            elsif ($req->{is_expired}) {
                post('@'.$req->{user}.' そのiepg古い', $mid);
            }
            elsif ($req->{is_qa}) {
                if ($req->{url}) {
                    post('@'.$req->{user}.' '.$req->{keyword}.'、これはどうですか '.$req->{url}, $mid);
                }
                else {
                    post('@'.$req->{user}.' '.$req->{keyword}.'むり', $mid);
                }
            }
            elsif ($req->{is_reserved}) {
                if ($req->{keyword}) {
                    post('@'.$req->{user}.' '.$req->{keyword}.'、もう予約してる', $mid);
                }
                else {
                    post('@'.$req->{user}.' もう予約してる', $mid);
                }
            }
            elsif ($req->{is_repeat}) {
                if (grep {$req->{user} eq $_} @superusers) {
                    my $date = DateTime->from_epoch(epoch => $req->{repeat_expire});
                    my $hdate = $date->ymd('-');
                    post('@'.$req->{user}.' '.$req->{keyword}.'、'.$hdate.'まで全部録画します', $mid);
                    $refresh_repeat_flag = 1;
                }
                else {
                    post('@'.$req->{user}.' 金くれ', $mid);
                }
            }
            elsif ($req->{default_iepg}) {
                if ($req->{has_collision}) {
                    post('@'.$req->{user}.' '.$req->{collision_title}.'とかぶるからむり', $mid);
                }
                else {
                    post('@'.$req->{user}.' 予約した', $mid);
                }
            }
            elsif ($req->{iepg}) {
                my $justified_flag = ($req->{retrieve_result}->{justify}) ? 'とりあえず' : '';
                post('@'.$req->{user}.' '.$req->{keyword}.'、'.$justified_flag.'これ予約した '.$req->{url}, $mid);
            }
            elsif ($req->{keyword}) {
                if ($req->{search_result_num}) {
                    post('@'.$req->{user}.' '.$req->{keyword}.'むり、番組表にはあったけどなんかとかぶってる', $mid);
                }
                else {
                    post('@'.$req->{user}.' '.$req->{keyword}.'むり、検索にひっかかんない', $mid);
                }
            }
            elsif ($req->{dump_message}) {
                if ($req->{is_reply}) {
                    if (grep {$req->{user} eq $_} @uzaiuser) {
                        post('@'.$req->{user}.' '.$req->{dump_message}, $mid) if (int(rand(3)));
                    }
                    else {
                        post('@'.$req->{user}.' '.$req->{dump_message}, $mid);
                    }
                }
                if ($req->{is_boxer}) { # ボクサーの確率調整
                    post($req->{dump_message}, $mid) if (grep {$req->{user} eq $_} @boxeruser);
                    
                    if (grep {$req->{user} eq $_} @boxeruser_light) {
                        post($req->{dump_message}, $mid) if (int(rand(3)));
                        next;
                    }
                    
                    next if (grep {$req->{user} eq $_} @nguser);
                    
                    if (grep {$req->{user} eq $_} @nguser_light) {
                        post($req->{dump_message}, $mid) unless (int(rand(20)));
                        next;
                    }
                    
                    if (grep {$req->{user} eq $_} @nguser_strong) {
                        post($req->{dump_message}, $mid) unless (int(rand(50000)));
                        next;
                    }
                    
                    post($req->{dump_message}, $mid) unless (int(rand(3)));
                }
            }

録画以外の定型文

my @goodnights = qw/とっとと寝ろや 寝るな ぼくもねます 6時起きな/;
my $goodmorning_notice = ( ( (localtime(time))[2] + 1 + 3 + int(rand(7)) ) % 12 ).'時起きな';
push @goodnights, $goodmorning_notice, $goodmorning_notice, $goodmorning_notice;
my @yeses = qw/はい はいはい 了解しました そうですね/;
my @noes = qw/むり めんどくせえ... ハァ〜 らめぇ はぁん はぁ？ だるい/;
my @dies = qw/死ぬ 助けて マジ無理 涅槃きれい… 川渡ってる/;
my @cheerups = qw/
    ぜんっぜん気持ち伝わってこない！もう1回！
    そんなんじゃ聞こえないよ！全っ然気持ちが伝わってこない！
    引きずらない！切り替えていこう！
    がんばれがんばれできるできる絶対できるがんばれもっとやれるって！！
    ぜったいだいじょうぶだよ！なんとかなるよ！
    ぜったいだいじょうぶだよ！
    ぜったいなんとかなるよ！
    だいじょうぶだよ！ぜったいなんとかなるよ！
/;
my @yourwelcomes = qw/
    どういたしまして
    はいはい
    いえいえ
/;

ボクサー生成

sub text_boxing {
    my %opt = @_;
    my $m = $opt{message};
    my $ngwords = $opt{ngwords};
    
    return if (grep {my $ngword = $_; $m =~ /$ngword/} @$ngwords);

    $m =~ s/^(\@[^\s]+\s+)+//;
    my @arms = qw/= ≡ - - - - -=≡ ≡=- 〜/;
    push @arms, '';
    my $arm = $arms[int(rand(scalar(@arms)))];

    my $lnp = $arm.'o';
    my @lpunches = ($lnp, $lnp, $lnp, $lnp, $lnp, '9', 'ï¼™', 'ノ⧉');
    my $lpunch = $lpunches[int(rand(scalar(@lpunches)))];

    my $rnp = 'o'.$arm;
    my @rpunches = ($rnp, $rnp, $rnp, $rnp, $rnp, '6', 'ï¼–', '⧉ヽ');
    my $rpunch = $rpunches[int(rand(scalar(@rpunches)))];

    my @lfaces = map {"(o'-')"} (0..6);
    push @lfaces, "o'-')";
    push @lfaces, "ｲｪｲ! o'-')";
    my $lface = $lfaces[int(rand(scalar(@lfaces)))];

    my @rfaces = map {"('-'o)"} (0..6);
    push @rfaces, "('-'o";
    push @rfaces, "('-'o ｲｪｲ!";
    my $rface = $rfaces[int(rand(scalar(@rfaces)))];
    
    my $result = {
        is_boxer => 0,
        dump_message => '',
    };

    if ($m =~ s/^[^(（\{]*[(（\{]\s*\*?\s*(?:(?:´[・･])|(?:`[・･])|(?:கு)|[☉\'´ுï½€`◕´◕ﾟ^＾・。◠è‘—])/${lface}${lpunch})ﾟ/) {
        $result->{dump_message} = $m;
        $result->{is_boxer} = 1;
        return $result;
    }
    if ($m =~ s/(?:(?:[・･]ï½€)|(?:[・･]´)|(?:கு)|[\'ï½€ு`◕ﾟ☣\ï¼¾◠=☉©権≦])\s*\*?\s*[\})）][^)）\}]*$/ﾟ(${rpunch}${rface}/) {
        $result->{dump_message} = $m;
        $result->{is_boxer} = 1;
        return $result;
    }
    return;
}

返信のpost

Gearmanを使い、

• 録画後の要約画像生成、および報告
• 通常の返信

用に、2つのworkerを動作。

sub post_twit {
    my %opt = @_;
    
    delete $opt{twit};
    delete $opt{ua};

    my @workers = ($opt{worker}) ? ($opt{worker}) : ('localhost');

    my $client = Gearman::Client->new;
    $client->job_servers(@workers);
    my $args = freeze(\%opt);
    my $result_ref;
    $result_ref = $client->dispatch_background("post_twit", \$args, {});

    return $result_ref;
}

worker_post_twitter.pl

投稿につかうGearman用のworker

use Gearman::Worker;
use Storable qw(thaw);

(snip)

my $worker = Gearman::Worker->new;
$worker->job_servers(@hosts);
$worker->register_function(
    post_twit => sub {
        my $job = shift;
        my %opt = %{thaw($job->arg)};

        my $text = $opt{message};
        my $reply_id = $opt{reply_id};
        my $tcss = $opt{tcss};

        if ($opt{video_path}) {
            return 0 unless (-e $opt{video_path});
            my $thumb_url = upload_thumbnail(
                $opt{video_path},
                ($opt{tag} || ''),
            );
            $text .= ' '.$thumb_url;
        }
 
        if (1 == int(rand(3))) {
            $text = convert($text, $tcss, $ua);
        }
        warn $text;
        my $args = {
            status => $text,
        };
        $args->{in_reply_to_status_id} = $reply_id if (defined $reply_id);
        return ($twit->update($args)) ? 1 : 0;
    }
);

$worker->work while 1;

text converter

WedataのText Conversion Servicesに登録されてるものをつかいます。

sub convert {
    my ($text, $tcss_ref, $ua) = @_;
  
    use HTTP::Status qw/:is/;

    my @tcss = @{$tcss_ref};
    srand(time);

    if (@tcss) { 
        my $id = '';
        if ($text =~ s/^(\@\w+\s)//) {
            $id = $1 || '';
        }

        my $url = '';

        if ($text =~ s/(\shttp\:\/\/.*)$//) {
            $url = $1 || '';
        }
        
        my $new_text;
        my $response;
        do {
            my $service = $tcss[floor(rand(scalar(@tcss)))];
            my $surl = $service->{url};
            warn $surl;
           
            my $text_esc = uri_escape(
                encode(
                    ($service->{enc} || 'utf-8'),
                    $text
                )
            );
            $surl =~ s/\%s/$text_esc/;
            
            if ($service->{xpath}) {
                $new_text = get_text_by_xpath($surl, $service->{xpath}, $ua, $service->{enc});
            }
            else {
                $ua ||= LWP::UserAgent->new();
                my $resp_local = $ua->get($surl);
                if (is_success($resp_local->code)) {
                    $new_text = decode($service->{enc}, $ua->get($surl)->content);
                }
            }
        } while (!$new_text);
       
        $new_text =~ s/^\@/ï¼ /;

        $text = $id.$new_text.$url;
        warn $text;
    }

    return $text;
}

Webサービスのつかいかた

• 基本的にscraping
  • APIがそもそもなかった（goo番組表、cookpad）
  • XPathの書きすぎでもうろうとしていてAPIを使うという発想がなかった（yahoo）

番組表の検索

• goo番組表で検索
• みつからなかったら、yahooで検索して最初のタイトルを取得
• goo番組表で再検索
• なかったらあきらめる

• 番組検索

sub retrieve_keyword {
    my ($keyword, $ua, $repeat) = @_;

    return unless $keyword;

    my $search_url = 
        'http://tv.goo.ne.jp/search/result.php?genres%5B%5D=&category=VU&key='
        . uri_escape(encode('EUC-JP', $keyword));
   
    my $tree = HTML::TreeBuilder::XPath::Remote->new_from_uri($search_url, $ua);
    my $number;
    my @number_nodes = $tree->findnodes('id("incontents")/p[@class="fs16"][1]');
    if (@number_nodes) {
        my $text = $number_nodes[0]->as_text;
        $text =~ /\((\d+)件\)/;
        $number = $1 || 0;
    }
    return unless $number;

    my $xpath = '//table[@class="t01"]//a[contains(@href, "/contents/program")]';
    $xpath .= '[count(./img) < 1]' if ($repeat);
    my @urls = $tree->findnodes($xpath);
    my @url_list;
    if (scalar(@urls)) {
        @url_list = map {
            $_->attr('href')
        } @urls;
        return {
            number => $number,
            list => \@url_list,
        };
    }

    return;
}

• もしかして

sub justify_keyword {
    my ($keyword, $ua) = @_;

    my $yahoo_search_url =
        'http://search.yahoo.co.jp/search?ei=UTF-8&p='
        . uri_escape(encode('utf-8', $keyword));
    my $tree = HTML::TreeBuilder::XPath::Remote->new_from_uri($yahoo_search_url, $ua);
    my $text = '';
    if (my @nodes = $tree->findnodes('id("web")/ol/li/a')) {
        $text = $nodes[0]->as_text;
    }
    $text =~ s/\[[^\]]+\]$//;
    
    return "$text";
}

cookpadで検索

• キーワードをちょっと分解して、ふつうに検索
• 結果から材料だけ抽出して、「材料買ってこい」

sub retrieve_keyword_cookpad {
    my ($keyword, $ua) = @_;

    return unless $keyword;

    if (my @keywords = split(/と|の|で作る/, $keyword)) {
        $keyword = join ' ', @keywords;
    }

    my $search_url = 
        'http://cookpad.com/%E3%83%AC%E3%82%B7%E3%83%94/'
        . uri_escape(encode('utf-8', $keyword));
   
    my $tree = HTML::TreeBuilder::XPath::Remote->new_from_uri($search_url, $ua);

    my $xpath = '//div[@class="recipe-preview"]//span[contains(@class, "title")]/a';
    my $xpath_ing = '//div[@class="recipe-preview"]//div[contains(@class, "material")]';
    my @urls = $tree->findnodes($xpath);
    my @ings_nodes = $tree->findnodes($xpath_ing);
    if (scalar(@urls)) {
        my $index = floor(rand(scalar(@urls)));
        my $url = $urls[$index];
        my $ing = $ings_nodes[$index]->as_text;
        
        $ing =~ s/(\s|　)+/ /g;
        $ing =~ s/^\s*材料：//;
        my @ings = map {s/\s.*$//;$_} split /、/, $ing;
        @ings = (@ings > 3) ? @ings[0..2] : @ings;

        return {
            title => $url->as_text,
            url => $url->attr('href'),
            ingredients => \@ings,
        };
    }

    return;
}

HDDレコーダー機能

• 録画予約要求からiEPGファイルを取得、録画予約リストに追加
  • 毎回録画機能：日に1回1週間分の番組を検索し、マッチしたものをすべて録画予約リストに追加
• 30秒ごとに録画リストを走査、録画開始フラグの立ったiEPGをつかって録画
  • 録画開始前にtwitterに通知
  • 録画終了後に要約画像といっしょにtwitterに通知

要約画像生成

• ffmpegでスクリーンショット

• スクリーンショットをいろいろ処理

• Flickr APIでアップロード

使用したWebサービス

• Twitterをプラットフォームとして
• Flickrを映像要約画像の保存先として

それぞれ使用しています。
また、

• goo番組表を番組表の検索に
• クックパッドをレシピの検索に
• Yahoo! ウェブ検索を検索時のもしかしてデータベースとして

それぞれ勝手に使用しています、すみません…

謝辞

• このような発表の場を用意してくださったチームラボ様
• flickrのproアカウントをくださった有料会員のisbsh様
• その他いろいろアイディアを頂いたりキャラクタをパクらせてくださったtwitterでのfollowing/followers各位

ありがとうございました。これからもfuba_recorderをよろしくお願いいたします。