ShipIt::Step::ChangeAllVersions 0.001 released

Perl

ディストリビューションのモジュールすべてのバージョンを更新するshipit stepプラグインを書いた。

繰り返し再発明されてきたツールだとは思う。たとえば，ppi_versionというPPIベースのバージョン更新ツールもあるし，shipit stepモジュールにもApplyYAMLCHangeLogVersionというプラグインがある。しかし，これらはモジュールのバージョンは更新してくれるが，ドキュメントのバージョンまでは更新してくれない。PBPに勧めらるまでもなく，perldocで見るドキュメントにもバージョンが書いてあるほうがいい。
使い方は簡単で，.shipitのChangeVersionをChangeAllVersionsにするだけである。

ところで，ShipItのプラグインのテストは非常に難しい。そもそもShipIt本体が自動テストを想定していない作りになっており，ShipIt本体やほとんどのプラグインはテストを書かないという方法をとっているが，これはあまりいい状況とはいえない。

だいぶバッドノウハウだが，ChangeAllVersionsでは以下のように凌いだので記録しておく。

# t/01_basic.t
# ...
my $buffer;
BEGIN{ # Fake Term::ReadLine, which is hard coded in ShipIt::Util
    package Term::ReadLine;
    sub new{ bless {}, shift }
    sub readline{ $buffer }
    $INC{'Term/ReadLine.pm'} = __FILE__;
}
use ShipIt;
use ShipIt::VC;
use ShipIt::Step::ChangeAllVersions;
{
    package ShipIt::VC::Dummy;

    sub new { bless {} } # intentinaly one-arg bless
    sub exists_tagged_version{ 0 }

    no warnings 'redefine';
    *ShipIt::VC::new = \&ShipIt::VC::Dummy::new;
}

chdir $test_dir;
my $conf  = ShipIt::Conf->parse('.shipit');
my $state = ShipIt::State->new($conf);
foreach my $step( $conf->steps ){
    # ...
}

まず，ShipIt::Utilでは問答無用でTerm::ReadKey->newをしているので，これを潰す。そうしないと，make testの元でいきなり落ちる。また，Step::FindVersionで入力を求められるので，これも状況に応じて必要な文字列を返せるようにする。

そしてShipItコアをロードしたのち，ShipIt::VC::newをダミークラスに置き換える。テストではバージョンコントロールシステムは必要ないからである。

そして，あらかじめ作っておいたテスト用ディストリビューションのディレクトリにchdirし，そこに置いてある.shipitを読み込み，stepを実行させる。

どうみてもBKです。本当にありがとございました。

Module::Installもそうだが，ディストリビューション管理ツールはどうもテストが書きにくい。なんとかしてほしいものだ。

A patch for Data::Dumper to display the subroutine name, instead of sub { "DUMMY" }

Perl

sub { "DUMMY" } にウンザリして，しばらく前から Data::Dumper に以下のようなパッチを当てている。これで，コードリファレンスが与えられたときにその名前を出力するようになる。Deparse よりも簡潔でいい。無名関数に対してはあまり効果がないが，&foo::__ANON__ だってパッケージの情報がある分 sub{ "DUMMY"} よりはマシだ。

To Dumper.pm:

--- a/Dumper.pm~
+++ b/Dumper.pm
@@ -456,7 +456,10 @@ sub _dump {
        $sub    =~ s/\n/$pad/gse;
        $out   .=  $sub;
       } else {
-        $out .= 'sub { "DUMMY" }';
+        require B;
+        my $cv = B::svref_2object($val);
+        $out .= '\&' . join('::', $cv->GV->STASH->NAME, $cv->GV->NAME);
         carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
       }
     }

To Dumper.xs:

--- a/Dumper.xs~
+++ b/Dumper.xs
@@ -805,7 +805,9 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *
            SvREFCNT_dec(totpad);
        }
        else if (realtype == SVt_PVCV) {
-           sv_catpvn(retval, "sub { \"DUMMY\" }", 15);
+           CV* const code = (CV*)SvRV(val);
+           sv_catpvf(retval, "\\&%s::%s", HvNAME(GvSTASH(CvGV(code))), GvNAME(CvGV(code)));
            if (purity)
                warn("Encountered CODE ref, using dummy placeholder");
        }