# ---------------------------------------------------------------- # EmailJP.pl - Send mail with Net::SMTP (add Date: header) # Copyright 2001-2004 Kappe Inc. All rights reserved. # ---------------------------------------------------------------- # 2001/05/14 宛先アドレスの取り出しがちゃんとしたバージョン # 2002/12/25 RCPT コマンドエラーを捕捉。debug オプション対応 # 2003/06/13 送信文字コード指定対応、足りないヘッダを自動付加 # 2003/06/26 ヘッダ追加は冒頭にする # 2003/07/01 複数の代替SMTPサーバを指定可能 # 2004/07/05 バグ修正、自動コード判別、Message-Id: 生成出力 # 2004/10/28 Encode561、EmojiTrans、EscapeSJIS、EscapeJIS 対応 # 2004/11/07 POD を少し整備しました # ---------------------------------------------------------------- use strict; package EmailJP; use vars qw( $VERSION $DEBUG ); # ---------------------------------------------------------------- $VERSION = "0.01"; # ---------------------------------------------------------------- =head1 NAME EmailJP.pm -- Send mail with Net::SMTP (add Date: header) =head1 SYNOPSIS # 簡単な使い方（ヘッダを参照して宛先アドレスを決定） use EmailJP; my $count = &EmailJP::sendmail( mail => $text ); # 最大限の使い方（宛先アドレスを明示的に指定する） use EmailJP; my $server; $server = "127.0.0.1"; # SMTPサーバ $server = [qw( 192.168.0.1 127.0.0.1 )]; # 複数指定可能 my $count = &EmailJP::sendmail( server => $server, # SMTPサーバ hello => "localhost", # HELLO timeout => 5, # タイムアウト return => $return_path, # エラー返送先 to => $rcpt_to, # メール宛先 head => $mail_head, # メールヘッダ body => $mail_body, # メール本文 charset => "iso-2022-jp", # 送信文字コードは JIS internal => "EUC-JP" # 内部文字コードは EUC ); =head1 DESCRIPTION EmailJP モジュールは、日本語を含むメールを適切な形式で送信します。 =head2 OPTIONS sendmail() 関数では以下のオプションを指定できます。 server => SMTPサーバホストIPアドレス EmailJP がメール送信する際、デフォルトで 127.0.0.1（自ホスト）に SMTP 接続してメールを送信します。 SMTP 接続する先のメールサーバIPアドレスを変更する場合は、 server オプションで指定してください。 配列へのリファレンスで複数のメールサーバを列挙した場合は、 1つ目のメールサーバが停止している場合に 2つ目以降のメールサーバへ順に接続します。 基本的に利用可能なメールサーバを列挙しておくことをお勧めします。 hello => HELLO文字列 SMTP 接続時の HELO コマンドの引数を指定します。 デフォルトでは localhost となります。 このままでも通常は問題ありません。 timeout => タイムアウト秒数 SMTP 接続時のタイムアウト秒数を指定します。 return => エラー返信先アドレス メール送信完了後にエラーが発生した場合に、 SMTP サーバから通知されるアドレスを指定します。 指定しない場合は、メールヘッダの Return-Path: 行が参照されます。 ただし、エラーメールが生成されるのは EmailJP の送信処理が成功した後で、 EmailJP の送信処理が失敗した場合は、単に偽が返ります。 to => メール宛先アドレス メールの宛先アドレスを指定します。 指定しない場合は、メールヘッダの To: Cc: Bcc: 行が参照されます。 internal => 内部文字コード sendmail() 関数を呼び出す側の文字コードは、 デフォルトで EUC-JP とみなします。 EUC-JP 以外の文字コード(UTF-8など)を使用している場合は、 internal オプションで指定してください。 Shift_JIS、UTF-8 などが使用できます。 charset => 送信文字コード メール送信時の文字コードは、デフォルトで iso-2022-jp となります。 ただし、メール本文中に &#xHHHH; 形式の絵文字コードを含んでおり、 メールの宛先に NTT ドコモ携帯アドレスを含んで、 かつ au・TU-KA・Vodafone の携帯アドレスを含まない場合は、 NTT ドコモ用絵文字を文字化けなく受信させるため Shift_JIS となります。 それ以外の文字コードで送信したい場合は、charset オプションで 指定してください。 Shift_JIS、UTF-8 などが使用できます。 head => メールヘッダ body => メール本文 送信するメールのヘッダと本文を指定します。 メールヘッダと本文が予め合体している場合は、 下記の mail オプションを指定してください。 mail => メールヘッダ＋本文 送信するメールのヘッダと本文を指定します。 ヘッダと本文の間には空行×１が必要です。 メールヘッダと本文が予め分離している場合は、 上記の head・body オプションを指定してください。 =head2 DEFAULT MAIL HEADER mail オプションまたは head オプションで指定されたヘッダ中に 必須のヘッダが無い場合は、下記のようなヘッダが自動付加されます。 （標準：JISの場合） Date: Fri, 13 Jun 2003 03:17:01 +0900 MIME-Version: 1.0 Content-Type: text/plain; charset="ISO-2022-JP" Content-Transfer-Encoding: 7bit （Shift_JISの場合） Date: Fri, 13 Jun 2003 03:17:01 +0900 MIME-Version: 1.0 Content-Type: text/plain; charset="Shift_JIS" Content-Transfer-Encoding: 8bit =head2 E-MAIL FOR PC PC向けのメール中に、ハシゴ高や、立の崎字などの IBM 拡張漢字を含む場合も EscapeJIS.pm モジュールにより文字化けせずに送信できます。 CP932 UCS2 補足 ------ ------ ---------- FBFC 9AD9 ハシゴ高 FAB1 FA11 山＋立＋可 FBB9 9127 とう小平 ただし、受信側のＯＳ、メールソフトによっては正しく表示できない場合も あります。（Outlook Express・Becky! 2 では表示できます） =head2 E-MAIL FOR PHONE メール本文の文字コードは通常、ISO-2022-JP (JIS) となりますが、 メール本文中に &#xHHHH; 形式の絵文字コードを含んでおり、 メールの宛先に NTT ドコモ携帯アドレスを含んで、 かつ au・TU-KA・Vodafone の携帯アドレスを含まない場合は、 NTT ドコモ用絵文字を文字化けなく受信させるため Shift_JIS となります。 メール本文中に &#xHHHH; 形式の絵文字コードを含んでおり、 メールの宛先に au・TU-KA の携帯アドレスを含んで、 かつ NTT ドコモ・Vodafone の携帯アドレスを含まない場合は、 EmojiTrans.pm モジュールを利用して、 NTT ドコモ用の絵文字コードを au・TU-KA 用の似た絵文字コードに変換します。 メール本文中に &#xHHHH; 形式の絵文字コードを含んでおり、 メールの宛先に Vodafone の携帯アドレスを含んで、 かつ NTT ドコモ・au・TU-KA の携帯アドレスを含まない場合は、 EmojiTrans.pm モジュールを利用して、 NTT ドコモ用の絵文字コードを Vodafone 用の似た絵文字コードに変換します。 これにより、NTT ドコモ用の絵文字コードを含むメール本文を用意するだけで NTT ドコモ・au・TU-KA・Vodafone 全てのキャリアに対して絵文字を含むメールを 正常に送信することができます。 =head1 COPYRIGHT Copyright 2004 Kawasaki Yusuke http://www.kawa.net/ =cut # ---------------------------------------------------------------- # 各モジュールを事前読み込みする場合 # （必要なモジュールは自動的に読み込まれます） # ---------------------------------------------------------------- use Net::SMTP; use Encode561; use EmojiTrans; # use EscapeSJIS; # use EscapeJIS; # use EscapeUTF8; # use MIME::Base64; # use Jcode; # ---------------------------------------------------------------- # デバッグモード # ---------------------------------------------------------------- # $DEBUG ++; # ---------------------------------------------------------------- # 初期設定 # ---------------------------------------------------------------- my $WORK_CHARSET = "EUC-JP"; # or "UTF-8" my $OUT_CHARSET = "ISO-2022-JP"; # or "UTF-8", "Shift_JIS" my $DOCOMO_CHARSET = "Shift_JIS"; # ドコモ専用 my $SMTP_SERVER = "127.0.0.1"; my $SMTP_HELLO = "localhost"; my $TIMEZONE = "+0900"; my $MIME_VERSION = "1.0"; my $SMTP_TIMEOUT = 3; my $MAIL_COMMAND = "/usr/sbin/sendmail -oi"; # ---------------------------------------------------------------- # Content-Transfer-Encoding: でないエンコーディングを指定 # ---------------------------------------------------------------- my $NOT_8BIT_CODE = { "iso-2022-jp" => "7bit", }; # ---------------------------------------------------------------- # 旧仕様で、Jcode.pm 用のコード名を指定された場合の変換マップ # ---------------------------------------------------------------- my $JCODE2CHARSET = { jis => "ISO-2022-JP", euc => "EUC-JP", sjis => "Shift_JIS", utf8 => "UTF-8", }; # ---------------------------------------------------------------- # メール送信 # ---------------------------------------------------------------- sub sendmail { my $hash = { @_ }; my $head = $hash->{head}; my $body = $hash->{body}; my $wait = $hash->{timeout} || $SMTP_TIMEOUT; # SMTPタイムアウト my $from = $hash->{return}; my $rcpt = $hash->{to}; my $server = $hash->{server} || $SMTP_SERVER; my $hello = $hash->{hello} || $SMTP_HELLO; my $outcode = $hash->{charset}; # charset= 指定 $outcode ||= $JCODE2CHARSET->{$hash->{jcode}}; # 旧バージョンとの互換 my $workcode = $hash->{internal} || $WORK_CHARSET; my $command = $hash->{command} || undef; # 外部コマンドで送信 $DEBUG ++ if $hash->{debug}; # デバッグ（2002/12/25） # ヘッダと本文の切り分けの確定 if ( $head eq "" && $body eq "" && defined $hash->{mail} ) { my $mail = $hash->{mail}; $mail = join( "", @$mail ) if ref $mail; $mail =~ s/\r?\n/\n/sg; $mail =~ s/\r/\n/sg; ( $head, $body ) = split( /(?:\n\r?\n|\r\n?\r)/, $mail, 2 ); } else { $head =~ s/\r?\n/\n/sg; $head =~ s/\r/\n/sg; $body =~ s/\r?\n/\n/sg; $body =~ s/\r/\n/sg; } # &#xHHHH; 形式の絵文字を使っている場合 my $use_emoji; $use_emoji ++ if ( $head =~ /\&\#/ ); $use_emoji ++ if ( $body =~ /\&\#/ ); $DEBUG and print "[USE_EMOJI=$use_emoji]\n"; # ヘッダ中の無駄な空白を削除 $head =~ s/[\r\n]+/\n/sg; $head =~ s/^\s+//s; $head =~ s/\s+$//s; # 差出人アドレスの取り出し $from ||= ( $head =~ /^Return-Path:(?:[^\n]|\n[\040\t])*? ([^\000-\040\"\'\<\>\(\)\@\,]+\@(?:[\w\-]+\.)+\w+)/mx )[0]; $from ||= ( $head =~ /^From: (?:[^\n]|\n[\040\t])*? ([^\000-\040\"\'\<\>\(\)\@\,]+\@(?:[\w\-]+\.)+\w+)/mx )[0]; $DEBUG and print "[FROM=$from]\n"; die "Sender address is not defined.\n" if ( $from eq "" ); # あて先アドレスの取り出し if ( ! ref $rcpt ) { if ( $rcpt eq "" ) { $rcpt = []; foreach my $line ( $head =~ /^(?:To|Cc|Bcc): ((?:[^\n]+|\n[\040\t])+)/mxg ) { foreach my $addr ( $line =~ /([^\000-\040\"\'\<\>\(\)\@\,]+ \@(?:[\w\-]+\.)+\w+)/xg ) { push( @$rcpt, $addr ); } } } else { $rcpt = [ $rcpt ]; } } $DEBUG and print "[RCPT=",($#$rcpt+1),"]\n"; die "Receipt address is not defined.\n" if ( $#$rcpt < 0 ); # 携帯電話宛のアドレスを確認する my $user_agent = &mobile_user_agent( $rcpt ); $DEBUG and print "[USER_ANGET=$user_agent]\n"; # Date: 行がなければ冒頭に追加する my $date = ( $head =~ /(?:^|[\r\n])Date: (?:[^\n]|\n[\040\t])*?(\S.*)/is )[0]; if ( $date eq "" ) { $date = &get_date_string(); $head = "Date: ".$date."\n".$head if $date; } $DEBUG and print "[Date=$date]\n"; # Content-Type: 行で文字コードが指定されていればそれに従う my $ctline = ( $head =~ /(?:^|[\r\n])Content-Type: (?:[^\n]|\n[\040\t])*?(\S.*)/isx )[0]; if ( $ctline =~ m#^text/.*;\s*charset="?([^"]+)#isx ) { $outcode = $1; } # 出力コードが未指定で、宛先がドコモのみで、 # 絵文字が指定されていそうな場合は、Shift_JIS とする unless ( $outcode ) { if ( $use_emoji && $user_agent eq "DoCoMo/" ) { $outcode ||= $DOCOMO_CHARSET; } $outcode ||= $OUT_CHARSET; } # Content-Type: 行がなければ冒頭に追加する if ( $ctline eq "" && $outcode ) { $ctline = "text/plain; charset=".$outcode; $head = "Content-Type: ".$ctline."\n".$head; } $DEBUG and print "[Content-Type=$ctline]\n"; $DEBUG and print "[charset=$outcode]\n"; # Content-Transfer-Encoding: 行がなければ冒頭に追加する my $ctenc = ( $head =~ /(?:^|[\r\n])Content-Transfer-Encoding: (?:[^\n]|\n[\040\t])*?(\S.*)/isx )[0]; if ( $ctenc eq "" ) { $ctenc = "8bit"; $ctenc = $NOT_8BIT_CODE->{$outcode} if $NOT_8BIT_CODE->{$outcode}; $head = "Content-Transfer-Encoding: ".$ctenc."\n".$head; } $DEBUG and print "[Content-Transfer-Encoding=$ctenc]\n"; # MIME-Version: 行がなければ冒頭に追加する my $mimever = ( $head =~ /(?:^|[\r\n])MIME-Version: (?:[^\n]|\n[\040\t])*?(\S.*)/isx )[0]; if ( $mimever eq "" ) { $mimever = $MIME_VERSION; $head = "MIME-Version: ".$mimever."\n".$head; } $DEBUG and print "[MIME-Version=$mimever]\n"; # Message-Id: 行がなければ冒頭に追加する my $messid = ( $head =~ /(?:^|[\r\n])Message-Id: (?:[^\n]|\n[\040\t])*?(\S.*)/isx )[0]; if ( $messid eq "" ) { $messid = &gen_message_id( $from ); $head = "Message-Id: ".$messid."\n".$head if $messid; $DEBUG and print "[Message-Id=$messid]\n"; } # 文字コード変換処理 if ( $workcode ne $outcode ) { &require_or_die( "Encode561.pm" ) unless defined $Encode561::VERSION; $DEBUG and print "[Encode561=$workcode to $outcode]\n"; Encode561::from_to( \$head, $workcode, $outcode ); Encode561::from_to( \$body, $workcode, $outcode ); } # 絵文字が使われていて、携帯宛がある場合は絵文字変換する if ( $use_emoji && $user_agent ) { &require_or_die( "EmojiTrans.pm" ) unless defined $EmojiTrans::VERSION; $DEBUG and print "[EmojiTrans=$user_agent]\n"; EmojiTrans::translate( \$head, $user_agent ); EmojiTrans::translate( \$body, $user_agent ); } # 絵文字などの &#xHHHH; 形式のエスケープ解除処理・MIMEヘッダ処理 if ( $outcode =~ /^ISO-2022-JP/i ) { $DEBUG and print "[EscapeJIS=$outcode]\n"; &require_or_die( "EscapeJIS.pm" ) unless defined $EscapeJIS::VERSION; EscapeJIS::unescape( \$head, $user_agent ) if $use_emoji; EscapeJIS::mime_encode( \$head ); EscapeJIS::unescape( \$body, $user_agent ) if $use_emoji; } elsif ( $outcode =~ /^(Shift[\-\_]?JIS|CP932)$/i ) { $DEBUG and print "[EscapeSJIS=$outcode]\n"; &require_or_die( "EscapeSJIS.pm" ) unless defined $EscapeSJIS::VERSION; EscapeSJIS::unescape( \$head, $user_agent ) if $use_emoji; EscapeSJIS::mime_encode( \$head ); EscapeSJIS::unescape( \$body, $user_agent ) if $use_emoji; } elsif ( $outcode =~ /^UTF-?8$/i ) { $DEBUG and print "[EscapeUTF8=$outcode]\n"; &require_or_die( "EscapeUTF8.pm" ) unless defined $EscapeUTF8::VERSION; EscapeUTF8::unescape( \$head, $user_agent ) if $use_emoji; EscapeUTF8::mime_encode( \$head ); # EscapeUTF8::unescape( \$body, $user_agent ) if $use_emoji; # 本文は変換しない } else { # それ以外の文字コードの場合もスルーする } # Net::SMTP でメールを送信するか、外部コマンドを利用するかを決定 my $use_smtp = 1 unless $command; if ( $use_smtp ) { &auto_require( "Net/SMTP.pm" ) unless defined $Net::SMTP::VERSION; $DEBUG and print "[Net::SMTP=$Net::SMTP::VERSION]\n"; } $use_smtp = undef unless defined $Net::SMTP::VERSION; $command ||= $MAIL_COMMAND unless $use_smtp; if ( ! $use_smtp && ! $command ) { die "Net::SMTP is required for sending e-mail.\n" } # Net::SMTP または外部コマンドでメールを送信する if ( $use_smtp ) { $DEBUG and print "[send_by_smtp]\n"; &send_by_smtp( $server, $from, $rcpt, $head, $body, $hello, $wait ); } else { $DEBUG and print "[send_by_command=$command]\n"; &send_by_command( $command, $from, $rcpt, $head, $body ); } } # ---------------------------------------------------------------- # 外部コマンドを利用したメール送信 # ---------------------------------------------------------------- sub send_by_command { my( $command, $from, $rcpt, $head, $body ) = @_; my $line = join( " ", $command, "-f", $from, @$rcpt ); open( CMD, "| $line" ) or die "$line - $!\n"; print CMD $head, "\n\n", $body; close( CMD ); scalar @$rcpt; } # ---------------------------------------------------------------- # Net::SMTP を利用したメール送信 # ---------------------------------------------------------------- sub send_by_smtp { my( $server, $from, $rcpt, $head, $body, $hello, $wait ) = @_; my $smtp; foreach my $host ( ref $server ? @$server : $server ) { $DEBUG and print "[SERVER=$host]\n"; $smtp = Net::SMTP->new( $host, Hello => $hello, # HELLO Timeout => $wait ); # タイムアウト $DEBUG and print "[SMTP=$smtp]\n"; last if defined $smtp; } return undef unless $smtp; $DEBUG and print "[FROM=$from]\n"; $smtp->mail( $from ) or return undef; # 送信元の指定 my $sent = 0; foreach my $to ( @$rcpt ) { my $recv = $smtp->to( $to ) or return undef; # 宛先の指定 $DEBUG and print "[TO=$to]\n"; $sent ++; } $smtp->data() or return undef; # メールの開始 $smtp->datasend( $head ); # メールヘッダ $smtp->datasend( "\n\n" ); # 空行 $smtp->datasend( $body ); # メール本文 $smtp->dataend(); # メールの終了 $smtp->quit; # SMTP 接続の終了 $DEBUG and print "[DONE=$sent]\n"; $sent; } # ---------------------------------------------------------------- # Date: ヘッダ用の文字列を生成する # ---------------------------------------------------------------- sub get_date_string { my $utc = shift || time(); my $WDAYNAME = [qw( Sun Mon Tue Wed Thu Fri Sat )]; my $MONTHNAME = [qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )]; my( $sec, $min, $hour, $day, $month, $year, $wday ) = localtime($utc); my $date = sprintf( "%s, %2d %s %4d %02d:%02d:%02d %s", $WDAYNAME->[$wday], $day, $MONTHNAME->[$month], $year+1900, $hour, $min, $sec, $TIMEZONE ); $date; } # ---------------------------------------------------------------- # Message-Id: ヘッダ用の文字列を生成する # ---------------------------------------------------------------- sub gen_message_id { my $from = shift; my $user = ( $from =~ /([\w\-\.]*)\@/ )[0] || $$; my $domain = ( $from =~ /\@([\w\-\.]+)/ )[0] || "localhost"; $user =~ tr/a-z/A-Z/; # ユーザ名は大文字にする my( $sec, $min, $hour, $day, $month, $year, $wday ) = localtime(); $year += 1900; $month ++; my $messid = sprintf( "<%04d%02d%02d%02d%02d%02d.%04X.%s\@%s>", $year, $month, $day, $hour, $min, $sec, rand(65536), $user, $domain ); $messid; } # ---------------------------------------------------------------- # 携帯電話のアドレスが１社に確定できる場合は User-Agent を仮定する # ---------------------------------------------------------------- sub mobile_user_agent { my $rcpt = shift or return; my $docomo = scalar grep {/\@docomo.ne.jp$/i} @$rcpt; my $voda = scalar grep {/\@([a-z]\.vodafone|jp-t[a-z]).ne.jp$/i} @$rcpt; my $ezweb = scalar grep {/\@(\w+\.)?(ezweb|tu-ka|ido|tk\w).ne.jp$/i} @$rcpt; my $user_agent; $user_agent = "DoCoMo/" if ( $docomo && ! $voda && ! $ezweb ); $user_agent = "J-PHONE/" if ( ! $docomo && $voda && ! $ezweb ); $user_agent = "KDDI-" if ( ! $docomo && ! $voda && $ezweb ); $user_agent; } # ---------------------------------------------------------------- # Perl モジュールを追加で読み込む # ---------------------------------------------------------------- sub auto_require { my $pm = shift or return; $DEBUG and print "[require=$pm]\n"; eval "require '$pm';"; } # ---------------------------------------------------------------- # Perl モジュールを追加で読み込む # ---------------------------------------------------------------- sub require_or_die { &auto_require( @_ ); die "$_[0] - $@\n" if $@; } # ---------------------------------------------------------------- ;1; # ----------------------------------------------------------------