annotate lib/IMPL/Mailer.pm @ 418:3f38dabaf5cc ref20150831

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