File Coverage

blib/lib/PHP/Functions/Mail.pm

Criterion	Covered	Total	%
statement	18	102	17.6
branch	0	28	0.0
condition			n/a
subroutine	6	9	66.6
pod	2	3	66.6
total	26	142	18.3

package PHP::Functions::Mail;

use strict;

use vars qw(@ISA @EXPORT_OK $VERSION);

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(mail mb_send_mail);
$VERSION = '0.04';

use Carp qw(carp croak);
use Net::SMTP;

sub mail {
    my $to = shift;
    my $subject = shift;
    my $body = shift;
    my $headers = shift;
    my $options = shift;

    eval {
	my $option = $options->{NetSmtpOption} ? $options->{NetSmtpOption} : undef;
	my $host = $options->{Host} ? $options->{Host} : 'localhost';
	my $smtp = Net::SMTP->new($host);

	my $send_header;
	my $in_subject = 0;
	my $in_from = 0;

	#From head check
	foreach my $header (split("\n", $headers)) {
	    unless ($header =~ /^([^:]+):(.+)$/) {
		next;
	    }
	    my $name = $1;
	    my $value = $2;
	    my $ns_value = $value;
	    $ns_value =~ s/\s/ /g;
	    $ns_value =~ s|\=\?ISO-2022-JP\?B\?.*?\?\=||g;

	    if (uc($name) eq 'FROM') {
		$smtp->mail(split(",", $ns_value));
		$in_from = 1;
	    }
	    $in_subject = 1 if uc($name) eq 'SUBJECT';
	}
	unless ($in_from) {
	    croak "no From header";
	    return 1;
	}

	$send_header .= "To: $to\n";
	$send_header .= "Subject: $subject\n"unless $in_subject;
	$smtp->to($to);

	$headers =~ s/\n\t/\t/mg;
	foreach my $header (split("\n", $headers)) {
	    unless ($header =~ /^([^:]+):(.+)$/) {
		carp "header format error: $header";
		next;
	    }
	    my $name = $1;
	    my $value = $2;
	    my $ns_value = $value;
	    $ns_value =~ s/\s/ /g;
	    $ns_value =~ s|\=\?ISO-2022-JP\?B\?.*?\?\=||ig;
	    $smtp->to(split(",", $ns_value)) if uc($name) eq 'TO';
	    $smtp->cc(split(",", $ns_value)) if uc($name) eq 'CC';
	    $smtp->bcc(split(",", $ns_value)) if uc($name) eq 'BCC';
	    $value =~ s/\t/\n\t/g;
	    $send_header .= "$name:$value\n";
	}
	$smtp->data;
	$body =~ s/\n\r/\n/g;
	$smtp->datasend("$send_header\n$body");
	$smtp->dataend;
	$smtp->quit;
    };
    croak "mail error: $@" if $@;

    return 0;
}

sub mb_send_mail {
    my $to = shift;
    my $subject = shift;
    my $body = shift;
    my $headers = shift;
    my $options = shift;
    use Jcode;

    my $send_header;
    $headers =~ s/\n\t/\t/mg;
    foreach my $header (split("\n", $headers)) {
	unless ($header =~ /^([^:]+):(.+)$/) {
	    carp "header format error: $header";
	    next;
	}
	my $name  = $1;
	my $value = $2;
	my $len   = 76 - (length($name) + 1);
	$len = 32 if $len < 32;
	$send_header .= "$name:" . mime_encode($value, $len) . "\n";
    }
    $send_header .= "Content-type: text/plain; charset=iso-2022-jp\n";

    mail(mime_encode($to, 72),
	 mime_encode($subject, 66),
	 Jcode->new($body)->iso_2022_jp,
	 $send_header,
	 $options);
}

sub mime_encode {
    use Jcode;
    my $str = Jcode->new(shift)->euc;
    my $len = shift;

    $str =~ s/([\x80-\xff]+)/Jcode->new($1)->mime_encode("\n", $len)/eg;
    $str =~ s/\n /\n\t/g;

    $str =~ s|(\=\?ISO-2022-JP\?B\?)|\n$1|ig;
    $str =~ s|(\?\=)|$1\n|ig;

    $str =~ s/^\s+//m;
    $str =~ s/\s+$//m;

    $str =~ s/\n\n/\n/gm;
    $str =~ s/\n\t\n/\n/gm;
    $str =~ s/\n/\n\t/gm;
    $str =~ s/\n\t$//m;

    return $str;
}

1;
__END__