annotate Lib/Mailer.pm @ 33:0004faa276dc

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