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__
=head1 NAME
PHP::Functions::Mail - Transplant of mail function of PHP
=head1 SYNOPSIS
#simple mail send
use PHP::Functions::Mail qw(mail);
mail('ToAddress@example.com', 'subject', 'body of message', 'From: FromAddress@example.com');
#When you enhance the header and Option specification
#Host specifiles the smtp server (default 'localhost')
use PHP::Functions::Mail qw(mail);
mail('ToAddress@example.com', 'subject', 'body of message',
join("\n",
'From: from user <FromAddress@example.com>',
'Cc: CcAddress@example.com, cc user <CcAddress2@example.com>'),
{Host => 'smtp.example.com'} );
#for Japanese
use PHP::Functions::Mail qw(mb_send_mail);
mb_send_mail('Japanese Strings <ToAddress@example.com>',
'subject of Japanese Strings', 'body of Japanese message',
'From: Japanese Strings <FromAddress@example.com>');
=head1 DESCRIPTION
This module offers perl the function equal with the mail function and the mb_send_mail function mounted with PHP.
=head2 EXPORT
=over 4
=item mail ( TO, SUBJECT, MESSAGE [, HEADERS [, OPTIONS]] )
send of mail.
use
=item mb_send_mail ( TO, SUBJECT, MESSAGE [, HEADERS [, OPTIONS]] )
send of mail for Japanese.
L<Jcode> is used.
=head1 SEE ALSO
L<http://www.php.net/manual/en/function.mail.php>
L<http://www.php.net/manual/en/function.mb-send-mail.php>
L<Net::SMTP>
=head1 AUTHOR
Kazuhiro, Osawa E<lt>ko@yappo.ne.jpE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005 by Kazuhiro Osawa
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either at your option,
any later version of Perl 5 you may have available.
=cut