annotate Lib/IMPL/Mailer.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +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;