fuba_recorderについて
開発ポリシー
- アンチ人工知能
- 要求の分類はすべてパターンマッチで
- 会話はステートレスに
- 用意された発言しかしない
- 高速開発
- タイムラインをみて要求パターンどんどん採用
- 新機能は忘れられないうちに実装
- テストせずに即運用
キャラ付けポリシー
- 信頼できる相方として、基本的に想定の範囲内の返答を返す
- 話しかけられないと話さない
- たまに頭がおかしくなる
- 検索してきた情報の意外性
- text converter
- バグ
- 2分以内に要望に対応して機能追加
fuba_recorderの基本動作
- 1つの要求に対して、1つの回答を返す
- ボクサー
- 木之本桜
- おやすみ
- レシピ提案
- HDD残量通知
- 録画予約
- 番組録画
- 録画要約
- 番組提案
- 自動follow
ひとつの要求が処理されるまでの流れ
- タイムラインのクロール
- tweetを各要求タイプに分類
- 要求タイプに応じて返信を生成
- 返信のpost
- text converter
タイムラインのクロール
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; }
番組表の検索
- 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レコーダー機能
使用したWebサービス
それぞれ使用しています。
また、
- goo番組表を番組表の検索に
- クックパッドをレシピの検索に
- Yahoo! ウェブ検索を検索時のもしかしてデータベースとして
それぞれ勝手に使用しています、すみません…