rt/lib/RT/Action/SendEmail.pm

   1 # {{{ BEGIN BPS TAGGED BLOCK
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26 #
  27 #
  28 # CONTRIBUTION SUBMISSION POLICY:
  29 #
  30 # (The following paragraph is not intended to limit the rights granted
  31 # to you to modify and distribute this software under the terms of
  32 # the GNU General Public License and is only of importance to you if
  33 # you choose to contribute your changes and enhancements to the
  34 # community by submitting them to Best Practical Solutions, LLC.)
  35 #
  36 # By intentionally submitting any modifications, corrections or
  37 # derivatives to this work, or any other work intended for use with
  38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  39 # you are the copyright holder for those contributions and you grant
  40 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  41 # royalty-free, perpetual, license to use, copy, create derivative
  42 # works based on those contributions, and sublicense and distribute
  43 # those contributions and any derivatives thereof.
  44 #
  45 # }}} END BPS TAGGED BLOCK
  46 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
  47
  48 package RT::Action::SendEmail;
  49 require RT::Action::Generic;
  50
  51 use strict;
  52 use vars qw/@ISA/;
  53 @ISA = qw(RT::Action::Generic);
  54
  55 use MIME::Words qw(encode_mimeword);
  56
  57 use RT::EmailParser;
  58 use Mail::Address;
  59
  60 =head1 NAME
  61
  62 RT::Action::SendEmail - An Action which users can use to send mail
  63 or can subclassed for more specialized mail sending behavior.
  64 RT::Action::AutoReply is a good example subclass.
  65
  66 =head1 SYNOPSIS
  67
  68   require RT::Action::SendEmail;
  69   @ISA  = qw(RT::Action::SendEmail);
  70
  71
  72 =head1 DESCRIPTION
  73
  74 Basically, you create another module RT::Action::YourAction which ISA
  75 RT::Action::SendEmail.
  76
  77 =begin testing
  78
  79 ok (require RT::Action::SendEmail);
  80
  81 =end testing
  82
  83
  84 =head1 AUTHOR
  85
  86 Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>
  87
  88 =head1 SEE ALSO
  89
  90 perl(1).
  91
  92 =cut
  93
  94 # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)
  95
  96
  97 # {{{ sub Commit
  98
  99 sub Commit {
 100     my $self = shift;
 101
 102     return($self->SendMessage($self->TemplateObj->MIMEObj));
 103 }
 104
 105 # }}}
 106
 107 # {{{ sub Prepare
 108
 109 sub Prepare {
 110     my $self = shift;
 111
 112     my ( $result, $message ) = $self->TemplateObj->Parse(
 113         Argument       => $self->Argument,
 114         TicketObj      => $self->TicketObj,
 115         TransactionObj => $self->TransactionObj
 116     );
 117     if ( !$result ) {
 118         return (undef);
 119     }
 120
 121     my $MIMEObj = $self->TemplateObj->MIMEObj;
 122
 123     # Header
 124     $self->SetRTSpecialHeaders();
 125
 126     $self->RemoveInappropriateRecipients();
 127
 128     # Go add all the Tos, Ccs and Bccs that we need to to the message to
 129     # make it happy, but only if we actually have values in those arrays.
 130
 131     # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
 132
 133     $self->SetHeader( 'To', join ( ', ', @{ $self->{'To'} } ) )
 134       if ( ! $MIMEObj->head->get('To') &&  $self->{'To'} && @{ $self->{'To'} } );
 135     $self->SetHeader( 'Cc', join ( ', ', @{ $self->{'Cc'} } ) )
 136       if ( !$MIMEObj->head->get('Cc') && $self->{'Cc'} && @{ $self->{'Cc'} } );
 137     $self->SetHeader( 'Bcc', join ( ', ', @{ $self->{'Bcc'} } ) )
 138       if ( !$MIMEObj->head->get('Bcc') && $self->{'Bcc'} && @{ $self->{'Bcc'} } );
 139
 140     # PseudoTo  (fake to headers) shouldn't get matched for message recipients.
 141     # If we don't have any 'To' header (but do have other recipients), drop in
 142     # the pseudo-to header.
 143     $self->SetHeader( 'To', join ( ', ', @{ $self->{'PseudoTo'} } ) )
 144       if ( $self->{'PseudoTo'} && ( @{ $self->{'PseudoTo'} } )
 145         and ( !$MIMEObj->head->get('To') ) ) and ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc'));
 146
 147     # We should never have to set the MIME-Version header
 148     $self->SetHeader( 'MIME-Version', '1.0' );
 149
 150     # try to convert message body from utf-8 to $RT::EmailOutputEncoding
 151     $self->SetHeader( 'Content-Type', 'text/plain; charset="utf-8"' );
 152
 153     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding,
 154         'mime_words_ok' );
 155     $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' );
 156
 157     # Build up a MIME::Entity that looks like the original message.
 158     $self->AddAttachments() if ( $MIMEObj->head->get('RT-Attach-Message') );
 159
 160     return $result;
 161
 162 }
 163
 164 # }}}
 165
 166 # }}}
 167
 168
 169
 170 =head2 To
 171
 172 Returns an array of Mail::Address objects containing all the To: recipients for this notification
 173
 174 =cut
 175
 176 sub To {
 177     my $self = shift;
 178     return ($self->_AddressesFromHeader('To'));
 179 }
 180
 181 =head2 Cc
 182
 183 Returns an array of Mail::Address objects containing all the Cc: recipients for this notification
 184
 185 =cut
 186
 187 sub Cc {
 188     my $self = shift;
 189     return ($self->_AddressesFromHeader('Cc'));
 190 }
 191
 192 =head2 Bcc
 193
 194 Returns an array of Mail::Address objects containing all the Bcc: recipients for this notification
 195
 196 =cut
 197
 198
 199 sub Bcc {
 200     my $self = shift;
 201     return ($self->_AddressesFromHeader('Bcc'));
 202
 203 }
 204
 205 sub _AddressesFromHeader  {
 206     my $self = shift;
 207     my $field = shift;
 208     my $header = $self->TemplateObj->MIMEObj->head->get($field);
 209     my @addresses = Mail::Address->parse($header);
 210
 211     return (@addresses);
 212 }
 213
 214
 215 # {{{ SendMessage
 216
 217 =head2 SendMessage MIMEObj
 218
 219 sends the message using RT's preferred API.
 220 TODO: Break this out to a separate module
 221
 222 =cut
 223
 224 sub SendMessage {
 225     my $self    = shift;
 226     my $MIMEObj = shift;
 227
 228     my $msgid = $MIMEObj->head->get('Message-Id');
 229     chomp $msgid;
 230
 231     $RT::Logger->info( $msgid . " #"
 232         . $self->TicketObj->id . "/"
 233         . $self->TransactionObj->id
 234         . " - Scrip "
 235         . $self->ScripObj->id . " "
 236         . $self->ScripObj->Description );
 237
 238     #If we don't have any recipients to send to, don't send a message;
 239     unless ( $MIMEObj->head->get('To')
 240         || $MIMEObj->head->get('Cc')
 241         || $MIMEObj->head->get('Bcc') )
 242     {
 243         $RT::Logger->info( $msgid . " No recipients found. Not sending.\n" );
 244         return (1);
 245     }
 246
 247
 248     if ( $RT::MailCommand eq 'sendmailpipe' ) {
 249         eval {
 250             open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" ) || die $!;
 251             print MAIL $MIMEObj->as_string;
 252             close(MAIL);
 253         };
 254         if ($@) {
 255             $RT::Logger->crit( $msgid . "Could not send mail. -" . $@ );
 256         }
 257     }
 258     else {
 259         my @mailer_args = ($RT::MailCommand);
 260
 261         local $ENV{MAILADDRESS};
 262
 263         if ( $RT::MailCommand eq 'sendmail' ) {
 264             push @mailer_args, split(/\s+/, $RT::SendmailArguments);
 265         }
 266         elsif ( $RT::MailCommand eq 'smtp' ) {
 267             $ENV{MAILADDRESS} = $RT::SMTPFrom || $MIMEObj->head->get('From');
 268             push @mailer_args, ( Server => $RT::SMTPServer );
 269             push @mailer_args, ( Debug  => $RT::SMTPDebug );
 270         }
 271         else {
 272             push @mailer_args, $RT::MailParams;
 273         }
 274
 275         unless ( $MIMEObj->send(@mailer_args) ) {
 276             $RT::Logger->crit( $msgid . "Could not send mail." );
 277             return (0);
 278         }
 279     }
 280
 281     my $success =
 282       ( $msgid
 283       . " sent To: "
 284       . $MIMEObj->head->get('To') . " Cc: "
 285       . $MIMEObj->head->get('Cc') . " Bcc: "
 286       . $MIMEObj->head->get('Bcc') );
 287     $success =~ s/\n//gi;
 288
 289     $self->RecordOutgoingMailTransaction($MIMEObj) if ($RT::RecordOutgoingEmail);
 290
 291     $RT::Logger->info($success);
 292
 293     return (1);
 294 }
 295
 296 # }}}
 297
 298 # {{{ AddAttachments
 299
 300 =head2 AddAttachments
 301
 302 Takes any attachments to this transaction and attaches them to the message
 303 we're building.
 304
 305 =cut
 306
 307
 308 sub AddAttachments {
 309     my $self = shift;
 310
 311     my $MIMEObj = $self->TemplateObj->MIMEObj;
 312
 313     $MIMEObj->head->delete('RT-Attach-Message');
 314
 315     my $attachments = RT::Attachments->new($RT::SystemUser);
 316     $attachments->Limit(
 317         FIELD => 'TransactionId',
 318         VALUE => $self->TransactionObj->Id
 319     );
 320     $attachments->OrderBy('id');
 321
 322     my $transaction_content_obj = $self->TransactionObj->ContentObj;
 323
 324     # attach any of this transaction's attachments
 325     while ( my $attach = $attachments->Next ) {
 326
 327         # Don't attach anything blank
 328         next unless ( $attach->ContentLength );
 329
 330 # We want to make sure that we don't include the attachment that's being sued as the "Content" of this message"
 331         next
 332           if ( $transaction_content_obj
 333             && $transaction_content_obj->Id == $attach->Id
 334             && $transaction_content_obj->ContentType =~ qr{text/plain}i );
 335         $MIMEObj->make_multipart('mixed');
 336         $MIMEObj->attach(
 337             Type     => $attach->ContentType,
 338             Charset  => $attach->OriginalEncoding,
 339             Data     => $attach->OriginalContent,
 340             Filename => $self->MIMEEncodeString( $attach->Filename,
 341                 $RT::EmailOutputEncoding ),
 342             'RT-Attachment:' => $self->TicketObj->Id."/".$self->TransactionObj->Id."/".$attach->id,
 343             Encoding => '-SUGGEST'
 344         );
 345     }
 346
 347 }
 348
 349 # }}}
 350
 351 # {{{ RecordOutgoingMailTransaction
 352
 353 =head2 RecordOutgoingMailTransaction MIMEObj
 354
 355 Record a transaction in RT with this outgoing message for future record-keeping purposes
 356
 357 =cut
 358
 359
 360
 361 sub RecordOutgoingMailTransaction {
 362     my $self = shift;
 363     my $MIMEObj = shift;
 364
 365
 366     my @parts = $MIMEObj->parts;
 367     my @attachments;
 368     my @keep;
 369     foreach my $part (@parts) {
 370         my $attach = $part->head->get('RT-Attachment');
 371         if ($attach) {
 372             $RT::Logger->debug("We found an attachment. we want to not record it.");
 373             push @attachments, $attach;
 374         } else {
 375             $RT::Logger->debug("We found a part. we want to record it.");
 376             push @keep, $part;
 377         }
 378     }
 379     $MIMEObj->parts(\@keep);
 380     foreach my $attachment (@attachments) {
 381         $MIMEObj->head->add('RT-Attachment', $attachment);
 382     }
 383
 384     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
 385
 386     my $transaction = RT::Transaction->new($self->TransactionObj->CurrentUser);
 387
 388     # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
 389
 390     my $type;
 391     if ($self->TransactionObj->Type eq 'Comment') {
 392         $type = 'CommentEmailRecord';
 393     } else {
 394         $type = 'EmailRecord';
 395     }
 396
 397
 398
 399     my ( $id, $msg ) = $transaction->Create(
 400         Ticket         => $self->TicketObj->Id,
 401         Type           => $type,
 402         Data           => $MIMEObj->head->get('Message-Id'),
 403         MIMEObj        => $MIMEObj,
 404         ActivateScrips => 0
 405     );
 406
 407
 408 }
 409
 410 # }}}
 411 #
 412
 413 # {{{ sub SetRTSpecialHeaders
 414
 415 =head2 SetRTSpecialHeaders
 416
 417 This routine adds all the random headers that RT wants in a mail message
 418 that don't matter much to anybody else.
 419
 420 =cut
 421
 422 sub SetRTSpecialHeaders {
 423     my $self = shift;
 424
 425     $self->SetSubject();
 426     $self->SetSubjectToken();
 427     $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding )
 428       if ($RT::EmailOutputEncoding);
 429     $self->SetReturnAddress();
 430
 431     # TODO: this one is broken.  What is this email really a reply to?
 432     # If it's a reply to an incoming message, we'll need to use the
 433     # actual message-id from the appropriate Attachment object.  For
 434     # incoming mails, we would like to preserve the In-Reply-To and/or
 435     # References.
 436
 437     $self->SetHeader( 'In-Reply-To',
 438         "<rt-" . $self->TicketObj->id() . "\@" . $RT::rtname . ">" );
 439
 440     # TODO We should always add References headers for all message-ids
 441     # of previous messages related to this ticket.
 442
 443     $self->SetHeader( 'Message-ID',
 444         "<rt-"
 445         . $RT::VERSION . "-"
 446         . $self->TicketObj->id() . "-"
 447         . $self->TransactionObj->id() . "-"
 448         . $self->ScripObj->Id . "."
 449         . rand(20) . "\@"
 450         . $RT::Organization . ">" )
 451       unless $self->TemplateObj->MIMEObj->head->get('Message-ID');
 452
 453     $self->SetHeader( 'Precedence', "bulk" )
 454       unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") );
 455
 456     $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname );
 457     $self->SetHeader( 'RT-Ticket',
 458         $RT::rtname . " #" . $self->TicketObj->id() );
 459     $self->SetHeader( 'Managed-by',
 460         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 461
 462     $self->SetHeader( 'RT-Originator',
 463         $self->TransactionObj->CreatorObj->EmailAddress );
 464
 465 }
 466
 467 # }}}
 468
 469
 470 # }}}
 471
 472 # {{{ RemoveInappropriateRecipients
 473
 474 =head2 RemoveInappropriateRecipients
 475
 476 Remove addresses that are RT addresses or that are on this transaction's blacklist
 477
 478 =cut
 479
 480 sub RemoveInappropriateRecipients {
 481     my $self = shift;
 482
 483     my @blacklist;
 484
 485     # Weed out any RT addresses. We really don't want to talk to ourselves!
 486     @{ $self->{'To'} } =
 487       RT::EmailParser::CullRTAddresses( "", @{ $self->{'To'} } );
 488     @{ $self->{'Cc'} } =
 489       RT::EmailParser::CullRTAddresses( "", @{ $self->{'Cc'} } );
 490     @{ $self->{'Bcc'} } =
 491       RT::EmailParser::CullRTAddresses( "", @{ $self->{'Bcc'} } );
 492
 493     # If there are no recipients, don't try to send the message.
 494     # If the transaction has content and has the header RT-Squelch-Replies-To
 495
 496     if ( defined $self->TransactionObj->Attachments->First() ) {
 497         my $squelch =
 498           $self->TransactionObj->Attachments->First->GetHeader(
 499             'RT-Squelch-Replies-To');
 500
 501         if ($squelch) {
 502             @blacklist = split ( /,/, $squelch );
 503         }
 504     }
 505
 506 # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist
 507     my @non_recipients = $self->TicketObj->SquelchMailTo;
 508     foreach my $attribute (@non_recipients) {
 509         push @blacklist, $attribute->Content;
 510     }
 511
 512     # Cycle through the people we're sending to and pull out anyone on the
 513     # system blacklist
 514
 515     foreach my $person_to_yank (@blacklist) {
 516         $person_to_yank =~ s/\s//g;
 517         @{ $self->{'To'} } = grep ( !/^$person_to_yank$/, @{ $self->{'To'} } );
 518         @{ $self->{'Cc'} } = grep ( !/^$person_to_yank$/, @{ $self->{'Cc'} } );
 519         @{ $self->{'Bcc'} } =
 520           grep ( !/^$person_to_yank$/, @{ $self->{'Bcc'} } );
 521     }
 522 }
 523
 524 # }}}
 525 # {{{ sub SetReturnAddress
 526
 527 =head2 SetReturnAddress is_comment => BOOLEAN
 528
 529 Calculate and set From and Reply-To headers based on the is_comment flag.
 530
 531 =cut
 532
 533 sub SetReturnAddress {
 534
 535     my $self = shift;
 536     my %args = (
 537         is_comment => 0,
 538         @_
 539     );
 540
 541     # From and Reply-To
 542     # $args{is_comment} should be set if the comment address is to be used.
 543     my $replyto;
 544
 545     if ( $args{'is_comment'} ) {
 546         $replyto = $self->TicketObj->QueueObj->CommentAddress
 547           || $RT::CommentAddress;
 548     }
 549     else {
 550         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
 551           || $RT::CorrespondAddress;
 552     }
 553
 554     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
 555         if ($RT::UseFriendlyFromLine) {
 556             my $friendly_name = $self->TransactionObj->CreatorObj->RealName;
 557             if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 558                 $friendly_name = $1;
 559             }
 560
 561             $friendly_name =~ s/"/\\"/g;
 562             $self->SetHeader(
 563                 'From',
 564                 sprintf(
 565                     $RT::FriendlyFromLineFormat,
 566                     $self->MIMEEncodeString( $friendly_name,
 567                         $RT::EmailOutputEncoding ),
 568                     $replyto
 569                 ),
 570             );
 571         }
 572         else {
 573             $self->SetHeader( 'From', $replyto );
 574         }
 575     }
 576
 577     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
 578         $self->SetHeader( 'Reply-To', "$replyto" );
 579     }
 580
 581 }
 582
 583 # }}}
 584
 585 # {{{ sub SetHeader
 586
 587 =head2 SetHeader FIELD, VALUE
 588
 589 Set the FIELD of the current MIME object into VALUE.
 590
 591 =cut
 592
 593 sub SetHeader {
 594     my $self  = shift;
 595     my $field = shift;
 596     my $val   = shift;
 597
 598     chomp $val;
 599     chomp $field;
 600     $self->TemplateObj->MIMEObj->head->fold_length( $field, 10000 );
 601     $self->TemplateObj->MIMEObj->head->replace( $field,     $val );
 602     return $self->TemplateObj->MIMEObj->head->get($field);
 603 }
 604
 605 # }}}
 606
 607
 608 # {{{ sub SetSubject
 609
 610 =head2 SetSubject
 611
 612 This routine sets the subject. it does not add the rt tag. that gets done elsewhere
 613 If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get
 614 the transaction's subject.
 615
 616 =cut
 617
 618 sub SetSubject {
 619     my $self = shift;
 620     my $subject;
 621
 622     my $message = $self->TransactionObj->Attachments;
 623     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
 624         return ();
 625     }
 626     if ( $self->{'Subject'} ) {
 627         $subject = $self->{'Subject'};
 628     }
 629     elsif ( ( $message->First() ) && ( $message->First->Headers ) ) {
 630         my $header = $message->First->Headers();
 631         $header =~ s/\n\s+/ /g;
 632         if ( $header =~ /^Subject: (.*?)$/m ) {
 633             $subject = $1;
 634         }
 635         else {
 636             $subject = $self->TicketObj->Subject();
 637         }
 638
 639     }
 640     else {
 641         $subject = $self->TicketObj->Subject();
 642     }
 643
 644     $subject =~ s/(\r\n|\n|\s)/ /gi;
 645
 646     chomp $subject;
 647     $self->SetHeader( 'Subject', $subject );
 648
 649 }
 650
 651 # }}}
 652
 653 # {{{ sub SetSubjectToken
 654
 655 =head2 SetSubjectToken
 656
 657 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 658
 659 =cut
 660
 661 sub SetSubjectToken {
 662     my $self = shift;
 663     my $tag  = "[$RT::rtname #" . $self->TicketObj->id . "]";
 664     my $sub  = $self->TemplateObj->MIMEObj->head->get('Subject');
 665     unless ( $sub =~ /\Q$tag\E/ ) {
 666         $sub =~ s/(\r\n|\n|\s)/ /gi;
 667         chomp $sub;
 668         $self->TemplateObj->MIMEObj->head->replace( 'Subject', "$tag $sub" );
 669     }
 670 }
 671
 672 # }}}
 673
 674 # }}}
 675
 676 # {{{ SetHeadingAsEncoding
 677
 678 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
 679
 680 This routine converts the field into specified charset encoding.
 681
 682 =cut
 683
 684 sub SetHeaderAsEncoding {
 685     my $self = shift;
 686     my ( $field, $enc ) = ( shift, shift );
 687
 688     if ($field eq 'From' and $RT::SMTPFrom) {
 689         $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom );
 690         return;
 691     }
 692
 693     my $value = $self->TemplateObj->MIMEObj->head->get($field);
 694
 695     # don't bother if it's us-ascii
 696
 697     # See RT::I18N, 'NOTES:  Why Encode::_utf8_off before Encode::from_to'
 698
 699     $value =  $self->MIMEEncodeString($value, $enc);
 700
 701     $self->TemplateObj->MIMEObj->head->replace( $field, $value );
 702
 703
 704 }
 705 # }}}
 706
 707 # {{{ MIMEEncodeString
 708
 709 =head2 MIMEEncodeString STRING ENCODING
 710
 711 Takes a string and a possible encoding and returns the string wrapped in MIME goo.
 712
 713 =cut
 714
 715 sub MIMEEncodeString {
 716     my  $self = shift;
 717     my $value = shift;
 718     # using RFC2047 notation, sec 2.
 719     # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
 720     my $charset = shift;
 721     my $encoding = 'B';
 722     # An 'encoded-word' may not be more than 75 characters long
 723     #
 724     # MIME encoding increases 4/3*(number of bytes), and always in multiples
 725     # of 4. Thus we have to find the best available value of bytes available
 726     # for each chunk.
 727     #
 728     # First we get the integer max which max*4/3 would fit on space.
 729     # Then we find the greater multiple of 3 lower or equal than $max.
 730     my $max = int(((75-length('=?'.$charset.'?'.$encoding.'?'.'?='))*3)/4);
 731     $max = int($max/3)*3;
 732
 733     chomp $value;
 734     return ($value) unless $value =~ /[^\x20-\x7e]/;
 735
 736     $value =~ s/\s*$//;
 737     Encode::_utf8_off($value);
 738     my $res = Encode::from_to( $value, "utf-8", $charset );
 739
 740     if ($max > 0) {
 741       # copy value and split in chuncks
 742       my $str=$value;
 743       my @chunks = unpack("a$max" x int(length($str)/$max
 744                                   + ((length($str) % $max) ? 1:0)), $str);
 745       # encode an join chuncks
 746       $value = join " ",
 747                      map encode_mimeword( $_, $encoding, $charset ), @chunks ;
 748       return($value);
 749     } else {
 750       # gives an error...
 751       $RT::Logger->crit("Can't encode! Charset or encoding too big.\n");
 752     }
 753 }
 754
 755 # }}}
 756
 757 eval "require RT::Action::SendEmail_Vendor";
 758 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm});
 759 eval "require RT::Action::SendEmail_Local";
 760 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm});
 761
 762 1;
 763