#!/usr/bin/env perl
package Sisimai::Lhost::Code;
use lib qw(./lib ./blib/lib);
use strict;
use warnings;

my $moduletest = sub {
    my $modulename = shift || return undef;
    my $isexpected = shift || return undef;
    my $privateset = shift || 0;
    my $onlydebugs = shift || 0;

    my $E = $modulename;    # Sendmail, Postfix, and so on.
    my $M = undef;          # Sisiimai::Lhost::Sendmail, Sisimai::ARF, and so on.
    my $v = undef;

    use Test::More;
    use JSON;
    use Module::Load;
    use Sisimai::Mail;
    use Sisimai::Fact;
    use Sisimai::Lhost;
    use Sisimai::Reason;
    use Sisimai::Address;

    my $lhostindex = Sisimai::Lhost->index; push @$lhostindex, 'ARF', 'RFC3464', 'RFC3834';
    my $isnotlhost = qr/\A(?:ARF|RFC3464|RFC3834)\z/;
    my $methodlist = ['DELIVERYSTATUS', 'INDICATORS', 'description', 'index', 'path'];
    my $skiptonext = {
        'public'  => ['lhost-postfix-49', 'lhost-postfix-50'],
        'private' => [
            'arf/01003', 'arf/01005', 'arf/01009', 'arf/01015',
            'lhost-exim/01084', 'lhost-mailmarshalsmtp/01001', 
            'lhost-postfix/01200', 'lhost-postfix/01201',
            'rfc3464/01024', 'rfc3464/01061', 'rfc3464/01081',
        ],
    };
    my $jsonobject = JSON->new;
    my $emailindex = 0;
    my $nameprefix = '';
    my $reasonlist = [map { $_ = lc $_ } @{ Sisimai::Reason->index }];
    push @$reasonlist, 'delivered', 'feedback', 'undefined', 'vacation';

    if( $E =~ $isnotlhost ) {
        # ARF, RFC3464, ARF3834
        $M = sprintf("Sisimai::%s", $E);

    } else {
        # Sisimai::Lhost OR Sisimai::Rhost
        my $c = [caller()]->[1];
        my $h = $c =~ /-rhost-/ ? 'rhost' : 'lhost';
        $M = sprintf("Sisimai::%s::%s", ucfirst $h, $E);
        $nameprefix = $h.'-';
    }
    my $samplepath = $privateset ? sprintf("set-of-emails/private/%s%s", $nameprefix, lc $E) : 'set-of-emails/maildir/bsd';

    Module::Load::load $M;
    use_ok $M;
    can_ok $M, @$methodlist    if $M =~ /Sisimai::Lhost/;
    can_ok $M, ('inquire') unless $M =~ /Sisimai::Rhost/;
    is $M->inquire(undef),     undef unless $M =~ /Sisimai::Rhost/;
    is $M->inquire({} ,undef), undef unless $M =~ /Sisimai::Rhost/;

    PARSE_EACH_EMAIL: for my $e ( sort keys %$isexpected ) {
        # Open each email in set-of-emails/ directory
        my $cj = undef; # Current JSON/YAML string
        my $cf = undef; # Current sample email file
        my $cr = undef; # Current regular expression
        my $ct = undef; # Current text for displaying with -v option
        my $cv = undef; # Current value for test
        my $cx = $isexpected->{ $e };

        my $haveparsed = 0;

        if( $onlydebugs ) {
            # Debug mode
            $emailindex += 1;
            next unless int($onlydebugs) == int($e);
            ok $onlydebugs, sprintf("[%s] %s|DEBUG(%02d)", $e, $E, $onlydebugs);
        }

        if( $privateset ) {
            # Private sample: 01227-581a7c3e4f0c0664ff171969c34bf988.eml
            $cf = [glob(sprintf("./%s/%s-*.eml", $samplepath, $e))]->[0];

        } else {
            # Public sample: lhost-sendmail-59.eml
            $cf = $E =~ $isnotlhost
                ? $cf = sprintf("./%s/%s-%02d.eml", $samplepath, lc $E, int $e)
                : $cf = sprintf("./%s/%s%s-%02d.eml", $samplepath, $nameprefix, lc $E, int $e);
        }

        ok -f $cf, sprintf("[%s---] %s/email(path) = %s", $e, $E, $cf);
        ok -s $cf, sprintf("[%s---] %s/email(size) = %s", $e, $E, -s $cf);

        my $mailobject = Sisimai::Mail->new($cf);
        # next unless defined $mailobject;
        isa_ok $mailobject, 'Sisimai::Mail';

        READ_EACH_EMAIL: while( my $r = $mailobject->data->read ) {
            # Read messages in each email
            my $methodargs = { 'data' => $r, 'delivered' => 1, 'vacation' => 1, 'origin' => $cf };
            my $listoffact = Sisimai::Fact->rise($methodargs);

            unless( $listoffact ) {
                my $bf = '';
                my $be = '';

                if( $privateset ) {
                    $bf = [split('/', $cf, 4)]->[-1];
                    $be = 'private';

                } else {
                    $bf = [split('/', $cf)]->[-1];
                    $be = 'public';
                }
                $bf =~ s/[.]eml\z//;
                next if grep { index($bf, $_) == 0 } @{ $skiptonext->{ $be } };
                warn $bf;
            }

            my $recipients = scalar @$listoffact;
            my $errorindex = 0;

            isa_ok $listoffact, 'ARRAY';
            ok $recipients, sprintf("[%s---] %s/including %d bounces", $e, $E, $recipients);

            while( my $rr = shift @$listoffact ) {
                # Test each Sisimai::Fact object
                isa_ok $rr, 'Sisimai::Fact';
                $errorindex += 1;

                ACTION: {
                    $cv = $rr->action;
                    $cr = qr/\A(?:delayed|delivered|expanded|failed|relayed)\z/;
                    $ct = sprintf("[%s-%02d] ->action =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);
                    if( $rr->reason eq 'feedback' || $rr->reason eq 'vacation' ) {
                        # "action" is empty when the value of "reason" is "feedback" OR "vacation"
                        is $cv, '', sprintf("%s %s", $ct, '');

                    } else {
                        # The value of "reason" is not "feedback"
                        ok $cv =~ $cr, sprintf("%s %s", $ct, $cr);
                    }
                }

                ADDRESSER: {
                    isa_ok $rr->addresser, 'Sisimai::Address';

                    $cv = $rr->addresser->address;
                    $cr = qr/\A.+[@][0-9A-Za-z._-]+[A-Za-z]+?\z/;
                    $ct = sprintf("[%s-%02d] ->addresser->", $e, $errorindex);

                    ok defined $rr->addresser->alias,   sprintf("%s%s = %s", $ct, 'alias', $rr->addresser->alias);
                    ok defined $rr->addresser->verp,    sprintf("%s%s = %s", $ct, 'verp',  $rr->addresser->verp);
                    ok defined $rr->addresser->name,    sprintf("%s%s = %s", $ct, 'name',  $rr->addresser->name);
                    ok defined $rr->addresser->comment, sprintf("%s%s = %s", $ct, 'comment', $rr->addresser->comment);
                    ok length  $rr->addresser->user,    sprintf("%s%s = %s", $ct, 'user',  $rr->addresser->user);

                    unless( Sisimai::Address->is_mailerdaemon($cv) ) {
                        # Is not a MAILER-DAEMON
                        ok length  $rr->addresser->host, sprintf("%s%s = %s", $ct, 'host',  $rr->addresser->host);
                        ok length $cv,                   sprintf("%s%s = %s", $ct, 'address', $cv);
                        ok $cv =~ $cr,                   sprintf("%s%s = %s", $ct, 'address', $cv);

                        is $cv, $rr->addresser->user.'@'.$rr->addresser->host;
                        ok $rr->addresser->alias =~ $cr if length $rr->addresser->alias;
                        ok $rr->addresser->verp  =~ $cr if length $rr->addresser->verp;
                    }
                }

                ALIAS: {
                    $cv = $rr->alias;
                    $ct = sprintf("[%s-%02d] ->alias =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);
                    ok $cv ne $rr->recipient->address, sprintf("%s %s != %s", $ct, $cv, $rr->recipient->address);
                }

                CATCH: {
                    is $rr->catch, undef, sprintf("[%s-%02d] ->catch = undef", $e, $errorindex);
                }

                DELIVERYSTATUS: {
                    $cv = $rr->deliverystatus;
                    $cr = qr/\A[245][.]\d[.]\d{1,3}\z/;
                    $ct = sprintf("[%s-%02d] ->deliverystatus =", $e, $errorindex);

                    if( $rr->reason eq 'feedback' || $rr->reason eq 'vacation') {
                        # "deliverystatus" is empty when the value of "reason" is "feedback"
                        is $cv, '', sprintf("%s %s", $ct, $cr);

                    } else {
                        # Except the value of "reason" is "feedback"
                        ok length $cv, sprintf("%s %s", $ct, $cv);
                        ok $cv =~ $cr, sprintf("%s %s", $ct, $cr);
                    }
                    is $cv, $cx->[$errorindex - 1]->[0], sprintf("%s %s", $ct, $cv);
                }

                DESTINATION: {
                    $cv = $rr->destination;
                    $cr = qr/\A[-_.0-9A-Za-z]+\z/;
                    $ct = sprintf("[%s-%02d] ->destination =", $e, $errorindex);

                    ok length $cv,               sprintf("%s %s", $ct, $cv);
                    ok $cv =~ $cr,               sprintf("%s %s", $ct, $cr);
                    is $cv, $rr->recipient->host, sprintf("%s recipient->host", $ct);
                }

                DIAGNOSTICCODE: {
                    $cv = $rr->diagnosticcode;
                    $ct = sprintf("[%s-%02d] ->diagnosticcode =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);
                }

                DIAGNOSTICTYPE: {
                    $cv = $rr->diagnostictype;
                    $cr = qr/\A(?:LMTP|SMTP|UNKNOWN|X[.]?[45]00|X-[0-9A-Z-]+)/;
                    $ct = sprintf("[%s-%02d] ->diagnostictype =", $e, $errorindex);

                    if( $rr->reason eq 'feedback' || $rr->reason eq 'vacation' ) {
                        # "deliverystatus" is empty when the value of "reason" is "feedback"
                        ok defined $cv, sprintf("%s %s", $ct, $cr);

                    } else {
                        # Except the value of "reason" is "feedback"
                        ok length $cv, sprintf("%s %s", $ct, $cv);
                        like $cv, $cr, sprintf("%s %s", $ct, $cr);
                    }
                }

                FEEDBACKTYPE: {
                    $cv = $rr->feedbacktype;
                    $cr = qr/\A[\x21-\x7e]+\z/;
                    $ct = sprintf("[%s-%02d] ->feedbacktype =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);

                    if( $rr->reason eq 'feedback' ) {
                        # The value of "feedbacktype" is not empty
                        ok length $cv,                        sprintf("%s %s", $ct, $cv);
                        ok $cv =~ $cr,                        sprintf("%s %s", $ct, $cr);
                        is $cv, $cx->[$errorindex - 1]->[4],  sprintf("%s %s", $ct, $cv);

                    } else {
                        # The value of "feedbacktype" is empty
                        is $cv, '', sprintf("%s %s", $ct, $cr);
                    }
                }

                HARDBOUNCE: {
                    $cv = $rr->hardbounce;
                    $cr = qr/\A[01]\z/;
                    $ct = sprintf("[%s-%02d] ->hardbounce =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %d", $ct, $cv);
                    ok $cv =~ $cr,  sprintf("%s %s", $ct, $cr);
                    is $cv, $cx->[$errorindex - 1]->[3], sprintf("%s %d", $ct, $cv);
                }

                LHOST: {
                    $cv = $rr->lhost;
                    $cr = qr/\A[^\s\[\]\(\)]+\z/;
                    $ct = sprintf("[%s-%02d] ->lhost =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);
                    ok $cv =~ $cr,  sprintf("%s %s", $ct, $cr) if length $cv;
                }

                LISTID: {
                    $cv = $rr->listid;
                    $cr = qr/\A[\x21-\x7e]+\z/;
                    $ct = sprintf("[%s-%02d] ->listid =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);

                    if( length $cv ) {
                        # The value of "listid" is not empty
                        ok length $cv, sprintf("%s %s", $ct, $cv);
                        ok $cv =~ $cr, sprintf("%s %s", $ct, $cr);

                    } else {
                        # The value of "listid" is empty
                        is $cv, '', sprintf("%s %s", $ct, $cr);
                    }
                }

                MESSAGEID: {
                    $cv = $rr->messageid;
                    $cr = qr/\A[\x21-\x7e]+\z/;
                    $ct = sprintf("[%s-%02d] ->messageid =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);

                    if( length $cv ) {
                        # The value of "messageid" is not empty
                        ok length $cv, sprintf("%s %s", $ct, $cv);
                        ok $cv =~ $cr, sprintf("%s %s", $ct, $cr);

                    } else {
                        # The value of "messageid" is empty
                        is $cv, '', sprintf("%s %s", $ct, $cr);
                    }
                }

                ORIGIN: {
                    $cv = $rr->origin;
                    $ct = sprintf("[%s-%02d] ->origin =", $e, $errorindex);

                    ok length $cv, sprintf("%s %s", $ct, $cv);
                    ok -f $cv,     sprintf("%s %s: file", $ct, $cv);
                    ok -s $cv,     sprintf("%s %s: %dKB", $ct, $cv, int((-s $cv) / 1000));
                }

                REASON: {
                    $cv = $rr->reason;
                    $ct = sprintf("[%s-%02d] ->reason =", $e, $errorindex);

                    ok length $cv,                        sprintf("%s %s", $ct, $cv);
                    ok grep { $cv eq $_ } (@$reasonlist), sprintf("%s %s", $ct, $cv);
                    is $cv, $cx->[$errorindex - 1]->[2],  sprintf("%s %s", $ct, $cv);
                }

                RECIPIENT: {
                    isa_ok $rr->recipient, 'Sisimai::Address';

                    $cv = $rr->recipient->address;
                    $cr = qr/\A.+[@][0-9A-Za-z._-]+[A-Za-z]+?\z/;
                    $ct = sprintf("[%s-%02d] ->recipient->", $e, $errorindex);

                    ok defined $rr->recipient->alias,   sprintf("%s%s = %s", $ct, 'alias', $rr->recipient->alias);
                    ok defined $rr->recipient->verp,    sprintf("%s%s = %s", $ct, 'verp',  $rr->recipient->verp);
                    ok defined $rr->recipient->name,    sprintf("%s%s = %s", $ct, 'name',  $rr->recipient->name);
                    ok defined $rr->recipient->comment, sprintf("%s%s = %s", $ct, 'comment', $rr->recipient->comment);
                    ok length  $rr->recipient->user,    sprintf("%s%s = %s", $ct, 'user',  $rr->recipient->user);
                    ok length  $rr->recipient->host,    sprintf("%s%s = %s", $ct, 'host',  $rr->recipient->host);

                    ok $cv =~ $cr, sprintf("%s%s = %s", $ct, 'address', $cv);
                    ok length $cv, sprintf("%s%s = %s", $ct, 'address', $cv);
                    is $cv, sprintf("%s@%s", $rr->recipient->user, $rr->recipient->host);
                    ok $rr->recipient->alias =~ $cr if length $rr->recipient->alias;
                    ok $rr->recipient->verp  =~ $cr if length $rr->recipient->verp;
                }

                REPLYCODE: {
                    $cv = $rr->replycode;
                    $cr = qr/\A[245]\d\d\z/;
                    $ct = sprintf("[%s-%02d] ->replycode =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);

                    if ( length $cv ) {
                        # The value of "replycode" is not empty
                        ok $cv =~ $cr, sprintf("%s %s", $ct, $cv);

                        my $rv = int substr($cv, 0, 1);
                        my $dv = int substr($rr->deliverystatus, 0, 1);
                        is $rv, $dv, sprintf("%s %dXX (%d.X.X)", $ct, $rv, $dv);
                    }
                    is $cv, $cx->[$errorindex - 1]->[1], sprintf("%s %s", $ct, $cv);
                }

                RHOST: {
                    $cv = $rr->rhost;
                    $cr = qr/\A[^\s\[\]\(\)]+\z/;
                    $ct = sprintf("[%s-%02d] ->rhost =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);
                    ok $cv =~ $cr,  sprintf("%s %s", $ct, $cr) if length $cv;
                }

                SENDERDOMAIN: {
                    $cv = $rr->senderdomain;
                    $cr = qr/\A[-_.0-9A-Za-z]+\z/;
                    $ct = sprintf("[%s-%02d] ->senderdomain =", $e, $errorindex);

                    unless( Sisimai::Address->is_mailerdaemon($rr->addresser->address)) {
                        ok length $cv,               sprintf("%s %s", $ct, $cv);
                        ok $cv =~ $cr,               sprintf("%s %s", $ct, $cr);
                        is $cv, $rr->addresser->host, sprintf("%s addresser->host", $ct);
                    }
                }

                SMTPAGENT: {
                    $cv = $rr->smtpagent;
                    $cr = qr/\A[-.0-9A-Za-z]+\z/;
                    $ct = sprintf("[%s-%02d] ->smtpagent =", $e, $errorindex);

                    ok length $cv, sprintf("%s %s", $ct, $cv);
                    if( index($nameprefix, 'rhost') == 0 ) {
                        # Sisimai::Rhost
                        ok $cv =~ $cr, sprintf("%s %s", $ct, $cr);

                    } else {
                        # Sisimai::Lhost
                        if( $E eq 'RFC3464' && $cv !~ /\ARFC3464/ ) {
                            # Parsed by Sisimai::MDA
                            ok $cv =~ $cr, sprintf("%s %s", $ct, $cr);
                            is scalar @{ [grep { $cv eq $_ } @$lhostindex] }, 0, sprintf("%s %s", $ct, $cv);

                        } elsif( $E eq 'ARF' ) {
                            # Parsed by Sisimai::ARF
                            is $cv, 'Feedback-Loop', sprintf("%s %s", $ct, $cr);

                        } else {
                            # Other MTA modules
                            is $cv, $E, sprintf("%s %s", $ct, $cr);
                        }
                    }
                }

                SMTPCOMMAND: {
                    $cv = $rr->smtpcommand;
                    $cr = qr/\A(?:CONN|HELO|EHLO|MAIL|RCPT|DATA|QUIT)\z/;
                    $ct = sprintf("[%s-%02d] ->smtpcommand =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);
                    ok $cv =~ $cr,  sprintf("%s %s", $ct, $cr) if length $cv;
                }

                SUBJECT: {
                    $cv = $rr->subject;
                    $ct = sprintf("[%s-%02d] ->subject =", $e, $errorindex);

                    ok defined $cv, sprintf("%s %s", $ct, $cv);
                }

                TIMESTAMP: {
                    $cv = $rr->timestamp;
                    $ct = sprintf("[%s-%02d] ->timestamp =", $e, $errorindex);

                    isa_ok $cv, 'Sisimai::Time';
                    ok $cv->epoch, sprintf("%s %s", $ct, $cv->epoch);
                    ok $cv->cdate, sprintf("%s %s", $ct, $cv->cdate);
                }

                TIMEZONEOFFSET: {
                    $cv = $rr->timezoneoffset;
                    $cr = qr/\A[-+]\d{4}/;
                    $ct = sprintf("[%s-%02d] ->timezoneoffset =", $e, $errorindex);

                    ok length $cv, sprintf("%s %s", $ct, $cv);
                    ok $cv =~ $cr, sprintf("%s %s", $ct, $cr);
                }

                TOKEN: {
                    $cv = $rr->token;
                    $cr = qr/\A[0-9a-f]{40}\z/;
                    $ct = sprintf("[%s-%02d] ->token =", $e, $errorindex);

                    is length($cv), 40, sprintf("%s %s", $ct, $cv);
                    ok $cv =~ $cr,      sprintf("%s %s", $ct, $cr);
                }

                DAMN: {
                    $cv = $rr->damn;
                    $ct = sprintf("[%s-%02d] ->damn =", $e, $errorindex);

                    isa_ok $cv, 'HASH';
                    is $cv->{'addresser'}, $rr->addresser->address, sprintf("%s %s", $ct, $cv->{'addresser'});
                    is $cv->{'recipient'}, $rr->recipient->address, sprintf("%s %s", $ct, $cv->{'recipient'});
                    is $cv->{'timestamp'}, $rr->timestamp->epoch,   sprintf("%s %d", $ct, $cv->{'timestamp'});
                    is $cv->{'catch'},     '',                      sprintf("%s ''", $ct);
                }

                DUMP: {
                    # JSON
                    $cv = $rr->dump('json');
                    $ct = sprintf("[%s-%02d] ->dump(json) =", $e, $errorindex);
                    $cj = $jsonobject->decode($cv);

                    isa_ok $cj, 'HASH';
                    ok length $cv,         sprintf("%s %s", $ct, substr($cv, 0, 32));
                    is $cj->{'catch'}, '', sprintf("%s ''", $ct);
                    is $rr->addresser->address, $cj->{'addresser'}, sprintf("%s %s", $ct, $cj->{'addresser'});
                    is $rr->recipient->address, $cj->{'recipient'}, sprintf("%s %s", $ct, $cj->{'recipient'});
                    is $rr->timestamp->epoch,   $cj->{'timestamp'}, sprintf("%s %s", $ct, $cj->{'timestamp'});

                    eval {
                        # YAML; this module is an optional
                        require YAML;
                        $cv = $rr->dump('yaml');
                        $ct = sprintf("[%s-%02d] ->dump(yaml) =", $e, $errorindex);
                        $cj = YAML::Load($cv);

                        isa_ok $cj, 'HASH';
                        ok length $cv,         sprintf("%s %s", $ct, substr($cv, 0, 3));
                        is $cj->{'catch'}, '', sprintf("%s ''", $ct);
                        is $rr->addresser->address, $cj->{'addresser'}, sprintf("%s %s", $ct, $cj->{'addresser'});
                        is $rr->recipient->address, $cj->{'recipient'}, sprintf("%s %s", $ct, $cj->{'recipient'});
                        is $rr->timestamp->epoch,   $cj->{'timestamp'}, sprintf("%s %s", $ct, $cj->{'timestamp'});
                    };
                }

            } # End of the loop for checking each Sisimai::Fact object
            $emailindex++;
            ok $errorindex, sprintf("%s is including %d bounces", $mailobject->data->path, $errorindex);

        } # End of READ_EACH_EMAIL

    } # End of PARSE_EACH_EMAIL
    ok $emailindex, sprintf("%s have parsed %d emails", $M, $emailindex);
};

sub makeinquiry { return $moduletest }

1;
