File Coverage

blib/lib/Test/Email.pm

Criterion	Covered	Total	%
statement	54	90	60.0
branch	0	10	0.0
condition	0	2	0.0
subroutine	12	19	63.1
pod	1	7	14.2
total	67	128	52.3

package Test::Email;
use strict;
use warnings;

use Test::Builder;
use MIME::Parser;
use Carp 'croak';

use base 'MIME::Entity';

our $VERSION = '0.04';

my $TEST = Test::Builder->new();

my $DEBUG = 0;

sub ok {
    my ($self, $test_href, $desc) = @_;

    my $pass = $self->_run_tests($test_href);

    my $ok = $TEST->ok($pass, $desc);

    return $ok;
}

sub header_ok {
    my ($self, $header_name, $argument, $description) = @_;

    my $value = $self->head()->get($header_name);
    chomp($value);

    my $pass = $TEST->ok($value eq $argument, $description);

    return $pass;
}

sub header_like {
    my ($self, $header_name, $argument, $description) = @_;

    my $value = $self->head()->get($header_name);
    chomp($value);

    my $pass = $TEST->like($value, $argument, $description);

    return $pass;
}

sub header_is {
    my ($self, $header_name, $argument, $description) = @_;

    my $value = $self->head()->get($header_name);
    chomp($value);

    my $pass = $TEST->is_eq($value, $argument, $description);

    return $pass;
}

sub body_ok {
    my ($self, $argument, $description) = @_;

    my $body = join '', @{ $self->body() };

    $body =~ s/\n+$//;
    $argument  =~ s/\n+$//;

    my $pass = $TEST->ok($body eq $argument, $description);

    return $pass;
}

sub body_like {
    my ($self, $argument, $description) = @_;

    my $body = join '', @{ $self->body() };

    $body =~ s/\n+$//;
    $argument  =~ s/\n+$//;

    my $pass = $TEST->like($body, $argument, $description);

    return $pass;
}

sub body_is {
    my ($self, $argument, $description) = @_;

    my $body = join '', @{ $self->body() };

    $body =~ s/\n+$//;
    $argument  =~ s/\n+$//;

    my $pass = $TEST->is_eq($body, $argument, $description);

    return $pass;
}

# run all tests against this email, return success
sub _run_tests {
    my ($self, $test_href) = @_;

    for my $key (keys %$test_href) {
        my $passed = $self->_test($key, $test_href->{$key});
        if (!$passed) {
            return 0;
        }
    }

    return 1;
}

my %test_for = (
    header	=>	\&_test_header,
    body	=>	\&_test_body,
);

# perform one test against one email
sub _test {
    my ($self, $key, $test) = @_;

    _debug("in _test($self, $key, $test)");

    if (my $test_cref = $test_for{$key}) {
	return $test_cref->($self, $test);
    }
    else {
	return $test_for{header}->($self, $key, $test);
    }
}

sub _test_header {
    my ($self, $header, $test) = @_;

    _debug("in _test_header($self, $header, $test)");

    my $value = $self->head()->get($header) || '';
    chomp($value);

    return _do_test($value, $test);
}

sub _test_body {
    my ($self, $test) = @_;

    _debug("in _test_body($self, $test)");

    my $body = join '', @{ $self->body() };
    return _do_test($body, $test);
}

sub _do_test {
    my ($thing, $test) = @_;

    _debug("Testing '$thing' against $test");

    my $type = ref $test;
    if ($type eq 'Regexp') {
	return $thing =~ $test;
    }
    elsif ($type eq '') {
        $thing =~ s/\n+$//;
        $test  =~ s/\n+$//;
	return $thing eq $test;
    }
    else {
	croak "I don't know how to test for this type: '$type'";
    }
}

sub _debug {
    my ($msg) = @_;
    warn $msg."\n" if $DEBUG;
}

1;
__END__