Merge branch 'bugfixes-6_2_2'

dada/DADA/App/BounceHandler/MessageParser.pm

@@ -271,6 +271,10 @@ sub generic_parse {
 
     $email = DADA::App::Guts::strip($email);
     $email =~ s/^\<|\>$//g if $email;
+	if(!$email) { 
+		$email = $self->generic_body_parse_for_email($entity); 
+	}
+
     $list = DADA::App::Guts::strip($list) if $list;
     return ( $list, $email, \%return );
 
@@ -567,6 +571,44 @@ sub generic_body_parse_for_list {
     }
 }
 
+sub generic_body_parse_for_email {
+
+    my $self   = shift;
+    my $entity = shift;
+    my $email;
+
+    my @parts = $entity->parts;
+    if ( !@parts ) {
+
+	    my $body = $entity->bodyhandle;
+	    my $IO;
+
+	    return undef if !defined($body);
+
+	    if ( $IO = $body->open("r") ) {    # "r" for reading.
+	        while ( defined( $_ = $IO->getline ) ) {
+	            chomp($_);
+				if($_ =~ m/Your message to \<(.*?)\> was automatically rejected/){ 
+					return $1; 
+				}
+			}
+		}
+    }
+    else {
+        my $i;
+        for $i ( 0 .. $#parts ) {
+            my $part = $parts[$i];
+            $email = $self->generic_body_parse_for_email($part);
+            if ($email) {
+                return $email;
+            }
+        }
+    }
+}
+
+
+
+
 sub find_list_from_unsub_link {
 
     my $self   = shift;
@@ -706,7 +748,8 @@ sub parse_for_rfc6522 {
 		if defined $notification;
 
 	$diag->{parsed_by} .= 'parse_for_rfc6522'; 
-
+    $email =~ s/\<|\>//g; 
+	$email = strip($email); 
 	return ( $list, $email, $diag );
 
 }
@@ -988,6 +1031,10 @@ sub parse_for_qmail {
                             $diag->{Guessed_MTA} = 'Qmail';
                             $diag->{'Diagnostic-Code'} = $data;
                         }
+						elsif($data =~ m/user is over quota/){ 
+                            $diag->{Guessed_MTA} = 'Qmail';
+                            $diag->{'Diagnostic-Code'} = $data;							
+						}
                     }
                 }
 
@@ -1060,13 +1107,16 @@ sub parse_for_exim {
 							# This should probably be moved to the Rules...
 							# And these are fairly genreal-purpose...
 							elsif ($_ =~ m/This user doesn\'t have a (.*?) account|unknown user|This account has been disabled or discontinued|or discontinued \[\#102\]|User(.*?)does not exist|Invalid mailbox|mailbox unavailable|550\-5\.1\.1|550 5\.1\.1|Recipient does not exist here/) { 
-                                $diag->{'Status'} = '5.x.y';								
+                                $diag->{'Status'} = '5.x.y';
 							}
                             else {
                             }
 
 
-							if($_ =~ m/RCPT TO\:\<(\S+\@\S+)\>\:/){ 
+							if($_ =~ m/This user doesn't have a (.*?) account \((.*?)\)/){ 
+								$email = $2; 
+							}
+							elsif($_ =~ m/RCPT TO\:\<(\S+\@\S+)\>\:/){ 
 								$email = $1; 	
 							}	
                             elsif ( $_ =~ /(\S+\@\S+)/ ) {

dada/DADA/App/FormatMessages.pm

@@ -792,7 +792,7 @@ sub _make_multipart {
 
 	if($orig_type eq 'text/plain'){ 
 		$new_type = 'text/html'; 
-		$new_data = plaintext_to_html({-str => safely_encode($orig_content)});
+		$new_data = plaintext_to_html({-str => $orig_content});
 
 		# I kind of agree this is a strange place to put this, but H::T template tags 
 		# are getting clobbered: 
@@ -810,12 +810,12 @@ sub _make_multipart {
 	}
 	else { 
 		$new_type = 'text/plain';
-		$new_data = html_to_plaintext({-str => safely_encode($orig_content)});
+		$new_data = html_to_plaintext({-str => $orig_content});
 	}
 
 	my $new_entity = MIME::Entity->build(
 		Type     => $new_type, 
-		Data     => $new_data, 
+		Data     => safely_encode($new_data), 
 		Encoding => $orig_encoding,
 	 );
 
@@ -974,63 +974,63 @@ sub _format_headers {
 
 
 
-sub _encode_header { 
-
-	my $self       = shift; 
-	my $label      = shift; 
-	my $value      = shift; 
-	my $new_value  = undef; 
+sub _encode_header {
+
+    my $self      = shift;
+    my $label     = shift;
+    my $value     = shift;
+    my $new_value = undef;
+
+    return $value
+      unless $self->im_encoding_headers;
+
+    require MIME::EncWords;
+
+    if (   $label eq 'Subject'
+        || $label eq 'List'
+        || $label eq 'List-URL'
+        || $label eq 'List-Owner'
+        || $label eq 'List-Subscribe'
+        || $label eq 'List-Unsubscribe'
+        || $label eq 'just_phrase' )
+    {
+
+		# Bug: https://rt.cpan.org/Ticket/Display.html?id=84295
+		my $MaxLineLen = -1;
+
+        $new_value = MIME::EncWords::encode_mimewords(
+            $value,
+            Encoding   => 'Q',
+            MaxLineLen => $MaxLineLen,
+			Charset    => $self->{ls}->param('charset_value'),
+        );
+
+    }
+    else {
+        require Email::Address;
+        my @addresses = Email::Address->parse($value);
+        for my $address (@addresses) {
+
+            my $phrase = $address->phrase;
+
+            $address->phrase(
+                MIME::EncWords::encode_mimewords(
+                    $phrase,
+                    Encoding => 'Q',
+                    Charset  => $self->{ls}->param('charset_value'),
+                )
+            );
+        }
+        my @new_addresses = ();
+        for (@addresses) {
+            push( @new_addresses, $_->format() );
+        }
+
+        $new_value = join( ', ', @new_addresses );
+    }
+
+    return $new_value;
 
-	return $value 
-	 	unless $self->im_encoding_headers;
-
-	require MIME::EncWords;
-
-	if(
-	   $label eq 'Subject'           || 
-	   $label eq 'List'              ||
-	   $label eq 'List-URL'          || 
-	   $label eq 'List-Owner'        ||
-	   $label eq  'List-Subscribe'   ||
-	   $label eq  'List-Unsubscribe' ||
-	   $label eq 'just_phrase'
-	){ 
-
-
-		$new_value = 
-		MIME::EncWords::encode_mimewords(
-			$value, 
-			Encoding => 'Q',
-			Charset  => $self->{ls}->param('charset_value'),
-		); 
-	}
-	else { 
-		require Email::Address;	
-		 my @addresses = Email::Address->parse($value); 
-		 for my $address(@addresses){
-
-		 	my $phrase = $address->phrase;
-
-		    $address->phrase(	
-				MIME::EncWords::encode_mimewords(
-					$phrase, 
-					Encoding => 'Q',
-					Charset  => $self->{ls}->param('charset_value'),
-				) 
-			);
-		}
-		my @new_addresses = (); 
-		for(@addresses){ 
-
-			push(@new_addresses, $_->format()); 
-		}
-
-		$new_value = join(', ', @new_addresses);
-	}
-
-
-	return $new_value; 
-
 }