view Lib/IMPL/Mailer.pm @ 194:4d0e1962161c

Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents aaab45153411
children
line wrap: on
line source

package IMPL::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;