unknownplace.org

perlbrew 使ってたんだけど、tokuhirom がつくってる plenv にスイッチした。

perlbrew よりシンプルでなにやってるかわかるのがなにより。 というか perlbrew がよく分からなすぎるという話もある。

plenv だとさらに .perl-version というファイルに perl のバージョンをいれておくと、そのディレクトリ以下では自動的にそのバージョンの perl が使われるという機能があって、これがだいぶはかどる。

perlbrew で入れた各種 perl は -g つけわすれて SEGV したときこまってて別途 --as=5.14.2-debug みたいのをつくってたけど、 その経験を生かして今度は最初から

$ plenv install 5.14.2 -D=DEBUGGING=-g

な感じで全部入れるようにした。ちなみにこの install オプションはまだドキュメントになってないのでまだ変わるかもしれないから、この記述は参考にしないようおねがいいたす。

perlbrew と比べるといったんラッパーをかます分 bootstrap が遅いというのがあって、 flymake とかだと結構気になるけど、 perl のバージョン検出の仕組みはシンプルだから elisp でかき直すのもすぐできそう。

Any::Moose は Moose と Mouse のラッパーで、バックエンドがどちらになるかは use Any::Moose した時点で Moose or Mouse がロードされているかによって変わる。

どこかで use Moose していたら use Any::Moose は use Moose としてうごくし、 そうじゃない場合は use Mouse としてうごく。

これはなんのためにあるかというと、MouseとMooseの両方のモジュールを混ぜて使うと壊れるからなんだけど、 そもそも混ぜて使って問題になるのは Mouse のクラスを Moose で extends したりとか、そういう Moose 周りの機能を相互に使おうとした場合だけであって、混ぜて使っていてもそれぞれのクラスを普通に使い合う分にはなんの問題もない。

また、昔はruntimeの速度にそこまで性能差はなかったということもある。(make_immutable してたら Moose もそこまで遅くない)

しかし現在では gfx マジックによって Mouse は激しく高速化されており、runtime での速度差もかなりある。 したがって、Moose的な意味で相互利用する場合でなければ、Any::Moose が勝手に Moose になるとうれしくない場合がほとんどだ。

さらに、MooseとMouseの非互換によって、バックエンドがMouseのときはうまく動いていたコードが、 どこからMooseモジュールを使用したことによってバックエンドがMooseに切り替わった瞬間に動かなくなるという事例もある。

結論として Any::Moose つかわないで Mouse を直で使う、で誰も困らないなーとおもってるのでそうしていこうと考えております。

もし混ぜることがあったとしても Moose からつかうときは non Moose なクラスとして扱うようにすれば別に問題ないでしょう。(僕はそもそもMoose使わないけどw)

僕のトークでなんか気になった人がいるとのことなので僕の使っているスクリプトを置いておきますね。

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use Cocoa::BatteryInfo;
use Cocoa::EventLoop;
use Cocoa::Growl ':all';

growl_register(
    app           => 'Battery Notifier',
    notifications => ['NotifyLastOneMinite', 'NotifyTimeRemaining'],
);

Cocoa::BatteryInfo::time_remaining_handler {
    my $sec = Cocoa::BatteryInfo->time_remaining_estimate;

    return unless $sec =~ /\d/;

    if ($sec <= 60) {
        growl_notify(
            name        => 'NotifyLastOneMinite',
            title       => 'バッテリー切れまで',
            description => sprintf '残り %d 秒', $sec,
        );
    }
    else {
        my $time;

        if ($sec >= 60*60) {
            $time = sprintf '%d 時間 %d 分 %d 秒',
                int($sec / (60*60)), int(($sec % (60*60)) / 60), $sec % 60;
        }
        elsif ($sec > 60) {
            $time = sprintf '%d 分 %d 秒',
                int($sec / 60), $sec % 60;
        }
        else {
            $time = sprintf '%d 秒', $sec;
        }

        growl_notify(
            name        => 'NotifyTimeRemaining',
            title       => 'バッテリー切れまで',
            description => sprintf '残り %s', $time,
        );
    }
};

Cocoa::EventLoop->run;

これを LaunchAgent でログイン時に自動で立ち上がるようにしております。

で、これをうごかしているとバッテリー残り時間が変化したタイミングで Growl 通知が来るのですが、 普通は NotifyTimeRemaining という通知が来ます。もしそのときに残りが60秒いないだったらその代わりに NotifyLastOneMinite という通知が来ます。

毎回通知されるのはうざいので僕は NotifyTimeRemaining というほうは Growl の設定でオフにしています。

で、だいたい使っている感覚としては60秒でまず通知が来て、 その後もういちど、残り0秒という通知がきて、その直後にハイバネートする、というような感じのようです。

今回は前夜祭でも話すことになって、始めて前夜祭からの参加になったけど、なかなかおもしろかった。

トークは二つってのはかなり久しぶりだけど、どちらも20分だし、YAPC向けになにか特別ネタを用意したというわけではなく、普段やってることや考えていることを話しただけでだいぶがんばってない感じのトークです

UV - libuv binding for Perl

Perlハッカーは息をするようにCPANモジュールを書く

というようなトークたちです。

今回は基本的にホールで電源ある席を陣取り、コード書きつつトークを見る、というスタイルで参加。

Padre の話は聞けなかったんだけど、Adam Kennedy さんはなんというか堂々としていて自信に満ちていてかっこよかった。あう言う大人になりたい。 Cocoa ネイティブ対応はなんか気が向いたら見てみようかなーって言う感じ。

Ingy はなんかすごいおじいちゃんっぽくなってておもしろかった。

NYTProf の話は Phase0 のスピリチュアルなところが結構響いた。これは見せたい人が一杯いるのでスライドを待つ。 実際の最適化の話はおおむね賛成できるかなーというところ。pidのオプションとかしらなかったなー。

mizzy さんはほんとにいいひとだな！ って思いました。

あと、antipop さんはきもいすごい

本日二回ほどバッテリー切れで黒い画面をみて、「システムのバッテリー残量警告でるのはやすぎなんだよなーもっとぎりぎりの残量通知が欲しいよなー」、とか思いつつバッテリー周りのAPIドキュメントを眺めていたら気がついたらCPANモジュールができていた…。

Cocoa::BatteryInfo - Getting battery informations on your Mac - metacpan.org

単純なバッテリー情報の取得の他にも、 Cocoa::EventLoop との合わせ技で OS からのバッテリー関連通知を受け取るという機能もあるので残量監視スクリプトなど作るのに最適です。

というとネタモジュールな感じだけど、ノートブックのインターナルバッテリー以外にも OS X Server に接続している UPS の情報などもとれたりしますのでわりとそっち系では実用モジュールなのではないかと思われる。

JSON-Types-0.01 - variable type utility for JSON encoding - metacpan.org

Perl から JSON 吐くときに、ここは絶対数値で（文字列で）だしたい、みたいなときに

use JSON;

print encode_json({
    number => $num + 0,
    string => $str . '',
    bool   => $bool ? \1 : \0,
});

みたいにすることがあるかもしれませんが、これってやっぱりハックなので可読性悪いしわかりにくいってことで、

use JSON;
use JSON::Types;

print encode_json({
    number => number $num,
    string => string $str,
    bool   => bool $bool,
});

みたいな感じで、まぁ内部的にやってることは同じなのですが可読性を上げていこう！というような趣旨のモジュールです。

追伸： Acme::Hidek のリリースで hidek さんの誕生日を知りました。おめでとうございます！

Travis は Github 連携の CI サービスで、結構前に Perl にも対応しているので最近更新したレポジトリには基本的に .travis.yml を置いて便利に使わせていただいていたのですが、 いままで使っていた設定だとtravis上でうまくテストが通らなくなってしまった。

今まで使っていた方法は、まず gfx 考案の Makefile.PL をベースに Makefile.PL をこんなかんじで書く：

use strict;
use warnings;

BEGIN {
    my @devmods = qw(
        Module::Install::AuthorTests
        Module::Install::ReadmeFromPod
        Module::Install::Repository
    );
    my @not_available;

    eval qq{use inc::Module::Install; 1;} or push @not_available, 'inc::Module::Install';
    for my $mod (@devmods) {
        eval qq{require $mod} or push @not_available, $mod;
    }
    if (@not_available) {
        print qq{# The following modules are not available.\n};
        print qq{# `$^X $0 | cpanm` will install them:\n};
        print $_, "\n" for @not_available;
        print "\n";
        exit -1;
    }
}

use inc::Module::Install;

name 'Test-RedisServer';
all_from 'lib/Test/RedisServer.pm';

test_requires 'Redis';
test_requires 'Test::More' => '0.86';
test_requires 'Test::TCP'  => '1.17';

requires 'perl'       => '5.008001';
requires 'File::Temp' => '0.19'; # newdir
requires 'Any::Moose' => '0.18';

readme_from 'lib/Test/RedisServer.pm';
author_tests 'xt';
auto_set_repository;

WriteAll;

こうすると perl Makefile.PL | cpanm で必要な Module::Install モジュールが入るので、.travis.yml を

language: "perl"
before_install:
    - perl Makefile.PL | cpanm

こんな感じにするだけでOK。でした。前までは。

.travis.yml はこのままでいいんですが、最近の Module::Install は use inc::Module::Install したときに

include /Users/typester/dev/Test-RedisServer/inc/Module/Install.pm

みたいのを標準出力に出力するので、それが cpanm に渡ってしまいおかしなことになっている模様。

苦肉の策として

    {
        local *STDOUT;
        eval qq{use inc::Module::Install; 1;} or push @not_available, 'inc::Module::Install';
    }

みたいのを入れてしのいだ。

最終的な Makefile.PL はこちら。 Travis のときは author_tests 走らないようにとかもしてある。

tl;dr - 通常のHookではなくPubSubHubbubのほうのHookを使えばGithubのすべてのイベントをひとつのWebHookで受け取ることができる。

Github の WebHook ではレポジトリの更新しか受け取れず、issue とかも受け取れたら便利なのになーと思いつつ API ドキュメントを見てみると Hook を API から登録したりすることができるようになっていた。 だがこれは所詮は Web から登録できる Hook をいじるもので、このリストにあるものしか登録できない。 また、それぞれの Hook について登録できるイベントはリストで定義されている物に制限されているようで、たとえば WebHook だと push イベントしか設定することはできないみたい。（API 経由でも設定できなかった）

一方、それとは別に用意されている PubSubHubbub の Hook をつかうと、どうやら一つの WebHook URL に任意のイベントを送ることができるようだ。

やり方は簡単で、https://github.com/typester/p5-UV の push イベントを http://unknownplace.org/webhook で受け取りたいとすると、

$ curl -u typester -i \
  https://api.github.com/hub \
  -F "hub.mode=subscribe" \
  -F "hub.topic=https://github.com/typester/p5-UV/events/push" \
  -F "hub.callback=http://unknownplace.org/webhook"

というような感じで API をたたけば登録完了。これで指定した URL に対してイベントが送られてくるようになる。 他のイベントも受け取りたいというときは、これを受け取りたいイベント分繰り返せば良い。

Hook に送られてくるのは JSON だが、デフォルトだと通常の WebHook と同じように payload={json} みたいな形で送られてくる。 ドキュメントによれば、-H "Accept: application/json" を上のリクエストにつけるか、イベントタイプを https://github.com/typester/p5-UV/events/push.json みたいに .json を加えてやるかすると、生の JSON が POST されるようになるらしい。が、僕は今までの WebHook スクリプトを流用したのでこれはためしていない。

登録した Hook の一覧は普通の Hook API で、

$ curl -u typester -i https://api.github.com/repos/typester/p5-UV/hooks

このようにするとで取得可能っぽい。僕の場合は WebHook と同じ分類で（イベントだけが複数ある）リストに載っていたが、生 JSON を受け取るように設定していた場合どのように載るのかは不明。

WebHook スクリプトは以下のような通知を受け取ったら IRC に投げる、みたいのを使っている。

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use Twiggy::Server;
use Getopt::Long;
use File::chdir;
use Encode;

use AnyEvent;
use AnyEvent::IRC::Client;
use Log::Minimal;

use Plack;
use Plack::Request;
use JSON::XS;

my $conf = {
    irc => {
        server   => 'irc.example.com',
        port     => 6667,
        ssl      => 1,
        channel  => '#example-project',
        nick     => 'github',
    },

    commit_hook => sub {
        my ($branch) = @_;

        if ($branch eq 'develop') {
            local $CWD = '/path/to/project';
            system 'git', qw!--git-dir=.git pull!;
            system 'curl', 'http://127.0.0.1:8080/jenkins-ci/job/project/build';
        }
    },
};

GetOptions(
    \my %option,
    qw/host=s port=i/,
);
$option{host} ||= '0.0.0.0';
$option{port} ||= 5000;

my $cv = AnyEvent->condvar;

my $irc = AnyEvent::IRC::Client->new;
$irc->enable_ssl if $conf->{irc}{ssl};

my $connector = sub {
    $irc->connect($conf->{irc}{server}, $conf->{irc}{port}, {
        nick => $conf->{irc}{nick},
        $conf->{irc}{password} ? (password => $conf->{irc}{password}) : (),
    });
};

$irc->reg_cb(
    registered => sub {
        my ($irc) = @_;
        $irc->send_srv( JOIN => $conf->{irc}{channel} );
    },

    disconnect => sub {
        warnf 'IRC Disconnected: %s', $_[1];
        $connector->();
    },

    debug_send => sub {
        my ($irc, $command, @params) = @_;
        debugf '> %s %s', $command, join ' ', @params;
    },
    debug_recvd => sub {
        my ($irc, $msg) = @_;
        debugf '< %s', $msg;
    },
);
$connector->();

my $app = sub {
    my $req = Plack::Request->new(shift);

    if ($req->method eq 'POST' and my $payload = $req->param('payload')) {
        my $json    = decode_json($payload);
        my $channel = $conf->{irc}{channel};

        if ($json->{commits}) {
            # push event
            (my $branch = $json->{ref}) =~ s!refs/heads/!!;

            if ($channel) {
                for my $commit (@{ $json->{commits} }) {
                    $irc->send_srv(
                        NOTICE => $channel,
                        encode_utf8 sprintf '%s committed to %s "%s" %s',
                        $commit->{author}{username} || $commit->{author}{name}, $branch,
                        $commit->{message}, $commit->{url},
                    );
                }

                my $hook = $conf->{commit_hook};
                $hook->($branch) if $hook;
            }
        }
        elsif (my $issue = $json->{issue}) {
            my $sender = $json->{sender};

            if (my $comment = $json->{comment}) {
                # issue comment event
                my ($body) = $comment->{body} =~ /^(.*\S.*)$/m;

                $irc->send_srv(
                    NOTICE => $channel,
                    encode_utf8 sprintf '%s commented issue #%d %s %s',
                    $sender->{login}, $issue->{number}, $body || '', $issue->{html_url},
                );
            }
            else {
                # issues event
                $irc->send_srv(
                    NOTICE => $channel,
                    encode_utf8 sprintf '%s %s issue #%d %s %s',
                    $sender->{login}, $json->{action}, $issue->{number}, $issue->{title}, $issue->{html_url},
                );
            }
        }

        return [200, [], ['']];
    }

    return [403, [], ['Forbidden']];
};

AnyEvent::post_detect {
    if ($AnyEvent::MODEL eq 'AnyEvent::Impl::EV') {
        no warnings 'once';
        $EV::DIED = sub { $cv->croak($@) };
    }
};

my $server = Twiggy::Server->new(%option);
$server->register_service($app);

$cv->recv;

現在 push, issues, issue-comment イベントを受け取ってる。 issues とれるとやっぱりだいぶ良い感じ。 あと pullreq 多用しているプロジェクトだとそのイベントもあるので通知させるようにすると捗りそう。

最近 Redis ずいてるわけですが、redis-server は

$ redis-server /path/to/redis.conf

or

$ cat redis.conf | redis-server -

みたいな形式でしか起動できず、これをがんばって exec してテスト用とかに使うコードを3回くらい書いたところで面倒になってモジュール化しました。

Daisuke Murase / Test-RedisServer - search.cpan.org

基本的に Test::mysqld のパクりなのでサクッとかけました。kazuho++

linux のコマンドラインから、wi-fi の情報をつかって位置情報を得る - tokuhirom's blog.

を見て、面白そうだと思ったのでそのMac版。MacでコマンドラインからWiFiスポットをスキャンするのは、

/System/Library/PrivateFrameworks/Apple80211.framework/Versions/A/Resources/airport -s

でいけます。ってことで、

use strict;
use warnings;
use utf8;
use 5.012;

use JSON;
use LWP::UserAgent;

my @addresses = do {
    my @lines = split /\n/, qx{/System/Library/PrivateFrameworks/Apple80211.framework/Versions/A/Resources/airport -s};
    shift @lines;

    my @r;
    push @r, (split /\s+/, $_)[2] for @lines;

    @r;
};

my $query = encode_json({
    version          => '1.1.0',
    host             => 'maps.google.com',
    request_address  => JSON::true,
    address_language => 'ja_JP',
    wifi_towers      => [
        map +{
            mac_address     => $_,
            signal_strength => 8,
            age             => 0,
        }, @addresses,
    ],
});

my $ua  = LWP::UserAgent->new;
my $res = $ua->post('http://www.google.com/loc/json', Content => $query);
$res->is_success or die $res->status_line;

use YAML;
warn Dump decode_json($res->content);

ってな感じでOKです！