読者です 読者をやめる 読者になる 読者になる

Test::Base でコンテンツの同一性をテストする

とある Web Application をリファクタリングするので、ある URL で得られる内容がリファクタリング前後で同一であることを確認したい、という話がありまして。
最初はベタに URL を fetch してハッシュ値を保存して……というスクリプトを書いたのだけど(すぐ書けるし)、こういうのはテストとして書くべきじゃないかと思ったので Test::Base で書いてみた。
# なんだか既にツールがありそうな気もするんだけど

$ cat url.txt
http://localhost
http://localhost/~fujiwara/

$ cat url.txt | perl -MTestURIDigest -e 'TestURIDigest::Maker::make' > digest.t

TestURIDigest::Maker::make() に url 一覧を食わせると、以下のような Test::Base を使ったテストスクリプトを吐き出す仕組みにしてみた。

#!/usr/bin/perl
use TestURIDigest;

plan   tests => 1 * blocks;
run_is input => 'expected';

__END__
=== http://localhost
--- input chomp fetch_digest
http://localhost
--- expected chomp
2d9e2dcdb9506526aa846aac60d2ff6877b952bb
=== http://localhost/~fujiwara/
--- input chomp fetch_digest
http://localhost/~fujiwara/
--- expected chomp
a519ff1c7974a5ec4617763e613f37e826811231

リファクタリング前に digest.t を作っておいて、リファクタリングしながら実行すればテスト可能。

$ prove digest.t
digest....ok                                                                 
All tests successful.
Files=1, Tests=2,  0 wallclock secs ( 0.23 cusr +  0.03 csys =  0.26 CPU)

TestURIDigest のソースは以下で。

package TestURIDigest;
use strict;
use warnings;
use Test::Base -Base;

package TestURIDigest::Filter;
use Test::Base::Filter -base;
use Digest::SHA qw/ sha1_hex /;
use URI::Fetch;
sub fetch_digest {
    my $uri = shift;
    my $res = URI::Fetch->fetch($uri) or die URI::Fetch->errstr;
    return sha1_hex( $res->content );
}

package TestURIDigest::Maker;
use Template;
sub make {
    my @tests;
    while ( my $uri = <> ) {
        chomp $uri;
        next unless $uri;
        my $test = {
            uri    => $uri,
            digest => TestURIDigest::Filter->fetch_digest($uri),
        };
        push @tests, $test;
    }
    my $tt = Template->new;
    $tt->process( \*DATA, { tests => \@tests }, \*STDOUT );
}
1;
__DATA__
#!/usr/bin/perl
use TestURIDigest;

plan   tests => 1 * blocks;
run_is input => 'expected';

[% "__END__" %]
[% FOR t IN tests -%]
=== [% t.uri %]
--- input chomp fetch_digest
[% t.uri %]
--- expected chomp
[% t.digest %]
[% END -%]