#!/usr/bin/perl

use DBI;
use Encode;
use MIME::Parser;

my $dbhost="ホスト名 or IP";
my $dbname="データベース名";
my $dbuser="ログインユーザ";
my $dbpass="パスワード";
my $parseObj = MIME::Parser->new();
my $entity;
my $subject, $from, $flag;

### 標準入力からメールを読み込んで件名と送信者アドレス取得
  $parseObj->output_dir('./');
  $entity   = $parseObj->parse(\*STDIN);
  $subject = encode("euc-jp", decode("MIME-Header", $entity->head->get("Subject")) );
  $from    = encode("euc-jp", decode("MIME-Header", $entity->head->get("From")) );
  if ( $from =~ /^.+<([^ \t]+@[^ \t]+)>.*$/ ) {
    $from =~ s/^.+<([^ \t]+@[^ \t]+)>.*$/$1/;
  }
  else {
    $from =~ s/^([^ \t]+@[^ \t]+)[ \t].*$/$1/;
  }
  $from =~ s/\r$//;
  $from =~ s/\n$//;

### ホワイトリストの確認(この例ではＤＢを見に行ってる
  eval {
    $dbh = DBI->connect("dbi:Pg:dbname=$dbname;host=$dbhost",$dbuser,$dbpass) or die  "cannot connect database.";
    $sth=$dbh->prepare( "select case exists(select * from \"EmailWhiteList\" where email = ? ) when true then 'Active' ELSE 'Non-Member' END" );
    $sth->bind_param(1,$from,{TYPE => SQL_VARCHAR});
    $sth->execute();
    $sth->bind_col(1, \$flag);
    $sth->fetch();
    $sth->finish();
    $dbh->disconnect();
  };
  $flag = "Unknown" if $@;

### ヘッダ X-Whitelist を付与して標準出力へ出力
  $entity->head->add("X-Whitelist",$flag);
  ###print $entity->print();
  $entity->print(\*STDOUT);
  $entity->purge();