diff Lib/Mailer.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/Mailer.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,69 @@
+package Mailer;
+use strict;
+
+use Encode qw (encode);
+use Encode::MIME::Header;
+use MIME::Base64 qw(encode_base64);
+use Email::Simple;
+
+our $SENDMAIL;
+
+sub DeliverMessage {
+    my $message = shift;
+    
+    $message = shift if $message eq __PACKAGE__ or ref $message eq __PACKAGE__;
+    
+    my $email = new Email::Simple($message);
+    
+    $email->header_set('Content-Transfer-Encoding' => 'base64');
+    $email->header_set('MIME-Version' => '1.0') if !$email->header('MIME-Version');
+    $email->header_set('Content-Type' => 'text/plain; charset="utf-8"');
+    my $raw = $email->body();
+    utf8::encode($raw) if utf8::is_utf8($raw);
+    $email->body_set(encode_base64($raw));
+    
+    foreach my $field ($email->header_names()) {
+        $email->header_set($field, map { encode('MIME-Header', utf8::is_utf8($_) ? $_ : Encode::decode('utf-8',$_) ) } $email->header($field) );
+    }
+    
+    return SendMail($email,@_);
+}
+
+sub _find_sendmail {
+    return $SENDMAIL if defined $SENDMAIL;
+
+    my @path = split /:/, $ENV{PATH};
+    my $sendmail;
+    for (@path) {
+        if ( -x "$_/sendmail" ) {
+            $sendmail = "$_/sendmail";
+            last;
+        }
+    }
+    return $sendmail;
+}
+
+sub SendMail {
+    my ($message, %args) = @_;
+    my $mailer = _find_sendmail;
+    
+    local *SENDMAIL;
+    if( $args{'TestFile'} ) {
+        open SENDMAIL, '>', $args{TestFile} or die "Failed to open $args{TestFile}: $!";
+        binmode(SENDMAIL);
+        print SENDMAIL "X-SendMail-Cmd: sendmail ",join(' ',%args),"\n";
+    } else {
+        my @args = %args;
+        die "sendmail not found" unless $mailer;
+        die "Found $mailer but cannot execute it"
+        unless -x $mailer;
+        open SENDMAIL, "| $mailer -t -oi @args"
+            or die "Error executing $mailer: $!";
+    }
+    print SENDMAIL $message->as_string
+        or die "Error printing via pipe to $mailer: $!";
+    close SENDMAIL;
+    return 1;
+}
+
+1;
\ No newline at end of file