Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
89 changes: 56 additions & 33 deletions lib/Email/Stuffer.pm
Original file line number Diff line number Diff line change
Expand Up @@ -213,8 +213,9 @@ sub new {
my ($class, $arg) = @_;

my $self = bless {
parts => [],
email => Email::MIME->create(
text_parts => [],
attach_parts => [],
email => Email::MIME->create(
header => [],
parts => [],
),
Expand Down Expand Up @@ -257,16 +258,38 @@ sub headers {
shift()->{email}->header_names; ## This is now header_names, headers is depreciated
}

=method text_parts

Returns, as a list, the L<Email::MIME> parts for the Email to text.

=cut

sub text_parts {
grep { defined $_ } @{shift()->{text_parts}};
}

=method attach_parts

Returns, as a list, the L<Email::MIME> parts for the Email relating to
attachments.

=cut

sub attach_parts {
grep { defined $_ } @{shift()->{attach_parts}};
}

=method parts

Returns, as a list, the L<Email::MIME> parts for the Email

=cut

sub parts {
grep { defined $_ } @{shift()->{parts}};
($_[0]->text_parts, $_[0]->attach_parts);
}


#####################################################################
# Header Methods

Expand Down Expand Up @@ -413,7 +436,7 @@ sub text_body {
);

# Create the part in the text slot
$self->{parts}->[0] = Email::MIME->create(
$self->{text_parts}->[0] = Email::MIME->create(
attributes => \%attr,
body_str => $body,
);
Expand Down Expand Up @@ -444,7 +467,7 @@ sub html_body {
);

# Create the part in the HTML slot
$self->{parts}->[1] = Email::MIME->create(
$self->{text_parts}->[1] = Email::MIME->create(
attributes => \%attr,
body_str => $body,
);
Expand Down Expand Up @@ -517,12 +540,8 @@ sub attach {

### MORE?

# Determine the slot to put it at
my $slot = scalar @{$self->{parts}};
$slot = 3 if $slot < 3;

# Create the part in the attachment slot
$self->{parts}->[$slot] = Email::MIME->create(
push @{$self->{attach_parts}}, Email::MIME->create(
attributes => \%attr,
body => $body,
);
Expand Down Expand Up @@ -635,29 +654,33 @@ Creates and returns the full L<Email::MIME> object for the email.
=cut

sub email {
my $self = shift;
my @parts = $self->parts;

### Lyle Hopkins, code added to Fix single part, and multipart/alternative
### problems
if (scalar(@{ $self->{parts} }) >= 3) {
## multipart/mixed
$self->{email}->parts_set(\@parts);
} elsif (scalar(@{ $self->{parts} })) {
## Check we actually have any parts
if ( _INSTANCE($parts[0], 'Email::MIME')
&& _INSTANCE($parts[1], 'Email::MIME')
) {
## multipart/alternate
$self->{email}->header_set('Content-Type' => 'multipart/alternative');
$self->{email}->parts_set(\@parts);
} elsif (_INSTANCE($parts[0], 'Email::MIME')) {
## As @parts is $self->parts without the blanks, we only need check
## $parts[0]
## single part text/plain
_transfer_headers($self->{email}, $parts[0]);
$self->{email} = $parts[0];
}
my $self = shift;
my @text_parts = $self->text_parts;
my @parts = $self->attach_parts;

if ( scalar(@text_parts) > 1 ) {
my $text_mime =
Email::MIME->create(
header => [ 'Content-Type' => 'multipart/alternative' ] );
$text_mime->parts_set( \@text_parts );
unshift @parts, $text_mime;
}
elsif ( scalar(@text_parts) == 1 ) {
## As @text_parts is $self->text_parts without the blanks, we only need check
## $parts[0]
## single part text/plain OR text/html
unshift @parts, $text_parts[0];
}

if ( scalar(@parts) > 1 ) {
## More than one part, so use multipart/mixed
$self->{email}->header_set( 'Content-Type' => 'multipart/mixed' );
$self->{email}->parts_set( \@parts );
}
elsif ( scalar(@parts) == 1 ) {
# Just one part: text, html or attachment
_transfer_headers( $self->{email}, $parts[0] );
$self->{email} = $parts[0];
}

$self->{email};
Expand Down
34 changes: 34 additions & 0 deletions t/alternative.t
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,10 @@ use warnings;
use Test::More qw[no_plan];
use Email::Stuffer;
use Email::Sender::Transport::Test ();
use File::Spec::Functions ':ALL';

my $TEST_GIF = catfile( 't', 'data', 'paypal.gif' );
ok( -f $TEST_GIF, "Found test image: $TEST_GIF" );

#####################################################################
# Multipart/Alternate tests
Expand Down Expand Up @@ -34,4 +37,35 @@ my $mime = $email->object;
like( ($mime->subparts)[0]->body_str, qr/I am an emáil/, 'Email contains text_body' );
like( ($mime->subparts)[1]->body_str, qr/<b>I am a html emáil<\/b>/, 'Email contains text_body' );

#####################################################################
# Multipart/Alternate tests with attachment

my $rv2 = Email::Stuffer->from ( 'Adam Kennedy<adam@phase-n.com>')
->to ( 'adam@phase-n.com' )
->subject ( 'Hello To:!' )
->text_body ( 'I am an emáil' )
->html_body ( '<b>I am a html emáil</b>' )
->attach_file( $TEST_GIF )
->transport ( $test )
->send;
ok( $rv2, 'Email sent ok' );
is( $test->delivery_count, 1, 'Sent one email' );
$email = $test->shift_deliveries->{email};
$string = $email->as_string;

like( $string, qr/Adam Kennedy/, 'Email contains from name' );
like( $string, qr/phase-n/, 'Email contains to string' );
like( $string, qr/Hello/, 'Email contains subject string' );
like( $string, qr/Content-Type: multipart\/alternative/, 'Email content type' );
like( $string, qr/Content-Type: text\/plain/, 'Email content type' );
like( $string, qr/Content-Type: text\/html/, 'Email content type' );

$mime = $email->object;
like( (($mime->subparts)[0]->subparts)[0]->body_str, qr/I am an emáil/, 'Email contains text_body' );
like( (($mime->subparts)[0]->subparts)[1]->body_str, qr/<b>I am a html emáil<\/b>/, 'Email contains text_body' );
like( ($mime->subparts)[0]->content_type, qr{^multipart/alternative}, 'First part is multipart/alternative');
like( ($mime->subparts)[1]->content_type, qr{^image/gif}, 'Second part is image/gif');
like( (($mime->subparts)[0]->subparts)[0]->content_type, qr{text/plain}, 'First text sub part is text/plain' );
like( (($mime->subparts)[0]->subparts)[1]->content_type, qr{text/html}, 'Second text sub part is text/html' );

1;
17 changes: 11 additions & 6 deletions t/basic.t
Original file line number Diff line number Diff line change
Expand Up @@ -115,12 +115,17 @@ my $rv2 = Email::Stuffer->from ( 'Adam Kennedy<adam@phase-n.com>')
->send;
ok( $rv2, 'Email sent ok' );
is( $test->delivery_count, 1, 'Sent one email' );
my $email = $test->shift_deliveries->{email}->as_string;
like( $email, qr/Adam Kennedy/, 'Email contains from name' );
like( $email, qr/phase-n/, 'Email contains to string' );
like( $email, qr/Hello/, 'Email contains subject string' );
like( $email, qr/I am an email/, 'Email contains text_body' );
like( $email, qr/paypal/, 'Email contains file name' );
my $email = $test->shift_deliveries->{email};
my $string = $email->as_string;
like( $string, qr/Adam Kennedy/, 'Email contains from name' );
like( $string, qr/phase-n/, 'Email contains to string' );
like( $string, qr/Hello/, 'Email contains subject string' );
like( $string, qr/I am an email/, 'Email contains text_body' );
like( $string, qr/paypal/, 'Email contains file name' );

my $mime = $email->object;
like( ($mime->subparts)[0]->content_type, qr{^text/plain}, 'First part is text/plain');
like( ($mime->subparts)[1]->content_type, qr{^image/gif}, 'Second part is image/gif');

# attach_file content_type
$rv2 = Email::Stuffer->from ( 'Adam Kennedy<adam@phase-n.com>' )
Expand Down