とある 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 -%]