first pass RT4 merge, RT#13852
[freeside.git] / rt / t / mail / sendmail.t
index 1f97bbb..bb5d2db 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use File::Spec ();
 
-use RT::Test tests => 137;
+use RT::Test tests => 141;
 
 use RT::EmailParser;
 use RT::Tickets;
@@ -13,7 +13,7 @@ my @_outgoing_messages;
 my @scrips_fired;
 
 #We're not testing acls here.
-my $everyone = RT::Group->new($RT::SystemUser);
+my $everyone = RT::Group->new(RT->SystemUser);
 $everyone->LoadSystemInternalGroup('Everyone');
 $everyone->PrincipalObj->GrantRight( Right =>'SuperUser' );
 
@@ -22,13 +22,13 @@ is (__PACKAGE__, 'main', "We're operating in the main package");
 
 {
     no warnings qw/redefine/;
-    sub RT::Action::SendEmail::SendMessage {
+    *RT::Action::SendEmail::SendMessage = sub {
         my $self = shift;
         my $MIME = shift;
 
         main::_fired_scrip($self->ScripObj);
         main::is(ref($MIME) , 'MIME::Entity', "hey, look. it's a mime entity");
-    }
+    };
 }
 
 # some utils
@@ -52,7 +52,7 @@ use RT::Interface::Email;
 my %args =        (message => $content, queue => 1, action => 'correspond');
 my ($status, $msg) = RT::Interface::Email::Gateway(\%args);
 ok($status, "successfuly used Email::Gateway interface") or diag("error: $msg");
-my $tickets = RT::Tickets->new($RT::SystemUser);
+my $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
 my $tick= $tickets->First();
@@ -79,10 +79,10 @@ Foob!');
                                   
 use Data::Dumper;
 
-my $ticket = RT::Ticket->new($RT::SystemUser);
+my $ticket = RT::Ticket->new(RT->SystemUser);
 my  ($id,  undef, $create_msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
 ok ($id,$create_msg);
-$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
  $tick = $tickets->First();
@@ -115,7 +115,7 @@ use RT::Interface::Email;
                            
  %args =        (message => $content, queue => 1, action => 'correspond');
  RT::Interface::Email::Gateway(\%args);
- $tickets = RT::Tickets->new($RT::SystemUser);
+ $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
  $tick = $tickets->First();
@@ -157,7 +157,7 @@ use RT::Interface::Email;
                                   
  %args =        (message => $content, queue => 1, action => 'correspond');
  RT::Interface::Email::Gateway(\%args);
-$tickets = RT::Tickets->new($RT::SystemUser);
+$tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
  $tick = $tickets->First();
@@ -192,8 +192,7 @@ sub _fired_scrip {
 
 sub utf8_redef_sendmessage {
     no warnings qw/redefine/;
-    eval ' 
-    sub RT::Action::SendEmail::SendMessage {
+    *RT::Action::SendEmail::SendMessage = sub {
         my $self = shift;
         my $MIME = shift;
 
@@ -201,26 +200,25 @@ sub utf8_redef_sendmessage {
         ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
         main::_fired_scrip($self->ScripObj);
         $MIME->make_singlepart;
-        main::is( ref($MIME) , \'MIME::Entity\',
-                  "hey, look. it\'s a mime entity" );
-        main::is( ref( $MIME->head ) , \'MIME::Head\',
+        main::is( ref($MIME) , 'MIME::Entity',
+                  "hey, look. it's a mime entity" );
+        main::is( ref( $MIME->head ) , 'MIME::Head',
                   "its mime header is a mime header. yay" );
-        main::like( $MIME->head->get(\'Content-Type\') , qr/utf-8/,
+        main::like( $MIME->head->get('Content-Type') , qr/utf-8/,
                   "Its content type is utf-8" );
         my $message_as_string = $MIME->bodyhandle->as_string();
         use Encode;
         $message_as_string = Encode::decode_utf8($message_as_string);
         main::like(
             $message_as_string , qr/H\x{e5}vard/,
-"The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
+"The message's content contains havard's name. this will fail if it's not utf8 out");
 
-    }';
+    };
 }
 
 sub iso8859_redef_sendmessage {
     no warnings qw/redefine/;
-    eval ' 
-    sub RT::Action::SendEmail::SendMessage {
+    *RT::Action::SendEmail::SendMessage = sub {
         my $self = shift;
         my $MIME = shift;
 
@@ -228,22 +226,20 @@ sub iso8859_redef_sendmessage {
         ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
         main::_fired_scrip($self->ScripObj);
         $MIME->make_singlepart;
-        main::is( ref($MIME) , \'MIME::Entity\',
-                  "hey, look. it\'s a mime entity" );
-        main::is( ref( $MIME->head ) , \'MIME::Head\',
+        main::is( ref($MIME) , 'MIME::Entity',
+                  "hey, look. it's a mime entity" );
+        main::is( ref( $MIME->head ) , 'MIME::Head',
                   "its mime header is a mime header. yay" );
-        main::like( $MIME->head->get(\'Content-Type\') , qr/iso-8859-1/,
+        main::like( $MIME->head->get('Content-Type') , qr/iso-8859-1/,
                   "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
         my $message_as_string = $MIME->bodyhandle->as_string();
         use Encode;
         $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
         main::like(
-            $message_as_string , qr/H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
-
-    }';
+            $message_as_string , qr/H\x{e5}vard/, "The message's content contains havard's name. this will fail if it's not utf8 out");
+    };
 }
 
-# {{{ test a multipart alternative containing a text-html part with an umlaut
 
  my $alt_umlaut_email = RT::Test::get_relocatable_file(
      'multipart-alternative-with-umlaut', (File::Spec->updir(), 'data', 'emails'));
@@ -260,7 +256,7 @@ $parser->ParseMIMEEntityFromScalar($content);
     %args = (message => $content, queue => 1, action => 'correspond');
     RT::Interface::Email::Gateway(\%args);
     # TODO: following 5 lines should replaced by get_latest_ticket_ok()
-    $tickets = RT::Tickets->new($RT::SystemUser);
+    $tickets = RT::Tickets->new(RT->SystemUser);
     $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
     $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
     $tick = $tickets->First();
@@ -272,9 +268,7 @@ $parser->ParseMIMEEntityFromScalar($content);
 
 }
 
-# }}}
 
-# {{{ test a text-html message with an umlaut
  my $text_html_email = RT::Test::get_relocatable_file('text-html-with-umlaut',
      (File::Spec->updir(), 'data', 'emails'));
  $content =  RT::Test->file_content($text_html_email);
@@ -287,7 +281,7 @@ $parser->ParseMIMEEntityFromScalar($content);
 
  %args =        (message => $content, queue => 1, action => 'correspond');
  RT::Interface::Email::Gateway(\%args);
- $tickets = RT::Tickets->new($RT::SystemUser);
+ $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
  $tick = $tickets->First();
@@ -299,32 +293,54 @@ is (count_attachs($tick), 1 , "Has one attachment, presumably a text-html and a
 
 sub text_html_redef_sendmessage {
     no warnings qw/redefine/;
-    eval 'sub RT::Action::SendEmail::SendMessage { 
-                my $self = shift;
-                my $MIME = shift;
-                return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
-                is ($MIME->parts, 0, "generated correspondence mime entity
-                        does not have parts");
-                is ($MIME->head->mime_type , "text/plain", "The mime type is a plain");
-         }';
+    *RT::Action::SendEmail::SendMessage = sub {
+        my $self = shift;
+        my $MIME = shift;
+        return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+        is ($MIME->parts, 0, "generated correspondence mime entity
+                does not have parts");
+        is ($MIME->head->mime_type , "text/plain", "The mime type is a plain");
+    };
 }
 
-# }}}
 
-# {{{ test a text-html message with russian characters
  my $russian_email = RT::Test::get_relocatable_file('text-html-in-russian',
      (File::Spec->updir(), 'data', 'emails'));
  $content =  RT::Test->file_content($russian_email);
 
 $parser->ParseMIMEEntityFromScalar($content);
 
-
 # be as much like the mail gateway as possible.
 &text_html_redef_sendmessage;
 
  %args =        (message => $content, queue => 1, action => 'correspond');
- RT::Interface::Email::Gateway(\%args);
- $tickets = RT::Tickets->new($RT::SystemUser);
+
+{
+
+my @warnings;
+local $SIG{__WARN__} = sub {
+    push @warnings, "@_";
+};
+
+RT::Interface::Email::Gateway(\%args);
+
+TODO: {
+        local $TODO =
+'need a better approach of encoding converter, should be fixed in 4.2';
+ok( @warnings == 1 || @warnings == 2, "1 or 2 warnings are ok" );
+ok( @warnings == 1 || ( @warnings == 2 && $warnings[1] eq $warnings[0] ),
+    'if there are 2 warnings, they should be same' );
+
+like(
+    $warnings[0],
+    qr/\QEncoding error: "\x{041f}" does not map to iso-8859-1/,
+"The badly formed Russian spam we have isn't actually well-formed UTF8, which makes Encode (correctly) warn",
+);
+
+}
+}
+
+ $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
  $tick = $tickets->First();
@@ -334,9 +350,7 @@ like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the conten
 
 is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-html and a multipart alternative");
 
-# }}}
 
-# {{{ test a message containing a russian subject and NO content type
 
 RT->Config->Set( EmailInputEncodings => 'koi8-r', RT->Config->Get('EmailInputEncodings') );
 RT->Config->Set( EmailOutputEncoding => 'koi8-r' );
@@ -351,7 +365,7 @@ $parser->ParseMIMEEntityFromScalar($content);
 &text_plain_russian_redef_sendmessage;
  %args =        (message => $content, queue => 1, action => 'correspond');
  RT::Interface::Email::Gateway(\%args);
- $tickets = RT::Tickets->new($RT::SystemUser);
+ $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
 $tick= $tickets->First();
@@ -362,26 +376,23 @@ is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-plain");
 is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right");
 sub text_plain_russian_redef_sendmessage {
     no warnings qw/redefine/;
-    eval 'sub RT::Action::SendEmail::SendMessage { 
-                my $self = shift; 
-                my $MIME = shift; 
-                return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
-                is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
-                 my $subject  = $MIME->head->get("subject");
-                chomp($subject);
-                #is( $subject ,      /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
-                };
-                 ';
+    *RT::Action::SendEmail::SendMessage = sub {
+        my $self = shift; 
+        my $MIME = shift; 
+        return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+        is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
+            my $subject  = $MIME->head->get("subject");
+        chomp($subject);
+        #is( $subject ,      /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
+    };
 }
 
 my @input_encodings = RT->Config->Get( 'EmailInputEncodings' );
 shift @input_encodings;
 RT->Config->Set(EmailInputEncodings => @input_encodings );
 RT->Config->Set(EmailOutputEncoding => 'utf-8');
-# }}}
 
 
-# {{{ test a message containing a nested RFC 822 message
 
 my $nested_rfc822_email = RT::Test::get_relocatable_file('nested-rfc-822',
     (File::Spec->updir(), 'data', 'emails'));
@@ -395,7 +406,7 @@ $parser->ParseMIMEEntityFromScalar($content);
 &text_plain_nested_redef_sendmessage;
  %args =        (message => $content, queue => 1, action => 'correspond');
  RT::Interface::Email::Gateway(\%args);
- $tickets = RT::Tickets->new($RT::SystemUser);
+ $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
 $tick= $tickets->First();
@@ -405,24 +416,28 @@ like (first_attach($tick)->ContentType , qr/multipart\/mixed/, "We recorded the
 is (count_attachs($tick) , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
 sub text_plain_nested_redef_sendmessage {
     no warnings qw/redefine/;
-    eval 'sub RT::Action::SendEmail::SendMessage { 
-                my $self = shift; 
-                my $MIME = shift; 
-                return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
-                is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
-                 my $subject  =  $MIME->head->get("subject");
-                 $subject  = MIME::Base64::decode_base64( $subject);
-                chomp($subject);
-                # TODO, why does this test fail
-                #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
-                1;
-                 }';
+    *RT::Action::SendEmail::SendMessage = sub {
+        my $self = shift;
+        my $MIME = shift;
+
+        return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
+
+        is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
+
+        use MIME::Words qw(:all);
+        my $encoded_subject = $MIME->head->get("subject");
+        my $subject = decode_mimewords($encoded_subject);
+
+        # MIME::Words isn't actually UTF8-safe. There go 4 hours I'll never get back.
+        utf8::decode($subject);
+        like($subject, qr/Niv\x{e5}er/, "The subject matches the word - $subject");
+
+        1;
+    };
 }
 
-# }}}
 
 
-# {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
 
  my $uuencoded_email = RT::Test::get_relocatable_file('notes-uuencoded',
      (File::Spec->updir(), 'data', 'emails'));
@@ -437,7 +452,7 @@ $parser->ParseMIMEEntityFromScalar($content);
     local *RT::Action::SendEmail::SendMessage = sub { return 1};
     %args =        (message => $content, queue => 1, action => 'correspond');
     RT::Interface::Email::Gateway(\%args);
-    $tickets = RT::Tickets->new($RT::SystemUser);
+    $tickets = RT::Tickets->new(RT->SystemUser);
     $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
     $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
     $tick= $tickets->First();
@@ -447,9 +462,7 @@ $parser->ParseMIMEEntityFromScalar($content);
     is (count_attachs($tick) , 3 , "Has three attachments");
 }
 
-# }}}
 
-# {{{ test a multipart that crashes the file-based mime-parser works
 
  my $crashes_file_based_parser_email = RT::Test::get_relocatable_file(
      'crashes-file-based-parser', (File::Spec->updir(), 'data', 'emails'));
@@ -464,7 +477,7 @@ no warnings qw/redefine/;
 local *RT::Action::SendEmail::SendMessage = sub { return 1};
  %args =        (message => $content, queue => 1, action => 'correspond');
  RT::Interface::Email::Gateway(\%args);
- $tickets = RT::Tickets->new($RT::SystemUser);
+ $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
 $tick= $tickets->First();
@@ -476,9 +489,7 @@ is (count_attachs($tick) , 5 , "Has three attachments");
 
 
 
-# }}}
 
-# {{{ test a multi-line RT-Send-CC header
 
  my $rt_send_cc_email = RT::Test::get_relocatable_file('rt-send-cc',
      (File::Spec->updir(), 'data', 'emails'));
@@ -490,7 +501,7 @@ $parser->ParseMIMEEntityFromScalar($content);
 
  %args =        (message => $content, queue => 1, action => 'correspond');
  RT::Interface::Email::Gateway(\%args);
- $tickets = RT::Tickets->new($RT::SystemUser);
+ $tickets = RT::Tickets->new(RT->SystemUser);
 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
 $tick= $tickets->First();
@@ -503,9 +514,8 @@ like ($cc , qr/test3/, "Found test 3");
 like ($cc , qr/test4/, "Found test 4");
 like ($cc , qr/test5/, "Found test 5");
 
-# }}}
 
-diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
+diag q{regression test for #5248 from rt3.fsck.com};
 {
     my $subject_folding_email = RT::Test::get_relocatable_file(
         'subject-with-folding-ws', (File::Spec->updir(), 'data', 'emails'));
@@ -518,7 +528,7 @@ diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
     is ($ticket->Subject, 'test', 'correct subject');
 }
 
-diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
+diag q{regression test for #5248 from rt3.fsck.com};
 {
     my $long_subject_email = RT::Test::get_relocatable_file('very-long-subject',
         (File::Spec->updir(), 'data', 'emails'));
@@ -535,4 +545,3 @@ diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
 
 # Don't taint the environment
 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');
-1;