Issue rjbs#25: mixed + alternative not supported

simongreen-net · Jun 25, 2017 · ba8c4de · ba8c4de
1 parent 0f3d7e6
commit ba8c4de
Show file tree

Hide file tree

Showing 3 changed files with 101 additions and 39 deletions.
diff --git 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,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
 
@@ -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,
     );
@@ -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,
     );
@@ -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,
     );
@@ -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};

diff --git 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/<b>I am a html emáil<\/b>/, 'Email contains text_body' );
 
+#####################################################################
+# Multipart/Alternate tests with attachment
+
+my $rv2 = Email::Stuffer->from       ( 'Adam Kennedy<[email protected]>')
+                       ->to         ( '[email protected]'              )
+                       ->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;
diff --git a/t/basic.t b/t/basic.t
@@ -115,12 +115,17 @@ my $rv2 = Email::Stuffer->from       ( 'Adam Kennedy<[email protected]>')
                         ->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<[email protected]>'        )