POP3受信するPerlスクリプト

POP3受信するPerlスクリプトを作りました（備忘録です）。
複数ユーザー(200以上)のテストを手動でやると発狂しそうなのでスクリプト化しました。
PerlモジュールのEncode、Net::POP3、Email::MIMEが必要です（無い場合はインストールして下さい）。

スクリプトを実行する際、第一引数にファイル名を指定します。
ファイルのsyntaxは以下の通り

#Comment
User1<Delimiter>Password1
User2<Delimiter>Password2
...
User100Password100

<Delimiter>はフィールド区切りでスペースまたはタブになります。
行頭に"#"があるとコメント行になります。
標準入力からデータを読み込ませる場合は

echo "User Password" | this-script.pl -

とすれば実行できます。

#!/usr/bin/perl

use strict;
use utf8;
use Encode;
use Net::POP3;
use Email::MIME;

my $server = 'サーバのFQDNまたはIPアドレス';
my $userfile = shift;
my $layout = << 'TMPL';
[TITLE]
%s

[BODY]
%s


TMPL

die "Usage: $0 [file]\n" unless $userfile;
open(IN, $userfile) || die "can't open file: $!\n";

while(<IN>){
    s/[\r\n]*$//;
    my ($user, $password) = split(/[\t\x20]+/, $_, 2);
    if ( $user =~ /^#|^$/ ) { next; }

    print Encode::encode( 'utf-8', "$user: POP3接続 " );
    my $pop = Net::POP3->new( $server );
    my $result = $pop->login( $user, $password );

    if ( $result ) {
        if ( $result == "0E0" ) {
            print Encode::encode( 'utf-8', "→ 成功(0)件\n" );
        } else {
            print Encode::encode( 'utf-8', "→ 成功($result)件\n" );
            my $list_href = $pop->list;        # メール一覧のハッシュのリファレンスを得る
            foreach my $msg_id ( keys %{ $list_href } ) {
                my $message = join q(), @{ $pop->get( $msg_id ) }; # メール本文を取得
                my $parsed  = Email::MIME->new($message);
                print sprintf $layout,
                    Encode::encode( 'utf8', $parsed->header('Subject') ),
                    Encode::encode( 'utf8', Encode::decode( 'jis', $parsed->body ) );

                $pop->delete( $msg_id );      # 受信したメールを削除する
            }
        }
    } else {
        print Encode::encode( 'utf-8', "→ 認証失敗\n" );
    }
    $pop->quit;
}
close(IN);
exit;