メルマガ配信プログラム習作

 #!/usr/bin/perl
 
 use strict;
 use warnings;
 use utf8;
 use lib './lib';
 use MailMaga::Info;
 use MailMaga::Send;
 
 my $info = MailMaga::Info->new;
 my $send = MailMaga::Send->new;
 $send->send($info);

 package MailMaga::Info;
 
 use strict;
 use warnings;
 use base qw/Class::Accessor::Fast/;
 use utf8;
 use Encode;
 use Readonly;
 use DBI;
 use Data::Dumper;
 
 __PACKAGE__->mk_accessors(qw/dbh users body subject email_from should_send mailmaga_info_id/);
 
 # DB接続情報
 Readonly my $DB_HOST    => 'localhost';
 Readonly my $DB_NAME    => 'mydb';
 Readonly my $DB_USER    => 'root';
 Readonly my $DB_PASS    => 'root';
 # メルマガ送信元アドレス
 Readonly my $EMAIL_FROM => 'root@example.com';
 
 # コンストラクタ
 sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->init;
    return $self;
 }
 
 #------------------------------------------------------------------------------
 # 初期化
 #------------------------------------------------------------------------------
 sub init {
    my $self = shift;
 
    $self->db_connect;
    $self->email_from($EMAIL_FROM);
    $self->subject('件名');
    $self->body('本文');
    $self->should_send(0);
    if ($self->load_mailmaga_info) {
        $self->search_users;
    }
    $self->db_disconnect;
 }
 #------------------------------------------------------------------------------
 # DB接続
 #------------------------------------------------------------------------------
 sub db_connect {
    my $self = shift;
 
    my $dsn = "DBI:mysql:database=$DB_NAME;host=$DB_HOST";
    my $dbh = DBI->connect(
        $dsn, $DB_USER, $DB_PASS,
        {
            RaiseError        => 1,
            PrintError        => 1,
            AutoCommit        => 1,
            mysql_enable_utf8 => 1,
        }
    ) or die $DBI::errstr;
    $self->dbh($dbh);
 }
 
 #------------------------------------------------------------------------------
 # DB切断
 #------------------------------------------------------------------------------
 sub db_disconnect {
    my $self = shift;
    $self->dbh->disconnect;
 }
 #------------------------------------------------------------------------------
 # 会員情報検索
 #------------------------------------------------------------------------------
 sub search_users {
    my $self = shift;
 
    my $sql = "SELECT id, name, email FROM users WHERE ORDER BY id DESC";
    my $rows;
    eval {
        $rows = $self->dbh->selectall_arrayref($sql, {Slice => {}});
    };
    die $@ if $@;
    # デバッグのため、送信先メールアドレスをgmail管理者アドレスへ変換
    #foreach my $row (@$rows) {
    #   $row->{email} = sprintf 'test+%s@gmail.com', (split '@', $row->{email})[0];
    #}
    $self->users($rows);
 }
 #------------------------------------------------------------------------------
 # メルマガ情報取得
 #------------------------------------------------------------------------------
 sub load_mailmaga_info {
    my $self = shift;
 
    my $sql = <<"SQL";
 SELECT * FROM mailmaga_info
 WHERE send_time <= NOW() AND send_time + INTERVAL 3 HOUR >= NOW()
 AND status = 1
 ORDER BY mailmaga_info_id DESC LIMIT 1
 SQL
    my $row;
    eval {
        $row = $self->dbh->selectrow_hashref($sql);
    };
    die $@ if $@;
    if ($row) {
        $self->subject($row->{subject});
        $self->body($row->{body});
        $self->mailmaga_info_id($row->{mailmaga_info_id});
        $self->should_send(1);
        return 1;
   } else {
        $self->should_send(0);
        return 0;
   }
 }
 #------------------------------------------------------------------------------
 # ステータス変更
 #------------------------------------------------------------------------------
 sub update_status {
    my ( $self, $status ) = @_;
 
    $self->db_connect unless $self->dbh->ping;
    # 1: 送信待ち 2:送信中 3: 送信済み
    my $sql = "UPDATE mailmaga_info SET status = ? WHERE mailmaga_info_id = ?";
    eval { $self->dbh->do( $sql, {}, $status, $self->mailmaga_info_id ); };
    die $@ if $@;
    $self->db_disconnect;
 }
 
 # ステータスを送信中へ変更
 sub update_as_sending {
    my $self = shift;
    $self->update_status(2);
 }
 
 # ステータスを送信済みへ変更
 sub update_as_sent {
    my $self = shift;
    $self->update_status(3);
 }
 
 1;

 package MailMaga::Send;
 
 use strict;
 use warnings;
 use base qw/Class::Accessor::Fast/;
 use utf8;
 use Encode;
 use Encode::JP::Mobile;
 use Mail::Address::MobileJp;
 use MIME::Lite;
 use MIME::Base64;
 use Email::Valid::Loose;
 use Log::Log4perl qw/:easy/;
 use Readonly;
 use Data::Dumper;
 use Sys::Syslog;
 use Template;
 
 __PACKAGE__->mk_accessors();
 
 # メール送信詳細ログファイル
 Readonly my $LOG_FILE => 'test.log';
 # メール送信間隔（秒）
 Readonly my $SLEEP_TIME => 6;
 # メール送信間隔（通）
 Readonly my $SLEEP_MAILS => 100;
 
 # ------------------------------------------------------------------------------
 # コンストラクタ
 # ------------------------------------------------------------------------------
 sub new {
    my $class = shift;
    my $self = bless {}, $class;
 
    # syslog処理
    Log::Log4perl->easy_init( { level => $INFO, file => ">>$LOG_FILE" } );
    openlog "$0 $$", 'ndelay', 'user';
    return $self;
 }
 # ------------------------------------------------------------------------------
 # メール送信 (public)
 # ------------------------------------------------------------------------------
 sub send {
    my ( $self, $mg_info) = @_;
 
    # 送信すべきメルマガがなければ処理を抜ける
    if (!$mg_info->should_send) {
        syslog 'info', 'tried to send mail maga, but no mail maga to send';
        closelog;
        return;
    } else {
        syslog 'info', 'starting to send mail maga';
        # 送信中へ
        $mg_info->update_as_sending;
    }
 
    my $email_from = $mg_info->email_from;
    my $subject    = $mg_info->subject;
    my $body       = $mg_info->body;
 
    my @users      = @{$mg_info->users};
    my $cnt = 0;
    foreach my $user (@users) {
        # メールアドレスの妥当性を調べ、不完全なメールアドレスの場合、スキップする
        if ( Email::Valid::Loose->address( $user->{email} ) ) {
            # 本文の文面を差し替える
            my $tt = Template->new( { ENCODING => 'utf8' } ) || die "$Template::ERROR\n";
            my $_body = '';
            $tt->process( \$body, { nicname => $user->{nicname} }, \$_body );
            # メール送信
            $self->_send(
                {
                    email_from => $email_from,
                    email_to   => $user->{email},
                    subject    => $subject,
                    body       => $_body,
                }
            );
            INFO "SEND: ID $user->{id}, EMAIL $user->{email}";
            if (++$cnt % $SLEEP_MAILS == 0) {
                sleep $SLEEP_TIME;
            }
        }
        else {
            INFO "SKIP: ID $user->{id}, EMAIL $user->{email}";
        }
    }
 
    # 送信済みへ
    $mg_info->update_as_sent;
 
    syslog 'info', 'finished to send mail maga';
    closelog;
 }
 # ------------------------------------------------------------------------------
 # メール送信 (private)
 # ------------------------------------------------------------------------------
 sub _send {
    my ($self, $opt) = @_;
 
    my $email_from  = $opt->{email_from};
    my $email_to    = $opt->{email_to};
    my $subject     = $opt->{subject};
    my $body        = $opt->{body};
    my $subject_encoded =
      is_imode($email_to)
      ? '=?SHIFT-JIS?B?' . MIME::Base64::encode( encode( 'x-sjis-docomo', $subject ) ) . '?='
      : is_softbank($email_to)
      ? '=?UTF-8?B?' . MIME::Base64::encode( encode( 'x-utf8-softbank', $subject ) ) . '?='
      : is_ezweb($email_to) ? encode( 'x-sjis-kddi-auto', $subject )
      :   '=?ISO-2022-JP?B?' . MIME::Base64::encode( encode( 'iso-2022-jp', $subject ) ) . '?=';
    my $body_encoded =
        is_imode($email_to)    ? encode( 'x-sjis-docomo',    $body )
      : is_softbank($email_to) ? encode( 'x-utf8-softbank',  $body )
      : is_ezweb($email_to)    ? encode( 'x-sjis-kddi-auto', $body )
      :                          encode( 'iso-2022-jp', $body );
 
    my $msg = MIME::Lite->new(
        From     => $email_from,
        To       => $email_to,
        Subject  => $subject_encoded,
        Data     => $body_encoded,
        Encoding => '8bit',
    );
    $msg->attr( 'content-type' => 'text/plain' );
    $msg->attr(
        'content-type.charset' => (
              is_imode($email_to)    ? 'Shift_JIS'
            : is_softbank($email_to) ? 'UTF-8'
            : is_ezweb($email_to)    ? 'Shift_JIS'
            : 'ISO-2022-JP'
        )
    );
    $msg->send;
 }
 
 1;