github + pull request の cons

github を普段から使っていると自然と pull request ベースで進める事になる(この仕組みはだいぶうまくできていると思う)が、それでも厄介事は尽きない。

一日数件のペースで pull request が送られるような絶賛開発中のリポジトリでは頻繁に master にマージされるが、Web UI 経由で簡単に git merge foo できるため、 マージ後の master でテストを走らせるような機会がそれほどない、というかそもそも面倒でやらない(本当はみんなテストの重要性をわかってはいるんだけど…)

unstable master

すると、いつの間にか master が unstable になっていて困った事になる。壊れたテスト(あるいはコードベース)のせいで自分の書いたコードが期待通りの動作をしているか保証できなくなる。

せめて master だけでも stable にしたい。そういう時に限ってテストを走らせるサーバを準備している余裕は無い。

done is better than perfect

完璧を目指すなら、 Jenkins で云々設定をして走らせることになると思う 。(Jenkins が完璧かどうかは知らないが…)

サーバが準備できないからといって不便な状況を許容するよりは、荒削りでも動くもののほうが有効なようだ。今回は ikachan + prove + α をローカルで走らせるだけで事足りた。 短時間で準備できて思いのほかワークする単純な仕組みとして費用対効果が大きい。

prove の出力するテストのサマリーを結果を流す IRC チャンネルを作って、みんなに入ってもらうだけで済んだ。

master に変更が入った時だけ走らせれば良いので、その辺りは記事の最後にあるスクリプトでコントロールしている。

PASS するとこれだけ。

12:39 ikachan: Start prove...
12:41 ikachan: All tests successful.
12:41 ikachan: Files=168, Tests=1355, 131 wallclock secs ( 0.85 usr  0.35 sys + 64.24 cusr  7.08 csys = 72.52 CPU)
12:41 ikachan: Result: PASS

FAIL するとこんな感じで教えてくれる。これで周知されるので、 merge した人が修正してくれる。

12:19 ikachan: Start prove...
12:22 ikachan: Test Summary Report
12:22 ikachan: -------------------
12:22 ikachan: t/foo/bar/baz.t                                                                (Wstat: 256 Tests: 14 Failed: 2)
12:22 ikachan:  Failed tests:  1-2
12:22 ikachan:  Non-zero exit status: 1
12:22 ikachan: Files=168, Tests=1355, 127 wallclock secs ( 0.89 usr  0.34 sys + 63.37 cusr  7.00 csys = 71.60 CPU)
12:22 ikachan: Result: FAIL

メンテナンスの段階になったらどこかのサーバに置いておくのが良さそうだ。

package App::provechan;
use sane;
use LWP::UserAgent;

sub new {
    my ($class, %args) = @_;
    bless {
        channel     => $args{channel},
        force_prove => $args{force_prove} // 0,
        sleep_sec   => $args{sleep_sec}   // 60,
        prove       => $args{prove}       // [ qw/ prove -r t / ],
        useragent   => LWP::UserAgent->new,
        skip_regexp => quotemeta "Already up-to-date.",
    }, $class;
}

sub run {
    my $self = shift;

    while (1) {
        if ($self->should_skip) {
            $self->log("Skip");
            if ($self->{force_prove}) {
                $self->{force_prove} = 0;
            } else {
                sleep $self->{sleep_sec};
                next;
            }
        }

        $self->installdeps;

        $self->prove;
    }
}

sub prove {
    my $self = shift;

    $self->send(privmsg =>"Start prove...");

    open my $fh, '-|', @{ $self->{prove} }
        or die "failed open pipe: $!";

    my @ret;
    while (<$fh>) {
        push @ret, $_;
        $self->log($_);
    }

    my @messages;
    for (my $i = 0; $i < @ret; $i++) {
        my $line = $ret[$i] // '';
        if ($line  =~ /Test Summary Report/) {
            push @messages, @ret[ $i .. $#ret ];
            last;
        } elsif ($line =~ /All tests successful/) {
            push @messages, @ret[ $i .. $#ret ];
            last;
        }
    }

    $self->send(notice => $_) for @messages;
}

sub should_skip {
    my $self = shift;

    my $pull = `git pull`;
    $self->log($pull);

    if ($pull =~ /$self->{skip_regexp}/m) {
        return 1;
    }
}

sub installdeps {
    my $self = shift;

    open my $installdeps, '-|', qw! cpanm --installdeps . !
        or die "failed open pipe: $!";

    $self->log($_) while (<$installdeps>);
}

sub log {
    my $self = shift;
    my $log  = shift // '';
    chomp $log;
    printf "[%s] %s\n", scalar localtime, $log;
}

sub send {
    my ($self, $method, $message) = @_;
    $self->{useragent}->post(
        "http://localhost:4979/$method",
        Content => {
            channel => $self->{channel},
            message => $message,
        }
    );
}

package main;

my $opts = {
    channel     => '#nantoka-ci',
    prove       => [ qw! env LOCAL_MYSQLD_SOCK=/tmp/mysql_sandbox5163.sock prove -r t/ ! ],
    force_prove => shift @ARGV,
};

App::provechan->new(%$opts)->run;

__END__