Perl で書くクローラのテスト

[2017 年の Perl Advent Calendar](https://qiita.com/advent-calendar/2017/perl) 1 日目を担当する [@codehex](https://twitter.com) です。

とあるカテゴリのサービスを巡回する[クローラ](https://ja.wikipedia.org/wiki/%E3%82%AF%E3%83%AD%E3%83%BC%E3%83%A9)を書く機会がありました。今回はそのテスト手法について僕が考えたことを書こうと思います。

文章でいっぱいの記事になりそうです...

## 考えたこと
このクローラは巡回するサービス数が少ないことを前提としています。
クローラを開発するにあたって考えることが沢山ありましたが、その中でも特に次のことについて考えなければいけませんでした。

- サービス毎で分かれるスクレイピング処理や DB への投入の処理を考慮して、どう処理を分岐させれば各々のデータを集めることが可能か
- 対応サービスを追加したい場合、難しいことを考えずに追加できるようにするにはどうすれば良いか

結果として、それぞれのサービス毎のパッケージを用意し、それらをプラグインとして扱う形式を取りました。実現するために [Mouse::Role](https://metacpan.org/pod/Mouse::Role) と [`requires`](https://metacpan.org/pod/Mouse::Role#requires(@method_names)) を使うことで上手くいきました。

さて、当たり前ですが各々のパッケージのテストを行わなければいけません。特に今回作成したクローラのテストとして重要な部分は次のようなものでした。

- 正しくスクレイピングができているか
- データの投入が正しく行えているか
- サービス上のコンテンツが更新されている場合、更新部分のみに対して処理を行えるか

## DB に関するテストの準備

データの投入が正しく行われているか検証する為に、テストを実行する前の最初だけ [Harriet](https://metacpan.org/pod/Harriet) で [Test::PostgreSQL](https://metacpan.org/pod/Test::PostgreSQL) を用いてテスト用の PostgreSQL サーバーを立ち上げ、 [DBIx::FixtureLoader](https://metacpan.org/pod/DBIx::FixtureLoader) であらかじめ用意していたスキーマやテスト用のデータを投入する
といったことを行います。大体こんな感じです。

```perl
use strict;
use utf8;
use JSON::XS;
use Test::PostgreSQL;
use DBIx::FixtureLoader;

$ENV{TEST_POSTGRESQL} ||= do {
    my $pgsql = Test::PostgreSQL->new() or die $Test::PostgreSQL::errstr;

    # create test database
    create_database($pgsql);
    insert_testdata($pgsql);

    $HARRIET_GUARDS::POSTGRESQL = $pgsql;
    my $dsn = +{
        master => $pgsql->dsn(dbname => "master"),
        slave  => $pgsql->dsn(dbname => "slave"),
    };
    
    encode_json($dsn);
};

sub create_database {
    my $pgsql = shift;
    my $dbh = DBI->connect($pgsql->dsn);
    foreach my $database (qw/slave master/) {
        $dbh->do("create database $database") or die $dbh->errstr;
    }
    $dbh->disconnect;
}

sub insert_testdata {
    my $pgsql = shift;

    foreach my $database (qw/slave master/) {
        my $dbh = DBI->connect($pgsql->dsn(dbname => $database));
        # load schema
        my $create = path("sql/$database/create.sql")->slurp;
        for my $stmt (split /;/, $create) {
            next unless $stmt =~ /\S/;
            $dbh->do($stmt) or die $dbh->errstr;
        }

        my $loader = DBIx::FixtureLoader->new(dbh => $dbh);
        my $fixture = path("sql/$database/fixture");
        my @children = $fixture->children(qr/\.csv$/);
        foreach my $path (@children) {
            $loader->load_fixture($path->absolute);
        }

        $dbh->disconnect;
    }
}
```

そしてテストスクリプトの初めで次のように書くことで、テスト用の dsn を取得することができるようになります。

```perl
use Harriet;
Harriet->new('./xt/harriet')->load_all;

my $json = $ENV{TEST_POSTGRESQL};
my $dsn = decode_json($json);
```

## スクレイピングのテスト

当たり前ですが、テストを行うたびにリクエストを送るのもどうかと思うので、html を用意することにしました。しかし、ここでも考えなければならないことがでてきます。

**どのタイミングでテストを作成するか**

タイミングとしては次のようなことが考えられました。

1. 対応するサービスを新しく追加し、それが正しい動作を保証できる時
2. サービスの構成が変わっていた時

1 の場合、正しい動作を保証するために簡単なスクリプトを作って確かめる必要があります。またクローラに限っては、長い時間をかけて人間の目でしっかりと確認しなければいないんじゃないかと思っています。（もっと良い方法があったら教えてください）

2 に関しては、スクレイピングができなかったとアラートを出すことで気づくことができるかと思います。もちろんスクレイピングの処理を書き換えなければならないし、新しく html を取ってくる必要があります。

上記のタイミングのたびに html を拾ってきて、それに合わせてテストを修正しなければいけないのも面倒です。そこで上記のタイミングのみで実行するテストジェネレーターなるものを作成することにしました。

ディレクトリ構成は次のようになります。

```
lib
├── Generator
│   ├── ServiceA.pm
│   ├── ServiceB.pm
│   ├── ServiceC.pm
│   └── ServiceD.pm
├── Generator.pm
└── test_generate.pl
```

`test_generate.pl` が行う処理のステップとして

1. html を取ってくる
2. それを読み込むような処理をテストに含める
3. あらかじめ用意していたテンプレートに、各サービス毎のテスト用のテンプレート(`Generator/Service*.pm` のこと)をがっちゃんこしていく
4. テストファイルとして吐き出す

スクレイピングのテストで必要な共通部分は `Generator.pm` へ含めました。そして `Generator::Service*` には各サービス毎のテンプレートを用意してあげる必要があります。 

```perl:Generator.pm
package Generator;

use Furl;
use Data::Dumper;

use Mouse::Role;
requires qw/generate base_url/;

has scraper       => (is => 'ro');
has script        => (
    is      => 'ro',
    default => sub { $_[0]->header }
);
has furl => (
	is      => 'ro',
	default => sub {
        Furl->new(
            timeout => 3600,
            headers => [
				...,
			]
        )
	}
);

sub add {
    my ($self, $str) = @_;
    $self->{script} .= $str;
}

sub output {
    my $self = shift;
    $self->generate;
    $self->add("done_testing()");
    return $self->script;
}

sub insert_construct_code {
    my ($self, $scraper) = @_;

    my $class = ref $self->scraper =~ s/Scraper/Insert/r;

    my $insert = <<INSERT;
$class->new(
    dbh    => DBIx::Simple->connect(\$dsn->{slave}),
    scraper   => [
        $scraper
    ]
)
INSERT
    return $insert =~ s/\n$//r;
}

sub dumper {
    my ($self, $ref) = @_;
    my $r = Dumper $ref;
    $r =~ s/\$VAR1 = //;
    $r =~ s/;\n$//;
    return $r;
}

sub fetch {
    my ($self, $url) = @_;
    my $res = $self->furl->get($url);
    unless ($res->is_success) {
    	warn "Failed to connect to remote HTTP server $url";
    	return;
    }
    return $res->decoded_content;
}

sub header {
    my $self = shift;
    my $class = ref $self->scraper;
    my $insert_class = $class =~ s/Scraper/Insert/r;

    return <<HEAD;
use utf8;
use strict;
use Test::More;
use Test2::Tools::Mock;
use Test2::Plugin::UTF8;
use DBIx::Simple;
use JSON::XS;
use xt::CLI;

use $class;
use $insert_class;

use Harriet;
Harriet->new('./xt/harriet')->load_all;

my \$json = \$ENV{TEST_POSTGRESQL};
my \$dsn = decode_json(\$json);

my \$scraper = $class->new(
    dbh => DBIx::Simple->connect(\$dsn->{slave}),
);

HEAD
}

__PACKAGE__->meta->make_immutable;

package Generator::Error;

use Mouse;
use Carp ();
use overload '""' => sub { $_[0]->error };
has error => (
    is       => 'ro',
    required => 1
);

sub warning { warn $_[0]->error }

1;
```

```perl:Generator/ServiceA.pm
package Generator::ServiceA;

use Mouse;
with 'Generator';
use utf8;

sub base_url {
    my $self = shift;
    ...
    return "http://www.serviceA.net/";
}

sub generate {
    my $self = shift;
    my $test_script = $self->header;

    my $url = $self->base_url;
    my $content = $self->fetch($url);
    my $info = $self->scraper->_scrape($content);
    $info = $self->dumper($info);

    $self->add(<<TEST);
my \$content = <<'...';
$content
...

my \$info = $info;

is_deeply \$scraper->_scrape(\$content), \$info, 'Is success to invoke _scrape method to ServiceA';

TEST

    my $insert = $self->insert_construct_code($info);
    $self->add(<<TEST);
my \$insert = $insert;
my \$inserted = \$insert->_insert();

is \$\#\$inserted, \$\#\$info, 'Is success to invoke _insert method for ServiceA';

TEST

... # いろんな処理

}

1;
```

[Data::Dumper](https://metacpan.org/pod/Data::Dumper) を含めている理由としては、スクレイピングが正しく動いているか確認をするためです。スクレイプした後に作成されるデータ構造を、上記の `dumper` メソッドを使うことによって文字列化することが可能です。そしてテスト生成時にその文字列をテストスクリプトへ貼り付け、生成後のテストスクリプト実行段階で [`is_deeply`](https://metacpan.org/pod/Test::More#is_deeply) を用いることで比較することができます。

`insert_construct_code` は、スクレイプした結果を DB へ投入するためのオブジェクトをのコンストラクトを行うコードを生成しています。コンストラクト時の引数に、リファレンスを渡すようなコードを生成しているだけです。

あとは `test_generator.pl` で `Generator::Service*` を `require Generator::ServiceA` といった形で動的にロードし、 `output` メソッドをファイル作成の関数などと組み合わせれば可能です。

## 実際に使ってみて

初めは、テストを自動生成するのもどうなんだろうと悩みましたが、実際にテストとして機能していることを確認できたので試みは成功したと思っています。
しかし油断すると危ない気がするので、もっと良い方法があれば書き直したいと思っています。

もしこうしたほうが良いと、意見を持っている方がいましたら是非教えて頂きたいです。


明日は [yukikimoto](https://qiita.com/yukikimoto) さんが開発している [SPVM](https://metacpan.org/pod/SPVM) の話です。楽しみですね！