|
100
|
1 package IMPL::Mailer;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use Encode qw (encode);
|
|
|
5 use Encode::MIME::Header;
|
|
|
6 use MIME::Base64 qw(encode_base64);
|
|
|
7 use Email::Simple;
|
|
|
8
|
|
|
9 our $SENDMAIL;
|
|
|
10
|
|
|
11 sub DeliverMessage {
|
|
|
12 my $message = shift;
|
|
|
13
|
|
|
14 $message = shift if $message eq __PACKAGE__ or ref $message eq __PACKAGE__;
|
|
|
15
|
|
|
16 my $email = new Email::Simple($message);
|
|
|
17
|
|
|
18 $email->header_set('Content-Transfer-Encoding' => 'base64');
|
|
|
19 $email->header_set('MIME-Version' => '1.0') if !$email->header('MIME-Version');
|
|
|
20 $email->header_set('Content-Type' => 'text/plain; charset="utf-8"');
|
|
|
21 my $raw = $email->body();
|
|
|
22 utf8::encode($raw) if utf8::is_utf8($raw);
|
|
|
23 $email->body_set(encode_base64($raw));
|
|
|
24
|
|
|
25 foreach my $field ($email->header_names()) {
|
|
|
26 $email->header_set($field, map { encode('MIME-Header', utf8::is_utf8($_) ? $_ : Encode::decode('utf-8',$_) ) } $email->header($field) );
|
|
|
27 }
|
|
|
28
|
|
|
29 return SendMail($email,@_);
|
|
|
30 }
|
|
|
31
|
|
|
32 sub _find_sendmail {
|
|
|
33 return $SENDMAIL if defined $SENDMAIL;
|
|
|
34
|
|
|
35 my @path = split /:/, $ENV{PATH};
|
|
|
36 my $sendmail;
|
|
|
37 for (@path) {
|
|
|
38 if ( -x "$_/sendmail" ) {
|
|
|
39 $sendmail = "$_/sendmail";
|
|
|
40 last;
|
|
|
41 }
|
|
|
42 }
|
|
|
43 return $sendmail;
|
|
|
44 }
|
|
|
45
|
|
|
46 sub SendMail {
|
|
|
47 my ($message, %args) = @_;
|
|
|
48 my $mailer = _find_sendmail;
|
|
|
49
|
|
|
50 local *SENDMAIL;
|
|
|
51 if( $args{'TestFile'} ) {
|
|
|
52 open SENDMAIL, '>', $args{TestFile} or die "Failed to open $args{TestFile}: $!";
|
|
|
53 binmode(SENDMAIL);
|
|
|
54 print SENDMAIL "X-SendMail-Cmd: sendmail ",join(' ',%args),"\n";
|
|
|
55 } else {
|
|
|
56 my @args = %args;
|
|
|
57 die "sendmail not found" unless $mailer;
|
|
|
58 die "Found $mailer but cannot execute it"
|
|
|
59 unless -x $mailer;
|
|
|
60 open SENDMAIL, "| $mailer -t -oi @args"
|
|
|
61 or die "Error executing $mailer: $!";
|
|
|
62 }
|
|
|
63 print SENDMAIL $message->as_string
|
|
|
64 or die "Error printing via pipe to $mailer: $!";
|
|
|
65 close SENDMAIL;
|
|
|
66 return 1;
|
|
|
67 }
|
|
|
68
|
|
|
69 1;
|
