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