メルマガ配信プログラム習作
#!/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;