annotate Lib/IMPL/Mailer.pm @ 215:77a9934a44af

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