Hatena::ブログ(Diary)

fubaはてな

 

20110112

新しい MacBook Air がほしいですね

MacBook Air 11インチ欲しい!

金がないので MacBook という名前になった最初の白いやつを長年使ってるんですが、一度ファンを交換したにもかかわらずまたファンの音がおかしくなってきています。もう一度交換すればいいんじゃないのという感じもするけど、

http://gameport.ocnk.net/product/134

を見ると6000円。5年間使ったマシンパームレストが割れるリスクと6000円を投じて静音とかちょっと考えたくないです。

あと電池も交換しました。これは非純正にもかかわらず明らかに金型が同じものを円高に物を言わせて DealExtreme.com で $48 程度で購入しました。DealExtreme.com は発送が遅い以外は大変安く送料もだいたい無料だし PayPal も使えて安心便利なので、ゴミを購入するときにはぜひ使うといいと思います。ただこの電池、普通につかってるだけで突然電源が落ちたりするし、微妙につくりがわるくそのうち外れそうです。8ヶ月で壊れたという残念なレビューもありましたし、今みるとちょっと容量のでかいやつが $38.90 で売ってるし大変ファックですね。

ここまでして今の MacBook を使ってるのは金のこともありますが、tumblr ステッカーもったいないというのもあるし新しい tumblr ステッカーもほしいですね。Tumblr ステッカー欲しい!?

20090718

20090320

fuba_recorderについて

経緯

開発ポリシー

キャラ付けポリシー

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

fuba_recorderの基本動作

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

タイムラインクロール

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);
    }
    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じゃない場合
    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', '9', 'ノ&#10697;');
    my $lpunch = $lpunches[int(rand(scalar(@lpunches)))];

    my $rnp = 'o'.$arm;
    my @rpunches = ($rnp, $rnp, $rnp, $rnp, $rnp, '6', '6', '&#10697;ヽ');
    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*(?:(?:´[・・])|(?:`[・・])|(?:&#2965;&#3009;)|[&#9737;\'´&#3009;``&#9685;´&#9685;゚^^・。&#9696;著])/${lface}${lpunch})゚/) {
        $result->{dump_message} = $m;
        $result->{is_boxer} = 1;
        return $result;
    }
    if ($m =~ s/(?:(?:[・・])|(?:[・・]´)|(?:&#2965;&#3009;)|[\'`&#3009;`&#9685;゚&#9763;\^&#9696;=&#9737;〓権≦])\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サービスのつかいかた

番組表検索

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サービス

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

また、

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

謝辞

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