Test::TCP + Net::Server::Mail::SMTPで、一時的に受信メールサーバを立ててテストする


テストメールを送信したり、
会員登録メールを送信したりするアプリをテストするときに、
メールを受信する一時的なメールサーバを立ち上げたくなる。
受信したメールの内容もテストしたい。

Test::TCPのサーバ側のコードで、
Net::Server::Mail::SMTPを利用して、
メールサーバを立ち上げる方法をとった。

```perl:basic.t
use strict;
use warnings;

use Test::More;
use Test::TCP;
use Net::Server::Mail::SMTP;
use Net::SMTP;
use Email::MIME;
use Email::MIME::MobileJP::Parser;

my $from = 'test-from@example.com';
my $to   = 'test-to@example.com';
my $body = 'test-body';
my $subject = 'test-subject';


### サーバの設定

my $server = Test::TCP->new(
    code => 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;

                        # $mail->get_texts(qr{^text/plain});
                        # $mail->get_texts(qr{^text/html});

                        is $from->address, 'test-from@example.com';
                        like $body, qr/test-body/;

                        return (1, 250, 'message queued');
                    }
                );
                $smtp->process();
            };

            if ($@) {
                warn $@;
                $remote->close();
            }
        }
    }
);


### クライアントの設定

my $mime = Email::MIME->create(
    header => [
        From => $from,
        To   => $to,
        Subject => $subject,
    ],
    attributes => {
        content_type => 'text/plain',
        charset      => 'ISO-2022-JP',
        encoding     => '7bit',
    },
    body => $body,
);


my $port = $server->port;

my $smtp = Net::SMTP->new(
    Host => '127.0.0.1',
    Port => $port,
    Hello => '[127.0.0.1]',
);

$smtp->mail($from);
$smtp->to($to);
$smtp->data();
$smtp->datasend($mime->as_string);
$smtp->quit;

undef $server;

done_testing;
```


Net::Server::Mail::SMTPは、
各SMTPコマンドに対してコールバックで処理をかけるのでとても便利。

```perl:sample
$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;

        # $mail->get_texts(qr{^text/plain});
        # $mail->get_texts(qr{^text/html});

        is $from->address, 'test-from@example.com';
        like $body, qr/test-body/;

        return (1, 250, 'message queued');
    }
);
```

ここのところで、受信したデータの内容をテストしている。