view release on metacpan or  search on metacpan

t/lib/Test/EmailAbstract.pm  view on Meta::CPAN

use strict;

package Test::EmailAbstract;
use Test::More;

sub new {
  my ($class, $message) = @_;
  my $simple = Email::Simple->new($message);
  bless { simple => $simple } => $class;
}

sub simple { $_[0]->{simple} }

sub _call {
  my ($wrapped, $object, $method, @args) = @_;

  if ($wrapped) {
    return $object->$method(@args);
  } else {
    return Email::Abstract->$method($object, @args);
  }
}

sub tests_per_class  { 7 }
sub tests_per_object { 8 }
sub tests_per_module {
  + 1
  + 2 * $_[0]->tests_per_class
  + 1 * $_[0]->tests_per_object
}

sub _do_tests {
  my ($self, $is_wrapped, $class, $obj, $readonly) = @_;

  if ($is_wrapped) {
    isa_ok($obj, 'Email::Abstract', "wrapped $class object");
  }

  is(
    _call($is_wrapped, $obj, 'get_header', 'Subject'),
    'Re: Defect in XBD lround',
    "Subject OK with $class"
  );

  eval { _call($is_wrapped, $obj, set_header => "Subject", "New Subject"); };

  if ($readonly) {
    like($@, qr/can't alter string/, "can't alter an unwrapped string");
  } else {
    is($@, '', "no exception on altering object via Email::Abstract");
  }

  my @receiveds = (
    q{from mailman.opengroup.org ([192.153.166.9]) by deep-dark-truthful-mirror.pad with smtp (Exim 3.36 #1 (Debian)) id 18Buh5-0006Zr-00 for <posix@simon-cozens.org>; Wed, 13 Nov 2002 10:24:23 +0000},
    q{(qmail 1679 invoked by uid 503); 13 Nov 2002 10:10:49 -0000},
  );

  my @got = _call($is_wrapped, $obj, get_header => 'Received');
  s/\t/ /g for @got;

  is_deeply(
    \@got,
    \@receiveds,
    "$class: received headers match up list context get_header",
  );

  my $got_body    = _call($is_wrapped, $obj, 'get_body');
  my $simple_body = $self->simple->body;