The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package TestBounceParser;

=encoding utf8

=head1 NAME

TestBounceParser - utility functions for L<Mail::DeliveryStatus::BounceParser>'s unittests

=head1 SYNOPSIS

  use TestBounceParser;

  check_report('file-in-corpus.msg',
    is_bounce => 1,
    addresses => [qw(foo@example.com bar@example.com)],
    std_reason => 'domain_error',
    smtp_code => 550
  );

=head1 EXPORTED FUNCTIONS

=cut

use warnings;
use strict;

use Test::More;
use Mail::DeliveryStatus::BounceParser;

use Exporter 'import';
our @EXPORT = qw(readfile check_report);

=head2 readfile

  my $content = readfile('path/to_file.msg');

Returns the content of the file passed as argument.

=cut

# FH because we're being backcompat to pre-lexical
sub readfile {
    my $fn = shift;
    open FH, "$fn" or die $!;
    local $/;
    my $text = <FH>;
    close FH;
    return $text;
}

=head2 check_report

  my $bounce = check_report($filename, %expectations);

The following keys are supported in C<%expectations>:

=over 4

=item is_bounce

whether the message is expected to be a bounce

=item reports

the number of reports we are expecting

=item addresses

an Arrayref to the list of addresses we are expecting

=item smtp_code

the SMTP code we are expecting (e.g. "554")

=item status

the status code we are expecting (e.g. "5.4.4")

=item reason

the reason string we are expecting (e.g. "550 Host unknown")

=item orig_message_id

the parsed original message id we are expecting

=item todo_is_bounce

when set, the is_bounce check is guarded in a TODO block

=item todo_std_reason

when set, the std_reason check is guarded in a TODO block

=back

=cut

sub check_report {
    my ( $filename, %expectations ) = @_;

    my $message = readfile($filename);
    my $bounce  = Mail::DeliveryStatus::BounceParser->new($message);
    isa_ok( $bounce, 'Mail::DeliveryStatus::BounceParser' );
    my ($report) = $bounce->reports;

TODO: {
        local $TODO = $expectations{todo_is_bounce};
        is( $bounce->is_bounce,
            $expectations{is_bounce},
            'is_bounce is correct'
        );
    }

    if ( exists $expectations{reports} ) {
        my $cnt = $expectations{reports};
        cmp_ok( $bounce->reports, '==', $cnt, "Found $cnt reports" );
    }

    if ( my $addrs = $expectations{addresses} ) {
        my $cnt = $expectations{addresses};
        cmp_ok( $bounce->addresses, '==', @$addrs,
            'found correct number of addresses' );
        is_deeply( [ map {lc} $bounce->addresses ],
            $addrs, 'addresses are correct' );
    }

TODO: {
        local $TODO = $expectations{todo_std_reason};
        if ( my $std_reason = $expectations{std_reason} ) {
            is( $report->get('std_reason'),
                $std_reason, "std reason is $std_reason" );
        }
    }

    if ( my $code = $expectations{smtp_code} ) {
        is( $report->get('smtp_code'), $code, 'smtp_code is correct' );
    }

    if ( my $status = $expectations{status} ) {
        is( $report->get('Status'), $status, 'status code is correct' );
    }

    if ( my $expected_reason = $expectations{reason} ) {
        my $reason = $report->get('reason');
        $expected_reason =~ s/\s//g;
        $reason =~ s/\s//g;
        is( $reason, $expected_reason, 'reason is right' );
    }

    if ( my $omid = $expectations{orig_message_id} ) {
        is( $bounce->orig_message_id, $omid,
            'the right bounced message id is given' );
    }

    return $bounce;
}

1;

=head1 AUTHOR

Philipp Gortan <gortan@cpan.org>

=cut