diff --git a/lib/Email/Stuffer.pm b/lib/Email/Stuffer.pm index 81162e6..36854d9 100644 --- a/lib/Email/Stuffer.pm +++ b/lib/Email/Stuffer.pm @@ -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 => [], ), @@ -257,14 +258,25 @@ sub headers { shift()->{email}->header_names; ## This is now header_names, headers is depreciated } -=method parts +=method text_parts -Returns, as a list, the L parts for the Email +Returns, as a list, the L parts for the Email to text. =cut -sub parts { - grep { defined $_ } @{shift()->{parts}}; +sub text_parts { + grep { defined $_ } @{shift()->{text_parts}}; +} + +=method attach_parts + +Returns, as a list, the L parts for the Email relating to +attachments. + +=cut + +sub attach_parts { + grep { defined $_ } @{shift()->{attach_parts}}; } ##################################################################### @@ -413,7 +425,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, ); @@ -444,7 +456,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, ); @@ -517,12 +529,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, ); @@ -635,29 +643,33 @@ Creates and returns the full L 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}; diff --git a/t/alternative.t b/t/alternative.t index 79173df..3aec34c 100644 --- a/t/alternative.t +++ b/t/alternative.t @@ -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 @@ -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/I am a html emáil<\/b>/, 'Email contains text_body' ); +##################################################################### +# Multipart/Alternate tests with attachment + +my $rv2 = Email::Stuffer->from ( 'Adam Kennedy') + ->to ( 'adam@phase-n.com' ) + ->subject ( 'Hello To:!' ) + ->text_body ( 'I am an emáil' ) + ->html_body ( 'I am a html emáil' ) + ->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/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; diff --git a/t/basic.t b/t/basic.t index 928a09b..034334e 100644 --- a/t/basic.t +++ b/t/basic.t @@ -115,12 +115,17 @@ my $rv2 = Email::Stuffer->from ( 'Adam Kennedy') ->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' )