Perlでメールを受ける

by Hippo2000(
2001/3/18,1999/1/20,1/7)

「Perlを使ってメールを送る」につづいて「Perlでメールを受ける」なのです。

受信そのものは、Net::POP3モジュールを使うとあっというまに実現できます。
メールを送るでは当初考えていなかった日本語の対応もこちらではおこなっています。

ここでは私が作ったサンプルの紹介だけにとどめます。（説明が面倒なのと、まだ深く調べきれていないのと）

とりあえずは使えるかなというレベルにはなったと思っていますが、もっといい方法があったら教えてください。

99年1月20日　変更（追加）
「添付ファイル名が日本語の場合、うまくメールの取得ができない」という指摘を受けて、調査したところ、添付ファイル名をデコードする必要があることがわかりました。
さらにPOP3サーバからのメールの削除についても記述を加えました.（サンプルに１行だけですが）
この点を加えました。

2001年3月18日　変更（追加）
MIME-toolsの最新版では大きく変更になったので、その点についてスクリプト例を追加しています。

2002/10/15 追加
BASP21による受信の例を追加

1.Perlの力でメールを受ける

Ｐｅｒｌにはさまざまなパッケージが日々追加されています。
そのために非常にパワフルな言語となっています。
パッケージの力を利用すれば、インターネットメールも受信することもできます。

また標準的なパッケージであれば、UNIXなど他の環境でそのまま使うことが可能です。

1.1　必要なパッケージをインストールする

ActivePerlではPPMというモジュールをインストールするためのユーティリティが使用できます。
インターネットメールを送信するためには、以下のパッケージが必要になります。

パッケージ名	説　　　　明
libnet	NET::POP3などのネットワーク関連のモジュールが入っています。
MIME-Base64	添付ファイルをエンコードするためのモジュール ActivePerlでは標準で入っているはず
MIME-tools	添付ファイルを送信するためのMultipart/mixed形式を作成する MIME::Entityが入っています。
MailTools	MIME::Entityの親クラスであるMail::Internetが入っています。
IO-stringy	MIME::Entityで使用します。

さらにJISコード変換のためのパッケージ（またはプログラム）が必要となります。
ここではjcode.plを使います。（kconvパッケージやnkfでも同様だと思っていますが、確認はしていません）

ここで使用するモジュールはすべて送信するときに使ったものと同じです。

1.2　単純な受信プログラム例

「単純な」といいながら結構、面倒なことになってしまっていますが...

このプログラムはメールを受信し、Ｆｒｏｍ、Subject、本文を表示し、
添付ファイルがあればPOP3に保存し、そのタイプと保存したファイル名を表示します。

各モジュールは以下のようなことをしています。

NET::POP3はPOP3サーバと通信し、メールの情報を取得をおこないます。
MIME::Parserは取得したメール情報を解析します。
MIME::Wordsによりデコードしまし、jcode.plを使ってシフトJISに変換しています。

use Net::POP3;
use MIME::Words qw(:all);
use MIME::Parser;
require 'jcode.pl';
#=====================================================
#DECODEする関数
#=====================================================
sub DecodeFld($) {
    my($sBuff) = @_;
    my($sRes, $sWk);
    chomp($sBuff);
    foreach $sWk (decode_mimewords( $sBuff, )){
	($sTxt, $sCode) = @$sWk;
	&jcode'convert(*sTxt, 'sjis') if ($sCode ne "");
					  #本来はISO-2022-JPの場合のみ
	$sRes .= $sTxt;
    }
    return $sRes;
}
#=====================================================
#Bodyの日本語化
#=====================================================
sub BodyStr($) {
    my($oBody) = @_;
    local($sBody);
    $sBody = $oBody;
    &jcode'convert(*sBody, 'sjis');
    return $sBody;
}
#=====================================================
#メインルーチン
#=====================================================
#0.初期設定
# 0.1 NET::POP3オブジェクトの作成
$oPop = Net::POP3->new('pop3svr') or die "Can't not open account.";
                      #POP3サーバ名を設定する

# 0.2 MIME::Parserオブジェクトの作成
my $oParse = new MIME::Parser;
$oParse->output_dir('pop3');	#解析結果をディレクトリPOP3に出力する

#1.初期設定
#1.1 メッセージの数の表示
print "メッセージ数: ", $oPop->login('user','passwd'), "\n";
                                   #ユーザ名とパスワードを設定

#1.2 メッセージを１つづつ取得し、解析する
$rhMsg = $oPop->list();		#メッセージIDのハッシュを取得する

foreach $sMsgId (keys %$rhMsg) {
#2. メッセージの内容の解析、表示
  print "\n>> $sMsgId --------------------------------------- \n";

#2.1 内容の解析
  $oEnt = $oParse->parse_data($oPop->get($sMsgId));
				#ヘッダだけであればgetの代わりにtopを使う
#2.2 ヘッダ
  $oHead = $oEnt->head;
  print "From:", &DecodeFld($oHead->get('From')), "\n";
  print "Subj:", &DecodeFld($oHead->get('Subject')), "\n";

#2.3 本文
  unless ($oEnt->is_multipart) {
   #(1)単純な構造の場合
    print &BodyStr($oEnt->bodyhandle->as_string),"\n";
  }
  else {
    #(2)Multipartの場合
    $nCnt = $oEnt->parts;	#パートの数
   # 1) 本文の表示(先頭パート)
    print &BodyStr($oEnt->parts(0)->bodyhandle->as_string), "\n";
   # 2) 各パートの情報を表示する(添付ファイル）
    for ($i=1; $i<$nCnt;$i++) {
	$sPath = $oEnt->parts($i)->bodyhandle->path;
    	print "=添付ファイル===================\n";
    	print "TYPE:", $oEnt->parts($i)->mime_type, "\n";
    	print "PATH:", $sPath, "\n";
    }
  }
#2.4 POP3サーバからの削除
  $oPop->delete($sMsgId);  #削除はdeleteでおこないます(99/1/20)
}
#3.ログオフ
$oPop->quit;

実行結果の例

C:\User>perl pop3_m1.pl
メッセージ数: 1

>> 1 ---------------------------------------
From:川合孝典<kawai@nippon-rad.co.jp>
Subj:MIME化した内容ｶﾅ文字入り
MIME化した簡単なメールの送信
こんな風に改行もできます。
まぁ当然ではありますが
=添付ファイル===================
TYPE:Application/octetstream
PATH:pop3/t1.txt
=添付ファイル===================
TYPE:Application/octetstream
PATH:pop3/t1.txt
                                                                   
C:\User>

1.3　添付ファイル名が日本語の場合への対応（添付ファイルの名前が重なったときのためにも）

1.2のプログラムでもなんとか動くのですが、MIME::Parserで解析した場合、同じファイル名のものが
添付されていた場合、そのまま上書きされてしまいます。

さらに問題なのは添付ファイル名が日本語の場合、解析でエラーになってしまいます。
これは添付ファイル名がBエンコードされているにもかかわらず、MIME::Parserクラスではエンコードされたままの
名前でファイルを作ろうとするためです。

これらの問題は、サブクラスを使って回避することができます。
以下のようなファイルを作ってMIME::Parserが入っているディレクトリに「パッケージ名.pm」で保存します。
（以下の例であれば、「c:\Perl\site\lib\MIME\kbparser.pm」）

さらにプログラム中のMIME::Parserをサブクラス名（ここではMIME::KbParser）に変更します。

=サブクラス MIME::KbParser=

package MIME::KbParser;
use MIME::Parser;
use MIME::Words qw(:all);          #decodeのために追加
@ISA = qw(MIME::Parser);
#=====================================================
#DECODEする関数
#=====================================================
sub DecodeFld($) {
    my($sBuff) = @_;
    my($sRes, $sWk);
    chomp($sBuff);
    foreach $sWk (decode_mimewords( $sBuff, )){
	($sTxt, $sCode) = @$sWk;
	&jcode'convert(*sTxt, 'sjis') if ($sCode ne "");
					  #本来はISO-2022-JPの場合のみ
	$sRes .= $sTxt;
    }
    return $sRes;
}
#================================================================
# output_pathのオーバーライド
#================================================================
sub output_path{
  my($self, $head) = @_;
  my $sPath = $self->SUPER::output_path($head);
  my($sHead, $sExt);

   $sPath = &DecodeFld($sPath);	#ここで名前をDecode
#1. 同じファイル名が存在するかをチェックする
  if (-e $sPath) {
    #1.1 既にその名前のファイルが存在する
    #(1)出力ディレクトリ、ファイル名を取得
    my $sDir  = $self->SUPER::output_dir;
    my $sFile = substr($sPath, length($sDir)+1);
    #(2)ファイル根幹と拡張子に分解する
    if ($sFile =~ /(.+)(\.\w+)/) {
	($sHead, $sExt) = ($1, $2);
    }
    else {
	($sHead, $sExt) = ($sFile, "");
    }
    #(3)0から10,000までファイル名を作成
    #   10,000越えるようなことは...
    for($i=0;$i<10000;$i++) {
	$sPath = "$sDir/$sHead($i)$sExt";
	return $sPath unless(-e $sPath);
    }
    return $self->SUPER::output_path($head);
		#ダメなら仕方ないので...
  }
  else {
    #1.2 同じ名前のファイルがなければそのまま
    return $sPath;
  }
}

=プログラムの変更=

use Net::POP3;
use MIME::Words qw(:all);
require 'jcode.pl';
use MIME::KbParser;     #MIME::ParserからMIME::KbParserへ変更
（1.2の例のまま）

#=====================================================
#メインルーチン
#=====================================================
#0.初期設定
# 0.1 NET::POP3オブジェクトの作成
$oPop = Net::POP3->new('pop3svr') or die "Can't not open account.";
                      #POP3サーバ名を設定する

# 0.2 MIME::Parserオブジェクトの作成
my $oParse = new MIME::KbParser;  #MIME::ParserからMIME::KbParserへ

（ここから先は1.2の例のまま）

実行結果の例

C:\User>perl pop3_m1k.pl
メッセージ数: 1

>> 1 ---------------------------------------
From:川合孝典<kawai@nippon-rad.co.jp>
Subj:MIME化した内容ｶﾅ文字入り
MIME化した簡単なメールの送信
こんな風に改行もできます。
まぁ当然ではありますが
=添付ファイル===================
TYPE:Application/octetstream
PATH:pop3/hogehoge(0).jpg
=添付ファイル===================
TYPE:Application/octetstream
PATH:pop3/見積情報(0).xls
メッセージ数: 1
                                                                  
C:\User>

1.4　参考資料

PPMでインストールすると各パッケージのインストールの際に、HTML形式のファイルが展開されます。
そのファイルに各モジュールの詳しい説明が載っています。

ファイルはActivePerlがインストールされたディレクトリ（通常はC:\Perl)の下のHTML\LIBまたは、
HTML\LIB\SITEに展開されます。

ここで扱った主なモジュールのファイル名を以下の表に示します。

パッケージ名	モジュール名	説　　　　明
libnet	NET::POP3	C:\Perl\html\lib\Net\POP3.html
MIME-Base64	MIME::Base64	C:\Perl\html\lib\site\MIME\Base64.html
MIME-tools	MIME::Words	C:\Perl\html\lib\site\MIME\Words.html
	MIME::Entity	C:\Perl\html\lib\site\MIME\Entity.html
	MIME::Parser	C:\Perl\html\lib\site\MIME\parser.html
		C:\Perl\html\lib\site\MIME\parserbase.html
	MIME::Head	C:\Perl\html\lib\site\MIME\head.html
	MIME::Body	C:\Perl\html\lib\site\MIME\body.html
MailTools	Mail::Internet	C:\Perl\html\lib\site\Mail\Internet.html

1.5　MIME-toolsの最新版への対応＋HTMLメールに添付ファイル

これまでは1.3のプログラムで大過なく過ごしてきましたが（本当かなぁ？）、MIME-Toolsが大きく変更され、MIME-Toolsの5.410では、これまでのようにMIME::Parserのサブクラスを定義しなくても日本語名の添付ファイルを受信できるようになりました。

もう少しMIME-Toolsの各モジュールのドキュメントを読んでみないとよくわからないのですが、とりあえずわかっていることをまとめます。メールの送信と含めて、まとめられればとは思っていますが。

まず、これまでのように別のサブクラスを用意しなくても、コード変換関数の指定MIME::WordDecoderのdefaultとして指定することにより、自動的にこの変換関数が呼ばれるようになっています。またHTMLメールで添付ファイルがあるなど、構造としてネストしている場合、これまでのプログラムではうまくいきませんでした。そこで再帰的に呼び出すように変更しています。

=新しいスクリプトの例=

uuse strict;
use Jcode;
use MIME::WordDecoder;
use MIME::Parser;
use Net::POP3;
use constant Pop3Svr => 'your.pop3svr';
use constant Pop3Usr => 'POP3user';
use constant Pop3Pwd => 'POP3Pwd';

#1.デフォルトのMIME変換を設定
MIME::WordDecoder->default(
    MIME::WordDecoder->new( [
        '*'   => sub { jcode(shift)->sjis }, #本来はISO-2022-JPのみ
        ]
    )
);
my $oParse = new MIME::Parser;
$oParse->output_dir('pop3'); 

#Get From Server
my $oPop = Net::POP3->new(Pop3Svr, Timeout => 60);
$oPop->login(Pop3Usr, Pop3Pwd);
my $rhMsg = $oPop->list(); 

foreach my $sMsgId (keys %$rhMsg) {
    my $raCont = $oPop->get($sMsgId);
    my $oEnt = $oParse->parse_data($raCont);
    my $oHead = $oEnt->head;

	print "\n===============================================\n";
    print "From:", unmime($oHead->get('From'));
    print "To  :", unmime($oHead->get('To'));
    print "Subj:", unmime($oHead->get('Subject'));
    PrnCont($oEnt);
}

#=====================================================
#内容の表示
#=====================================================
sub PrnCont($;$) {
  my($oEnt, $iLvl) = @_;

  $iLvl = 0 unless($iLvl);
  unless ($oEnt->is_multipart) {
#(1)シングルパート
    print "SINGLE:", jcode($oEnt->bodyhandle->as_string)->sjis;
  }
  else {
#(2)マルチパート
    my $nCnt = $oEnt->parts;    #Count of Parts
    for (my $i=0; $i<$nCnt;$i++) {
        if($oEnt->parts($i)->is_multipart) {
        #マルチパートのネスト
            print "PARTS: $i (Nested)\n";
            PrnCont($oEnt->parts($i), $iLvl+1);
        }
        else {
        #普通のマルチパート
            print "--------------------------------------------------\n";
            print "PART:", ref($oEnt), " LVL:$iLvl\n";
            print "PATH:", $oEnt->parts($i)->bodyhandle->path, "\n";
            print "TYPE:", $oEnt->parts($i)->mime_type, "\n";
            if($oEnt->parts($i)->mime_type eq "text/plain") {
                print "TEXT:\n";
                print jcode($oEnt->parts($i)->bodyhandle->as_string)->sjis, "\n"
            }
            elsif($oEnt->parts($i)->mime_type eq "text/html") {
                print "HTML:\n";
                print jcode($oEnt->parts($i)->bodyhandle->as_string)->sjis, "\n"
            }
            else {
                my $sPath = $oEnt->parts($i)->bodyhandle->path();
                print "--FILES--------------------\n";
                print "PATH:", $sPath, "\n";
            }
        }
    }
  }
}

なお、メーラからファイル名として正しくない（例えば妙に空白が入っているなど）場合への対応するためには、従来のようにサブクラスを利用してoutput_pathをオーバーライドすることになります。このメソッドはMIME::Parser::Filerのメソッドになっているので、MIME::Parser:Filerをオーバーライドしたいところですが、そのためにMIME::Parser::Filerを生成している部分をすべて書換えなければならず、あまり現実的ではありません。結局、従来通りMIME::Parserのサブクラスでオーバーライドするほうがいいように思われます。

以下はMIME::Parserのサブクラスとしてoutput_pathをオーバーライドする例です。パス名の先頭についている空白を削除しています。output_pathはMIME::Parser::Filerから持ってきて、改造を加えています。

=サブクラス MIME::KbParser3=

use strict;
package MIME::KbParser3;
use MIME::Parser;
use Jcode;
use vars qw(@ISA);
@ISA = qw(MIME::Parser);
#================================================================
# output_pathのオーバーライド
#================================================================
sub output_path {
    my ($self, $head) = @_;
#変更点： $self => $self->filerに変更
# if文の構成をちょっと変更し、$fname =~ s/^\s+//を追加
# ファイル名のevel判定をEUCに変換してから実行、その後に戻している
    ### Get the output directory:
    my $dir = $self->filer->output_dir($head);
    
    ### Get the output filename, decoding into the local character set:
    my $fname = MIME::Parser::Filer::unmime $head->recommended_filename;

    ### Can we use it:
    if    (!defined($fname)) {
        $self->filer->debug("no filename recommended: synthesizing our own");
        $fname = $self->filer->output_filename($head);
    }
    elsif ($self->filer->ignore_filename) {
        $self->filer->debug("ignoring all external filenames: synthesizing our own");
        $fname = $self->filer->output_filename($head);
    }
    else {
        $fname =~ s/^\s+//;
        $fname = jcode($fname)->euc;
        if ($self->filer->evil_filename($fname)) {
            ### Can we save it by just taking the last element?
            my $ex = $self->filer->exorcise_filename($fname);
            if (defined($ex) and !$self->filer->evil_filename($ex)) {
                $self->filer->whine("Provided filename '$fname' is regarded as evil, ",
                     "but I was able to exorcise it and get something ",
                     "usable.");
                $fname = $ex;
            }
            else {
                $self->filer->whine("Provided filename '$fname' is regarded as evil; ",
                     "I'm ignoring it and supplying my own.");
                $fname = $self->filer->output_filename($head);
            }
        }
        $fname = jcode($fname)->sjis;
    }
    $self->filer->debug("planning to use '$fname'");
    ### Resolve collisions and return final path:
    return $self->filer->find_unused_path($dir, $fname);
}
1;
__END__

2.Basp21の力でメールを受ける

ActivePerlにはOLEオートメーションやDLLを使えるという大きなメリットがあります。
そこでBASP21を使ってメールを受信することができます。

また日本語コードにも対応しています。

2.1　Basp２１、BSMTP.DLLとは

BASP21.DLLは、babaqさんが作成したフリーウェアで、VBScript、Visual Basic、VBA、WSHなどから使える汎用の
コンポーネントです。 ActivePerlからもWin32::OLEパッケージを使って利用することができます。
メールの送信、受信、プログラムの実行などさまざまなメソッドをサポートしています。

そして、BSMTP.DLLはBASP21でのメール関連のDLLです。

Basp21の内容については、詳しくはBaba Centerfolds http://www.hi-ho.ne.jp/babaq/　を参照してください。

BASP21を使ったメール受信の例：

RsvMail、ReadMailの戻り値の判定、つまり配列だったりそうでなかったりはWin32::OLEは配列への
リファレンスかスカラーかで判定することができます。
下記のスクリプトでは簡単にrefつまりリファレンスかどうかだけを見ています。
実際参照するときには@をつけて配列にデリファレンスして見ています。

use strict;
use Win32::OLE;
my $sSvr  = 'pop.hoge.ne.jp'; # POP3サーバマシン名
my $sUsr  = 'hogeuser';     # メールボックス名
my $sPass = 'hogepass';   # パスワード
my $sDir = 'c:\\temp\\basp21';  # 保存ディレクトリ名
my $oBobj = Win32::OLE->new('BASP21') or die "oops\n";
my $raRcv = $oBobj->RcvMail($sSvr, $sUsr, $sPass, 
                                'SAVEALL', $sDir);
if (ref($raRcv)) {  #リファレンスかどうかのチェック
    my $sFile;
    foreach $sFile (@$raRcv) {
        my $raRead = $oBobj->ReadMail($sFile, 'subject:from:date:', $sDir);
        if(ref($raRead)) {
            print @$raRead;
        }
        else {
            print "ERROR: $raRead\n";
        }
    }
}
else {
    print "ERROR: $raRcv\n";
}

参考資料

この文書をつくるのにあたり、以下のサイトのお世話になりました.

ActiveSate
　http://www.activestate.com/ 　　　　　　　　　ActivePerlのホームページ
　http://www.activestate.com/packages/zips/ 　ActivePerlのパッケージのページ
Baba　Centerfolds
　http://www.hi-ho.ne.jp/babaq/　　　　　　　　 Basp21のホームページ

ホーム　Perlの小技

ご意見、ご質問はこちらの掲示板で受け付けています。
またメールは河馬屋(Nifty)にお願いします。

Perlでメールを受ける

目次

1.Perlの力でメールを受ける
1.1　必要なパッケージをインストール
1.2　単純な受信プログラム例
1.3　添付ファイル名が日本語の場合への対応（添付ファイルの名前が重なったときのためにも）
1.4　参考資料

2.Basp21を使ってメールを受ける
2.1　Basp21、BSMTP.DLLとは

参考資料

1.Perlの力でメールを受ける

1.1　必要なパッケージをインストールする

1.2　単純な受信プログラム例

1.3　添付ファイル名が日本語の場合への対応（添付ファイルの名前が重なったときのためにも）

1.4　参考資料

1.5　MIME-toolsの最新版への対応＋HTMLメールに添付ファイル

2.Basp21の力でメールを受ける

2.1　Basp２１、BSMTP.DLLとは

参考資料