Mercurial > pub > Impl

comparison lib/IMPL/Mailer.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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;