view Lib/Mailer.pm @ 126:c8dfbbdd8005

Several bug fixes Forms support pre-alfa version
author wizard
date Fri, 11 Jun 2010 04:29:51 +0400
parents 16ada169ca75
children 06a34c197b05
line wrap: on
line source

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;