use strict;
use warnings;
use Test::Differences;
use Test::Fatal;
use Test::More 0.88;
use Courriel::Builder;
use Courriel::Helpers;
use List::AllUtils qw( all );
{
my $email = build_email(
subject('Test Subject'),
from('autarch@urth.org'),
to( 'autarch@urth.org', Email::Address->parse('bob@example.com') ),
cc( 'jane@example.com', Email::Address->parse('joe@example.com') ),
header( 'X-Foo' => 42 ),
header( 'X-Bar' => 84 ),
plain_body('The body of the message')
);
isa_ok( $email, 'Courriel' );
my %expect = (
Subject => 'Test Subject',
From => 'autarch@urth.org',
To => 'autarch@urth.org, bob@example.com',
Cc => 'jane@example.com, joe@example.com',
'X-Foo' => '42',
'X-Bar' => 84,
'Content-Type' => 'text/plain; charset=UTF-8',
'MIME-Version' => '1.0',
);
for my $key ( sort keys %expect ) {
is_deeply(
[ map { $_->value() } $email->headers()->get($key) ],
[ $expect{$key} ],
"got expected value for $key header"
);
}
my @date = $email->headers()->get('Date');
is( scalar @date, 1, 'found one Date header' );
like(
$date[0]->value(),
qr/\w\w\w, \d\d \w\w\w \d\d\d\d \d\d:\d\d:\d\d [-+]\d\d\d\d/,
'Date header looks like a proper date'
);
my @id = $email->headers()->get('Message-Id');
is( scalar @id, 1, 'found one Message-Id header' );
like(
$id[0]->value(),
qr/<[^>]+>/,
'Message-Id is in brackets'
);
}
{
my $email = build_email(
subject('Test Subject'),
plain_body(
content => 'Foo',
charset => 'ISO-8859-1'
),
);
my @ct = $email->headers()->get('Content-Type');
is( scalar @ct, 1, 'found one Content-Type header' );
is(
$ct[0]->value(),
'text/plain; charset=ISO-8859-1',
'Content-Type has the right charset'
);
}
{
my $email = build_email(
subject(q{}),
plain_body(
content => 'Foo',
),
);
is_deeply(
[ map { $_->value() } $email->headers()->get('Subject') ],
[q{}],
'got an empty string for the Subject header',
);
}
{
my $dt = DateTime->new( year => 1980, time_zone => 'UTC' );
my $email = build_email(
subject('Test Subject'),
header( Date => DateTime::Format::Mail->format_datetime($dt) ),
plain_body( content => 'Foo' ),
);
my @date = $email->headers()->get('Date');
is( scalar @date, 1, 'found one Date header' );
is(
$date[0]->value(),
'Tue, 01 Jan 1980 00:00:00 -0000',
'explicit Date header is not overwritten'
);
}
{
my $email = build_email(
subject('Test Subject'),
plain_body(
content => "Foo \x{00F1}",
encoding => 'quoted-printable'
),
);
is(
$email->plain_body_part()->encoded_content(),
'Foo =C3=B1=' . $Courriel::Helpers::CRLF,
'body is encoded using quoted-printable'
);
}
{
my $content = 'content ref';
my $email = build_email(
subject('Test Subject'),
plain_body( \$content ),
);
is(
$email->plain_body_part()->content(),
$content,
'can pass body content as a scalar ref'
);
}
{
my $email = build_email(
subject('Test Subject'),
plain_body('foo'),
html_body('<p>foo</p>'),
);
is(
$email->content_type()->mime_type(),
'multipart/alternative',
'passing a plain and html body with no attachments makes a multipart/alternative email'
);
}
{
my $pl_script = <<'EOF';
#!/usr/bin/perl
print "Hello world\n";
EOF
my $email = build_email(
subject('Test Subject'),
plain_body('foo'),
attach( content => $pl_script ),
);
is(
$email->content_type()->mime_type(),
'multipart/mixed',
'passing an attachment makes a multipart/mixed email'
);
my @parts = $email->parts();
is( scalar @parts, 2, 'email has two parts' );
ok(
( all { !$_->is_multipart() } @parts ),
'email consists of two single parts'
);
my $attachment
= $email->first_part_matching( sub { $_[0]->is_attachment() } );
ok(
$attachment,
'one of the parts returns true for is_attachment'
);
SKIP:
{
skip 'These tests rely on my local magic definitions', 2
unless $ENV{RELEASE_TESTING};
like(
$attachment->mime_type(),
qr{/x-perl$},
'correct mime type detected for attachment'
);
is(
$attachment->charset(),
'us-ascii',
'correct charset detected for attachment'
);
}
is(
$attachment->content(),
$pl_script,
'attachment content matches the original code'
);
like(
$email->as_string(),
qr{Content-Type:\s+multipart/mixed;\s+boundary=.+},
'Content-Type header for multipart email includes boundary'
);
my $parsed = Courriel->parse( text => $email->as_string() );
my $parsed_attachment
= $parsed->first_part_matching( sub { $_[0]->is_attachment() } );
is(
$parsed_attachment->content(),
$pl_script,
'attachment content survives round trip from string to object'
);
}
{
my $pl_script = <<'EOF';
#!/usr/bin/perl
print "Hello world\n";
EOF
my $email = build_email(
subject('Test Subject'),
plain_body('foo'),
html_body('<p>foo</p>'),
attach( content => $pl_script ),
);
is(
$email->content_type()->mime_type(),
'multipart/mixed',
'passing a plain and html body with attachments makes a multipart/alternative email'
);
ok(
$email->plain_body_part(),
'email has a plain body'
);
ok(
$email->html_body_part(),
'email has an html body'
);
ok(
$email->first_part_matching(
sub { $_[0]->mime_type() eq 'multipart/alternative' }
),
'email has a multipart/alternative part'
);
my $attachment
= $email->first_part_matching( sub { $_[0]->is_attachment() } );
ok(
$attachment,
'email has an attachment'
);
}
{
open my $fh, '<', 't/data/office.jpg' or die $!;
my $image = do { local $/; <$fh> };
close $fh;
my $email = build_email(
subject('Test Subject'),
html_body(
'<p>foo</p>',
attach(
content => $image,
filename => 'office.jpg',
),
),
);
is(
$email->content_type()->mime_type(),
'multipart/related',
'passing an html body with attached image makes a multipart/related email'
);
my $attachment
= $email->first_part_matching( sub { $_[0]->is_attachment() } );
ok(
$attachment,
'email has an attachment'
);
is(
$attachment->mime_type(),
'image/jpeg',
'got the right mime type for image attachment'
);
}
{
my $email = build_email(
subject('Test Subject'),
plain_body('Foo'),
attach('t/data/office.jpg'),
);
my $attachment
= $email->first_part_matching( sub { $_[0]->is_attachment() } );
ok(
$attachment,
'email has an attachment'
);
is(
$attachment->mime_type(),
'image/jpeg',
'got the right mime type for image attachment from file'
);
}
{
my $email = build_email(
subject('Test Subject'),
plain_body('Foo'),
attach(
file => 't/data/office.jpg',
content_id => 'abc123',
),
);
my $attachment
= $email->first_part_matching( sub { $_[0]->is_attachment() } );
is_deeply(
[ map { $_->value() } $attachment->headers()->get('Content-ID') ],
['<abc123>'],
'attachment has the correct Content-ID, and it is wrapped in brackets'
);
}
{
my $email = build_email(
subject('Test Subject'),
plain_body('Foo'),
attach(
file => 't/data/office.jpg',
mime_type => 'w/tf',
),
);
my $attachment
= $email->first_part_matching( sub { $_[0]->is_attachment() } );
is_deeply(
$attachment->mime_type(),
'w/tf',
'attachment has explicitly set mime type'
);
}
{
my $email = build_email(
subject('Test Subject'),
plain_body('Foo'),
attach(
file => 't/data/office.jpg',
filename => 'something-else.jpg',
),
);
my $attachment
= $email->first_part_matching( sub { $_[0]->is_attachment() } );
is_deeply(
$attachment->filename(),
'something-else.jpg',
'attachment has explicitly set filename'
);
}
{
like(
exception { build_email( ['wtf'] ); },
qr/checking type constraint for HashRef/,
'got error when passing invalid value to build_email'
);
}
{
like(
exception { build_email( { bad_key => 42 } ); },
qr/A weird value was passed to build_email:/,
'got error when passing invalid value to build_email'
);
}
{
like(
exception { build_email( subject('foo') ); },
qr/Cannot call build_email without a plain or html body/,
'got error when passing invalid value to build_email'
);
}
{
like(
exception { build_email(); },
qr/0 parameters were passed to Courriel::Builder::build_email but 1 was expected/,
'got error when passing no arguments to build_email'
);
}
done_testing();