カテゴリー: テスト

CGIプログラムをPlack::Testでテストする

以下のようなCGIプログラムのテストを書きたいとします。

 
fizzbuzz.cgi

#!/usr/bin/perl
use strict;
use warnings;
use CGI;
my $q = CGI->new;
my $number = $q->param('number');
unless (defined $number) {
print $q->header(
-status => 200,
-type => 'text/plain; charset=utf8',
);
print "Please set number";
exit;
}
my $result = '';
if ($number % 3 == 0) {
$result .= 'Fizz';
}
if ($number % 5 == 0) {
$result .= 'Buzz';
}
$result ||= $number;
print $q->header(
-status => 200,
-type => 'text/plain; charset=utf8',
);
print $result;

ロジックが一緒に書かれているので、Test::Moreでテストしづらいですね。
こんなときはCGIプログラムをPSGIアプリに変換し、
Plack::Testでテストすると楽です。

 

PSGIアプリに変換するにはPlack::App::CGIBinを使って、
以下の内容のapp.psgiを作成します。

#!/usr/bin/perl                                                                                                                                            
use strict;
use warnings;
use File::Basename;
use Plack::Builder;
use Plack::App::CGIBin;
my $basedir = dirname(__FILE__);
builder {
mount '/' =>
Plack::App::CGIBin->new( root => $basedir, exec_cb => sub { 1 } )->to_app;
};

これでめでたくCGIプログラムはPSGIアプリになりました。
普通のPSGIアプリと同様に、plackupコマンドなどで実行できるようになります。

$ plackup app.psgi

ブラウザなどで「http://localhost:5000/fizzbuzz.cgi?number=1」にアクセスすると実行できます。
 

PSGIアプリは、Plack::Testでテストすることができます。
先ほどのCGIプログラムのテストは、次のように書くことができます。

use strict;
use warnings;
use Test::More;
use Plack::Test;use HTTP::Request::Common;
use Plack::Loader;
use Plack::Util ();
my $app = Plack::Util::load_psgi('app.psgi');
test_psgi $app, sub {
my $cb = shift;
my $res;
$res = $cb->(GET "/fizzbuzz.cgi?number=1");
is $res->code, '200';
is $res->content, '1';
$res = $cb->(GET "/fizzbuzz.cgi?number=2");
is $res->code, '200';
is $res->content, '2';
$res = $cb->(GET "/fizzbuzz.cgi?number=3");
is $res->code, '200';
is $res->content, 'Fizz';
$res = $cb->(GET "/fizzbuzz.cgi?number=4");
is $res->code, '200';
is $res->content, '4';
$res = $cb->(GET "/fizzbuzz.cgi?number=5");
is $res->code, '200';
is $res->content, 'Buzz';
$res = $cb->(GET "/fizzbuzz.cgi?number=15");
is $res->code, '200';
is $res->content, 'FizzBuzz';
};
done_testing();

書きやすいですね。

自動テストのためにメールサーバを一時的に起動する

メール本体を組み立てるロジックとメール送信部分が結合しているようなシステムを自動テストする際に、
一時的に立ち上がるメールサーバが欲しくなります。
また、メールサーバにどんなメールが届くのかをチェックできると嬉しいですね。

Test::TCPとNet::Server::Mail::SMTPを使えば、これを実現できます。

Test::TCPは、開いているポートをスキャンして、サーバ側のコードとクライアント側のコードを実行してくれるモジュールです。
Net::Server::Mail::SMTPは、メールサーバを簡単に書けるようにしてくれるモジュールです。各SMTPコマンドに対して処理を書くことができます。

この2つのモジュールを組み合わせれば、以下のようにテストを書くことができます。

 

use strict;
use warnings;
use Test::More;
use Test::TCP;
use Net::SMTP;
use Net::Server::Mail::SMTP;
use Email::MIME;
use Email::Address::Loose;
use Email::MIME::MobileJP::Parser;
my $from = 'test-from@example.com';
my $to   = 'test-to@example.com';
my $body = 'test-body';
my $mime = Email::MIME->create(
header => [
From => $from,
To   => $to,
Subject => 'test-subject'
],
attributes => {
content_type => 'text/plain',
charset      => 'ISO-2022-JP',
encoding     => '7bit',
},
body => $body
);
test_tcp(
client => sub {
my $port = shift;
eval {
my $smtp = Net::SMTP->new(
Host => 'localhost',
Port => $port,
Hello => '[localhost]'
);
$smtp->mail('test-from@example.com');
$smtp->to('test-to@example.com');
$smtp->data();
$smtp->datasend($mime->as_string);
$smtp->quit;
};
if ($@) {
warn $@;
}
},
server => sub {
my $port = shift;
my $sock = IO::Socket::INET->new(
LocalAddr => '127.0.0.1',
LocalPort => $port,
Proto     => 'tcp',
Listen    => 1,
) or die "Cannot open server socket: $!";
# チェック用のリクエストが来るのでパスする                                                                                  
$sock->accept();
while (my $remote = $sock->accept()) {
eval {
my $smtp = Net::Server::Mail::SMTP->new('socket' => $remote);
$smtp->set_callback(
'RCPT' => sub {
my $sess = shift;
my $rcpt = shift;
my ($email) = Email::Address::Loose->parse($rcpt);
my $domain = $email->host;
return (0, 513, 'Syntax error.') unless $domain;
return 1;
}
);
$smtp->set_callback(
'DATA' => sub {
my $sess = shift;
my $data = shift;
my $mail = Email::MIME::MobileJP::Parser->new($data);
my $from = $mail->from();
my $body = $mail->mail->body;
is $from->address, 'test-from@example.com';
like $body, qr/test-body/;
return (1, 250, 'message queued');
}
);
$smtp->process();
};
if ($@) {
warn $@;
$remote->close();
}
}
}
);
done_testing;

Test::TCPは、serverに記述されたメールサーバが起動したあとに、clientに記述されたプログラムを実行してくれるようになっています。
便利ですね。

© SEEDS Co.,Ltd.