良く使うんだがすぐに忘れるのでメモ。
use CGI;
my $F = CGI->new();
my $dir = $F->url;
$dir =~ s/[\/][^\/]*$//g;
use CGI;
my $F = CGI->new();
my $dir = $F->url;
$dir =~ s/[\/][^\/]*$//g;
Perlの最近のブログ記事
たま～にforkして子プロセスを起動する処理を呼んだとき、親プロセスで上記の「Lost connection to MySQL server during query」エラーや、httpヘッダエラーが発生していた。
特に決済まわりで使っているわけでもないし、トランザクションが絶対必要なわけでもないし、子プロセス内の処理はとりあえず最後まで完了してるし、いままで「ま、いっか」って感じで放置していたが、最近頻発するようになってきたので、ようやく真面目に取り組んでみる。
DBIに接続したときのステートメントハンドルの扱い方が悪いんじゃないかっていいうのはうすうす気づいてたが、下記のような資料を発見。ありがたや。
http://d.hatena.ne.jp/hiratara/20110122/1295711939
http://nihen.hatenablog.com/entry/2011/11/17/102557
これの真似して、子プロセス生成直後に
$dbh->{InactiveDestroy} = 1;
$dbh = $dbh->clone({InactiveDestroy => 0});
を呼んだらなんとあっさり解決。
以前にこんなこと↓
http://www.igreks.jp/dev/2010/06/forkmysql.html
書いてたけど、やっぱ親プロセスと同じコネクションつかっちゃまずいわけね。
Apacheのせいにしてごめんなさいって感じですね。
特に決済まわりで使っているわけでもないし、トランザクションが絶対必要なわけでもないし、子プロセス内の処理はとりあえず最後まで完了してるし、いままで「ま、いっか」って感じで放置していたが、最近頻発するようになってきたので、ようやく真面目に取り組んでみる。
DBIに接続したときのステートメントハンドルの扱い方が悪いんじゃないかっていいうのはうすうす気づいてたが、下記のような資料を発見。ありがたや。
http://d.hatena.ne.jp/hiratara/20110122/1295711939
http://nihen.hatenablog.com/entry/2011/11/17/102557
これの真似して、子プロセス生成直後に
$dbh->{InactiveDestroy} = 1;
$dbh = $dbh->clone({InactiveDestroy => 0});
を呼んだらなんとあっさり解決。
以前にこんなこと↓
http://www.igreks.jp/dev/2010/06/forkmysql.html
書いてたけど、やっぱ親プロセスと同じコネクションつかっちゃまずいわけね。
Apacheのせいにしてごめんなさいって感じですね。
スクリプト側の配列をテンプレートに反映させるとき、すべての値をそのまま出力するならいいのだが、値が1のときは「checked」、0の時は空白文字列を出力したい時などがある。
例えば、以下のようなテンプレートがあったとき。
■test.tpl
--------------------------------------------------------------------------------------
<TMPL_IF NAME="users">
<ul>
<TMPL_LOOP NAME="users">
<li>
名前：<TMPL_VAR NAME="user_name">
</li>
<li>
<input type='checkbox' name='pub_name_on' value='1' <TMPL_VAR NAME="pub_name"> /> 名前を公開する
</li>
</TMPL_LOOP>
</ul>
<TMPL_ELSE>
<p>要素がありません</p>
</TMPL_IF>
--------------------------------------------------------------------------------------
スクリプト側をオーソドックスに書くとこんな感じ
■test.cgi
--------------------------------------------------------------------------------------
use strict;
use HTML::Template;
# オブジェクト生成
my $tpl = HTML::Template->new( filename => 'test.tpl');
#ユーザ情報を2次元配列にセット
my @users = (
['山田 太郎', 0], # 「0」は名前非公開
['鈴木 一郎', 1] # 「1」は名前公開
);
#ループ格納用配列作成
my @lood_data = ();
while (@users) {
# 各行のハッシュ作成
my %row_data = ();
# 配列データを格納
$row_data{'user_name'} = $$_[0];
$row_data{'pub_name'} = $$_[1];
# $row_data{'pub_name'} が1だったら「checked」に変更
$row_data{'pub_name'} = $row_data{'pub_name'} == 1 ? 'checked' : '';
# リファレンスでループ用配列に追加
push(@loop_data, \%row_data);
}
# paramメソッド実行
$tpl->param('users' => \@loop_data);
#出力
$tpl->output(print_to => \*STDOUT);
--------------------------------------------------------------------------------------
しかしこれだと、各値をいちいちハッシュにしたり面倒くさいので、下記のようにmapを用いてさらにその中で条件分岐も済ませると楽ちん。
■test2.cgi
--------------------------------------------------------------------------------------
use strict;
use HTML::Template;
# オブジェクト生成
my $tpl = HTML::Template->new( filename => 'test.tpl');
#ユーザ情報を2次元配列にセット
my @users = (
['山田 太郎', 0], # 「0」は名前非公開
['鈴木 一郎', 1] # 「1」は名前公開
);
# mapを使ってパラメータを一気に作成
my %params = ('users' => [
map { +{
user_name => $$_[0],
pub_name => $$_[1] == 1 ? 'checked' : '' # ←ここで条件分岐
}} @users
]);
# paramメソッド実行
$tpl->param(%params);
#出力
$tpl->output(print_to => \*STDOUT);
--------------------------------------------------------------------------------------
こんなかんじです。
例えば、以下のようなテンプレートがあったとき。
■test.tpl
--------------------------------------------------------------------------------------
<TMPL_IF NAME="users">
<ul>
<TMPL_LOOP NAME="users">
<li>
名前：<TMPL_VAR NAME="user_name">
</li>
<li>
<input type='checkbox' name='pub_name_on' value='1' <TMPL_VAR NAME="pub_name"> /> 名前を公開する
</li>
</TMPL_LOOP>
</ul>
<TMPL_ELSE>
<p>要素がありません</p>
</TMPL_IF>
--------------------------------------------------------------------------------------
スクリプト側をオーソドックスに書くとこんな感じ
■test.cgi
--------------------------------------------------------------------------------------
use strict;
use HTML::Template;
# オブジェクト生成
my $tpl = HTML::Template->new( filename => 'test.tpl');
#ユーザ情報を2次元配列にセット
my @users = (
['山田 太郎', 0], # 「0」は名前非公開
['鈴木 一郎', 1] # 「1」は名前公開
);
#ループ格納用配列作成
my @lood_data = ();
while (@users) {
# 各行のハッシュ作成
my %row_data = ();
# 配列データを格納
$row_data{'user_name'} = $$_[0];
$row_data{'pub_name'} = $$_[1];
# $row_data{'pub_name'} が1だったら「checked」に変更
$row_data{'pub_name'} = $row_data{'pub_name'} == 1 ? 'checked' : '';
# リファレンスでループ用配列に追加
push(@loop_data, \%row_data);
}
# paramメソッド実行
$tpl->param('users' => \@loop_data);
#出力
$tpl->output(print_to => \*STDOUT);
--------------------------------------------------------------------------------------
しかしこれだと、各値をいちいちハッシュにしたり面倒くさいので、下記のようにmapを用いてさらにその中で条件分岐も済ませると楽ちん。
■test2.cgi
--------------------------------------------------------------------------------------
use strict;
use HTML::Template;
# オブジェクト生成
my $tpl = HTML::Template->new( filename => 'test.tpl');
#ユーザ情報を2次元配列にセット
my @users = (
['山田 太郎', 0], # 「0」は名前非公開
['鈴木 一郎', 1] # 「1」は名前公開
);
# mapを使ってパラメータを一気に作成
my %params = ('users' => [
map { +{
user_name => $$_[0],
pub_name => $$_[1] == 1 ? 'checked' : '' # ←ここで条件分岐
}} @users
]);
# paramメソッド実行
$tpl->param(%params);
#出力
$tpl->output(print_to => \*STDOUT);
--------------------------------------------------------------------------------------
こんなかんじです。
MilkyStepのコミュニティでコアサーバを使ったとき、メルマガのデフォルト登録完了画面が文字化けする（日本語部分が???になる）との報告を受け、一時期かなり調査を行ったが解決せず。
それから約２カ月後、他のユーザから同様の現象が報告された。
開発環境では全くそのような現象が起こらないので、仕方なく、コアサーバーを実際に借りてMilkyStepを設置し徹底的に調査することにした。
表示させるデフォルト画面のHTMLソースは、ユーザが自由に編集できるようになっているのだが、そのソースはMySQLに保存される。
そこからデータを引っ張って、少し置換処理してからプログラムで出力する。
確かにコアサーバで実際に試してみると、5回中4回くらいの割合で日本語が「？」になる。
（成功する場合もある）
MySQLの文字セットはutf8、照合順序もutf8_general_ci、さらにSQL発行時に毎回「SET NAMES utf8」（MySQL4.1以降で有効）しているので、データ通信間で化けるとは考えにくい。
もちろんスクリプトのファイルもUTF8。
とりあえず、ブラウザの文字コードの誤判定臭いので、日本語を多めに入れたり、EUCでいうところの「美乳テーブル」である、郵便くんマーク（〠←これ）を冒頭に入れたりしてみたが、変わらず。
次に、Perlでutf8扱う時によくある、utf8フラグあるなしの問題かとも思い、「use utf8」したりEncode::encode/decodeしたりいろいろやったが、どうやら関係ないっぽい。
というか、なんかMySQLから参照した時点ですでに化けてるっぽい。
試しに、SELECT時に、以下のような感じで、明示的に照合順序を指定してみる。
まず、
--------------------------------------------------------------------------------
SELECT column_name COLLATE utf8_general_ci FROM ・・・・・
--------------------------------------------------------------------------------
・・・変化なし。
次に、
--------------------------------------------------------------------------------
SELECT COERCIBILITY(column_name COLLATE utf8_general_ci) FROM ・・・
--------------------------------------------------------------------------------
お、1回目はうまくいった。
もう1回。
--------------------------------------------------------------------------------
Software error:
COLLATION 'utf8' is not valid for CHARACTER SET 'latin1_swedish_ci' at ......
--------------------------------------------------------------------------------
あれあれ？？？？
「utf8_general_ciでの照合はCHARACTER SET 'latin1'では有効ではありません」
latin1？？なんで勝手に文字セット変わってんだよ！
utf8で固定だろーが！
なぜ、コアサーバだけ、しかも特定のカラムの文字列だけ参照するときにこうなるのか・・・
MySQL4から5に強引に移行した時の忘れものか？
とにかくこの、参照時に勝手にテーブルの文字コードをLatin1と判別するわけのわからない現象と格闘すること数時間。
そもそもこの処理って、forkした後の親プロセスの中でやっていたんだが、このforkを切ったらなぜか正常になった。
ということで、この処理はforkの中から外に出すことに決定。
いまだに原因はよくわからないが、fork時は内部的に変数を子プロセスにコピーするが、その時点で（コアサーバでは）なんか問題があるらしいってことはぼんやりわかった。
サーバサイドのアプリを広く対応するのはやっぱ一苦労だな・・・
それから約２カ月後、他のユーザから同様の現象が報告された。
開発環境では全くそのような現象が起こらないので、仕方なく、コアサーバーを実際に借りてMilkyStepを設置し徹底的に調査することにした。
表示させるデフォルト画面のHTMLソースは、ユーザが自由に編集できるようになっているのだが、そのソースはMySQLに保存される。
そこからデータを引っ張って、少し置換処理してからプログラムで出力する。
確かにコアサーバで実際に試してみると、5回中4回くらいの割合で日本語が「？」になる。
（成功する場合もある）
MySQLの文字セットはutf8、照合順序もutf8_general_ci、さらにSQL発行時に毎回「SET NAMES utf8」（MySQL4.1以降で有効）しているので、データ通信間で化けるとは考えにくい。
もちろんスクリプトのファイルもUTF8。
とりあえず、ブラウザの文字コードの誤判定臭いので、日本語を多めに入れたり、EUCでいうところの「美乳テーブル」である、郵便くんマーク（〠←これ）を冒頭に入れたりしてみたが、変わらず。
次に、Perlでutf8扱う時によくある、utf8フラグあるなしの問題かとも思い、「use utf8」したりEncode::encode/decodeしたりいろいろやったが、どうやら関係ないっぽい。
というか、なんかMySQLから参照した時点ですでに化けてるっぽい。
試しに、SELECT時に、以下のような感じで、明示的に照合順序を指定してみる。
まず、
--------------------------------------------------------------------------------
SELECT column_name COLLATE utf8_general_ci FROM ・・・・・
--------------------------------------------------------------------------------
・・・変化なし。
次に、
--------------------------------------------------------------------------------
SELECT COERCIBILITY(column_name COLLATE utf8_general_ci) FROM ・・・
--------------------------------------------------------------------------------
お、1回目はうまくいった。
もう1回。
--------------------------------------------------------------------------------
Software error:
COLLATION 'utf8' is not valid for CHARACTER SET 'latin1_swedish_ci' at ......
--------------------------------------------------------------------------------
あれあれ？？？？
「utf8_general_ciでの照合はCHARACTER SET 'latin1'では有効ではありません」
latin1？？なんで勝手に文字セット変わってんだよ！
utf8で固定だろーが！
なぜ、コアサーバだけ、しかも特定のカラムの文字列だけ参照するときにこうなるのか・・・
MySQL4から5に強引に移行した時の忘れものか？
とにかくこの、参照時に勝手にテーブルの文字コードをLatin1と判別するわけのわからない現象と格闘すること数時間。
そもそもこの処理って、forkした後の親プロセスの中でやっていたんだが、このforkを切ったらなぜか正常になった。
ということで、この処理はforkの中から外に出すことに決定。
いまだに原因はよくわからないが、fork時は内部的に変数を子プロセスにコピーするが、その時点で（コアサーバでは）なんか問題があるらしいってことはぼんやりわかった。
サーバサイドのアプリを広く対応するのはやっぱ一苦労だな・・・
システム開発上、ユーザがブラウザからメールマガジンを作成した時に、同時にエラーメール処理用のアドレスも作成されるようにする、逆にメルマガを削除したらそのアドレスも削除される必要があったためメモ。
今回のMTAはqmailを使うとのことで、アカウントの管理は必然的にvpopmailとなる。
しかし、qmailadminを使わないで新規アカウント作成（vadduser）・削除（vdeluser）を行うためには、基本的にrootでの操作となる。
単純にスクリプト内で
system("/home/vpopmail/bin/vadduser hoge@hoge.jp hogepass");
とやっただけでは、もちろんうまくいくはずがない。
というわけで、Cと連携して上手いことやってくれるモジュール様がないかと、CPANを探してみたらありました。
その名も「vpopmail.pm」。
呼び出す関数名もまさにvpopmailコマンドとほぼ同じ。
しかし、最終リリースは2001年・・・やばいんじゃないの？
かろうじてCPAN.pmをからインストールできたものの、説明も短すぎて、当然
use vpopmail;
vadduser（引数いろいろ）;
とかやれば新規にアカウントを作ってくれると思いきや全然ダメ。
vpopmailのバージョンを見てきてくれる関数だけはなぜか動いた（笑）
まあ、関数名も最近のvpopmailのコマンドといまいち合ってないし。
というわけでさんざん悩んだ結果、sudoを使うことで決定。
以下手順。
１．新規バーチャルアカウントを作成する簡単なスクリプト（vadduser.cgi）を作成しCGIの動くディレクトリに置く。
vadduser.cgi
-----------------------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
# コマンド発行
`sudo -u root /home/vpopmail/bin/vadduser hoge@hoge.jp hogepass`;
exit;
1
-----------------------------------------------------------------------------------------
２．sudoの設定ファイルに許可コマンドを追記
# visudo
（以下を追記）
apache ALL=(root) NOPASSWD: /home/vpopmail/bin/vadduser,/home/vpopmail/bin/vdeluser
同時に、以下の行をコメント化
Defaults requiretty
↓
#Defaults requiretty
※これをコメント化しないと、最近のLinuxでは、
sudo: apache : sorry, you must have a tty to run sudo ; TTY=unknown ;......
と怒られる。
このエラーは、/var/log/secure を見ればわかる。
保存して終了
:wq
３．vadduser.cgiをブラウザから実行してみる。
４．確認
popアカウント一覧に、「hoge」が追加されているのを確認
同時に、/home/vpopmail/domains/hoge@hoge.jp 内に、ディレクトリ「hoge」が作成されているのでOK！！
ああ疲れた今回も。
実務的には、このvadduser.cgiをAPIとしてドキュメントルート外に置いて、第三者からは直接アクセスされないようにし、他のCGIからシステムコールで呼んだりした方がセキュアかなと。
参考URL：
http://hibari.2ch.net/test/read.cgi/php/1024741312/l50
http://d.hatena.ne.jp/kakurasan/20100512/p1
http://old.ikoinoba.net/index.php?UID=1188143501
http://search.cpan.org/~sscanlon/vpopmail-0.08/
今回のMTAはqmailを使うとのことで、アカウントの管理は必然的にvpopmailとなる。
しかし、qmailadminを使わないで新規アカウント作成（vadduser）・削除（vdeluser）を行うためには、基本的にrootでの操作となる。
単純にスクリプト内で
system("/home/vpopmail/bin/vadduser hoge@hoge.jp hogepass");
とやっただけでは、もちろんうまくいくはずがない。
というわけで、Cと連携して上手いことやってくれるモジュール様がないかと、CPANを探してみたらありました。
その名も「vpopmail.pm」。
呼び出す関数名もまさにvpopmailコマンドとほぼ同じ。
しかし、最終リリースは2001年・・・やばいんじゃないの？
かろうじてCPAN.pmをからインストールできたものの、説明も短すぎて、当然
use vpopmail;
vadduser（引数いろいろ）;
とかやれば新規にアカウントを作ってくれると思いきや全然ダメ。
vpopmailのバージョンを見てきてくれる関数だけはなぜか動いた（笑）
まあ、関数名も最近のvpopmailのコマンドといまいち合ってないし。
というわけでさんざん悩んだ結果、sudoを使うことで決定。
以下手順。
１．新規バーチャルアカウントを作成する簡単なスクリプト（vadduser.cgi）を作成しCGIの動くディレクトリに置く。
vadduser.cgi
-----------------------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
# コマンド発行
`sudo -u root /home/vpopmail/bin/vadduser hoge@hoge.jp hogepass`;
exit;
1
-----------------------------------------------------------------------------------------
２．sudoの設定ファイルに許可コマンドを追記
# visudo
（以下を追記）
apache ALL=(root) NOPASSWD: /home/vpopmail/bin/vadduser,/home/vpopmail/bin/vdeluser
同時に、以下の行をコメント化
Defaults requiretty
↓
#Defaults requiretty
※これをコメント化しないと、最近のLinuxでは、
sudo: apache : sorry, you must have a tty to run sudo ; TTY=unknown ;......
と怒られる。
このエラーは、/var/log/secure を見ればわかる。
保存して終了
:wq
３．vadduser.cgiをブラウザから実行してみる。
４．確認
popアカウント一覧に、「hoge」が追加されているのを確認
同時に、/home/vpopmail/domains/hoge@hoge.jp 内に、ディレクトリ「hoge」が作成されているのでOK！！
ああ疲れた今回も。
実務的には、このvadduser.cgiをAPIとしてドキュメントルート外に置いて、第三者からは直接アクセスされないようにし、他のCGIからシステムコールで呼んだりした方がセキュアかなと。
参考URL：
http://hibari.2ch.net/test/read.cgi/php/1024741312/l50
http://d.hatena.ne.jp/kakurasan/20100512/p1
http://old.ikoinoba.net/index.php?UID=1188143501
http://search.cpan.org/~sscanlon/vpopmail-0.08/
これはGD::Barcode::QRcodeを用いたQRコード生成処理時に発生したエラー。
同じようなエラーに関しての記事が数件見つかったのでメモ。
http://xiaoxia.exblog.jp/6226189/
http://php.net/manual/ja/image.requirements.php
↓上記ページからの引用
操作できるイメージの形式は、インストールされている GDとこれらのイメージフォーマットにアクセスする ためにGDが必要とするその他のライブラリに依存し ます。
gd-1.6より前のバージョンのgdは、GIF イメージ画像をサポートし ていますが、PNG はサポートしていません。
一方、gd-1.6以降でgd-2.0.28未満の バージョンはPNGをサポートし、GIFはサポートしていません。
GIF サポートは、gd-2.0.28で再度有効になりました。
つまり、GDライブラリのバージョンによってはGIFをサポートしていないので、標題のようなエラーが発生するらしい。
GDライブラリのバージョンを変えたり、依存する各種libを変えたりすれば解決できるようだが、共用サーバだったり、インストール権限が無いユーザでは難しい。
というわけで、得意のevalを使って対処。
※gifをサポートしていなければpng、pngをサポートしていなければjpegで出力する
※すべてのGDライブラリのバージョンを調査したわけではないが、gifもpngもjpegもサポートしていなかったらダメ。多分それはありえないが。
以下サンプルコード
-----------------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
use GD::Barcode::QRcode;
#オブジェクト生成
my $qr_obj = GD::Barcode::QRcode->new(
'http://example.jp', #QR化する文字列
{ ModuleSize => 2 } # Ecc & Versionはauto select
);
my $qr_img = '';
my $ext = 'gif'; #拡張子
eval { $qr_img = $qr_obj->plot()->gif(); };
if($@){
$ext = 'png';
eval { $qr_img = $qr_obj->plot()->png(); };
if($@){
$ext = 'jpeg';
eval { $qr_img = $qr_obj->plot()->jpeg(); };
if($@){
die "gif, png, jpeg are not supported!!";
}
}
}
#書き出し
my $fh;
open($fh,">QRcode.$ext");
binmode $fh;
print $fh ($qr_img);
close $fh;
-----------------------------------------------------------------------------------
ちなみにGDライブラリのインストール権限をお持ちの方は、以下から最新版のGDライブラリをダウンロードして根本解決することも可。
http://www.libgd.org/releases/
同じようなエラーに関しての記事が数件見つかったのでメモ。
http://xiaoxia.exblog.jp/6226189/
http://php.net/manual/ja/image.requirements.php
↓上記ページからの引用
操作できるイメージの形式は、インストールされている GDとこれらのイメージフォーマットにアクセスする ためにGDが必要とするその他のライブラリに依存し ます。
gd-1.6より前のバージョンのgdは、GIF イメージ画像をサポートし ていますが、PNG はサポートしていません。
一方、gd-1.6以降でgd-2.0.28未満の バージョンはPNGをサポートし、GIFはサポートしていません。
GIF サポートは、gd-2.0.28で再度有効になりました。
つまり、GDライブラリのバージョンによってはGIFをサポートしていないので、標題のようなエラーが発生するらしい。
GDライブラリのバージョンを変えたり、依存する各種libを変えたりすれば解決できるようだが、共用サーバだったり、インストール権限が無いユーザでは難しい。
というわけで、得意のevalを使って対処。
※gifをサポートしていなければpng、pngをサポートしていなければjpegで出力する
※すべてのGDライブラリのバージョンを調査したわけではないが、gifもpngもjpegもサポートしていなかったらダメ。多分それはありえないが。
以下サンプルコード
-----------------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
use GD::Barcode::QRcode;
#オブジェクト生成
my $qr_obj = GD::Barcode::QRcode->new(
'http://example.jp', #QR化する文字列
{ ModuleSize => 2 } # Ecc & Versionはauto select
);
my $qr_img = '';
my $ext = 'gif'; #拡張子
eval { $qr_img = $qr_obj->plot()->gif(); };
if($@){
$ext = 'png';
eval { $qr_img = $qr_obj->plot()->png(); };
if($@){
$ext = 'jpeg';
eval { $qr_img = $qr_obj->plot()->jpeg(); };
if($@){
die "gif, png, jpeg are not supported!!";
}
}
}
#書き出し
my $fh;
open($fh,">QRcode.$ext");
binmode $fh;
print $fh ($qr_img);
close $fh;
-----------------------------------------------------------------------------------
ちなみにGDライブラリのインストール権限をお持ちの方は、以下から最新版のGDライブラリをダウンロードして根本解決することも可。
http://www.libgd.org/releases/
例えば、長い文字列
「あいうえおかきくけこさしすせそ」を
「あいうえお...」みたいに、
指定の文字数以降は省略したい場合。
ただ単にバイト数で切ってしまうと、日本語の場合は余るバイトがでてくるので、そのへんをちゃんとしないとダメ。
以下、UTF8の場合の処理
----------------------------------------------------------------------------------
my #str = "あいうえおかきくけこさしすせそ"; # 元の文字列
my $view = 10; # 10文字まで表示し後は省略
print &main::round_utf8($str,$view);
sub round_utf8 {
my ($str,$view) = @_;
my $one = "[\x00-\x7F]"; # 1バイト文字
my $two = "[\xC2-\xDF][\x80-\xBF]"; # 2バイト文字
my $three = "[\xE0-\xEF][\x80-\xBF]{2}"; # 3バイト文字
my $bigger = "[\xF0-\xF7][\x80-\xBF]{3,}"; # 4バイト以上
$str =~ s/^(($one|$two|$three|$bigger){$view}).+/$1.../g;
return $str;
}
----------------------------------------------------------------------------------
EUCやSJISの場合も、サブルーチン中のバイト列の定義を変えれば同じ。
「あいうえおかきくけこさしすせそ」を
「あいうえお...」みたいに、
指定の文字数以降は省略したい場合。
ただ単にバイト数で切ってしまうと、日本語の場合は余るバイトがでてくるので、そのへんをちゃんとしないとダメ。
以下、UTF8の場合の処理
----------------------------------------------------------------------------------
my #str = "あいうえおかきくけこさしすせそ"; # 元の文字列
my $view = 10; # 10文字まで表示し後は省略
print &main::round_utf8($str,$view);
sub round_utf8 {
my ($str,$view) = @_;
my $one = "[\x00-\x7F]"; # 1バイト文字
my $two = "[\xC2-\xDF][\x80-\xBF]"; # 2バイト文字
my $three = "[\xE0-\xEF][\x80-\xBF]{2}"; # 3バイト文字
my $bigger = "[\xF0-\xF7][\x80-\xBF]{3,}"; # 4バイト以上
$str =~ s/^(($one|$two|$three|$bigger){$view}).+/$1.../g;
return $str;
}
----------------------------------------------------------------------------------
EUCやSJISの場合も、サブルーチン中のバイト列の定義を変えれば同じ。
共用サーバなどでCPU一定時間使用でプロセスが切断されてしまう。
したがって、ゆっくりメール配信してると、配信が途中で終わってしまうのでその対策。
---------------------------------------------------------------------------------------------
# 宛先セット
my @to = ('aaa@aaa.com','bbb@bbb.com','ccc@ccc.com',.....);
# 指定事項
my $mass = 10; # 一斉送信数
my $intervals = 60; # 待機時間（秒）
my $switch_proc = 1; # プロセス切り替えを行う場合は1
my $switch_time = 30; # プロセス切り替え時間（秒）
#プロセス開始時間セット
my $proc_start = time;
# ループ開始
for(my $i=0; $i<@to; $i++){
# SENDラベル開始
SEND:{
# メール配信処理開始
if(!open(MAIL, "| /usr/lib/sendmail")) {
die "※Open failed sendmail!";
}
print MAIL <<EOM;
From: from@from.com
To: $to[$i]
Return-Path: from@from.com
Reply-To: from@from.com
Subject: TEST MAIL
Content-type: text/plain; Charset="ISO2022-JP"
Content-Transfer-Encodeing: 7bit
Here is mailbody
EOM
close MAIL;
# メール配信処理終了
if($mass != 0 && $intervals != 0){
if(($i+1) % $mass == 0 && $i+1 != @to){
# 一斉送信数を送信後の待機
for(my $sec=0; $sec<$intervals; $sec++){
# WAITラベル開始
WAIT: {
# 1秒スリープ
select(undef,undef,undef,1);
if($switch_proc && (time - $proc_start) >= $switch_time && ($sec+1 != $intervals)){
my $new_pid = '';
if($new_pid = fork){
# 子プロセス生成に成功したら終了
exit;
}
elsif(defined $new_pid) {
# プロセス開始時刻更新
$proc_start = time;
&db::open(); # 念のためDB再接続処理（詳細割愛）
$sec++; # ここでインクリメントしないと無限ループになるので注意
redo WAIT;
}
else{
# プロセスが多すぎたり、一時的にフォークできないときは次回
next;
}
}
}# end of WAIT
}
}
}
# 同様の処理
if($switch_proc && (time - $proc_start) >= $switch_time && ($i+1 != @to)){
my $new_pid = '';
if($new_pid = fork){
exit;
}
elsif(defined $new_pid) {
$proc_start = time;
&db::open();
$i++;
redo SEND;
}
else{
next; # もしくはエラー終了
}
}
}# end of SEND
}# end of for
したがって、ゆっくりメール配信してると、配信が途中で終わってしまうのでその対策。
---------------------------------------------------------------------------------------------
# 宛先セット
my @to = ('aaa@aaa.com','bbb@bbb.com','ccc@ccc.com',.....);
# 指定事項
my $mass = 10; # 一斉送信数
my $intervals = 60; # 待機時間（秒）
my $switch_proc = 1; # プロセス切り替えを行う場合は1
my $switch_time = 30; # プロセス切り替え時間（秒）
#プロセス開始時間セット
my $proc_start = time;
# ループ開始
for(my $i=0; $i<@to; $i++){
# SENDラベル開始
SEND:{
# メール配信処理開始
if(!open(MAIL, "| /usr/lib/sendmail")) {
die "※Open failed sendmail!";
}
print MAIL <<EOM;
From: from@from.com
To: $to[$i]
Return-Path: from@from.com
Reply-To: from@from.com
Subject: TEST MAIL
Content-type: text/plain; Charset="ISO2022-JP"
Content-Transfer-Encodeing: 7bit
Here is mailbody
EOM
close MAIL;
# メール配信処理終了
if($mass != 0 && $intervals != 0){
if(($i+1) % $mass == 0 && $i+1 != @to){
# 一斉送信数を送信後の待機
for(my $sec=0; $sec<$intervals; $sec++){
# WAITラベル開始
WAIT: {
# 1秒スリープ
select(undef,undef,undef,1);
if($switch_proc && (time - $proc_start) >= $switch_time && ($sec+1 != $intervals)){
my $new_pid = '';
if($new_pid = fork){
# 子プロセス生成に成功したら終了
exit;
}
elsif(defined $new_pid) {
# プロセス開始時刻更新
$proc_start = time;
&db::open(); # 念のためDB再接続処理（詳細割愛）
$sec++; # ここでインクリメントしないと無限ループになるので注意
redo WAIT;
}
else{
# プロセスが多すぎたり、一時的にフォークできないときは次回
next;
}
}
}# end of WAIT
}
}
}
# 同様の処理
if($switch_proc && (time - $proc_start) >= $switch_time && ($i+1 != @to)){
my $new_pid = '';
if($new_pid = fork){
exit;
}
elsif(defined $new_pid) {
$proc_start = time;
&db::open();
$i++;
redo SEND;
}
else{
next; # もしくはエラー終了
}
}
}# end of SEND
}# end of for
子プロセスに処理を渡して、親プロセスで標準出力を切るとき、
my $pid;
if($pid = fork){
#親の処理
close (STDOUT);
wait;
}
elsif(defined $pid){
close (STDOUT);
#子の処理
}
・
・
・
みたいな感じで今までOKだったのだが、ロリポップ系サーバなどではこれがうまく行かない。ブラウザの出力自体は切れるのだが、子プロセスの処理を行ってくれない。
WEBサーバによって変わると聞いたことがあるので、ググってみたところ、標準出力を切る部分を、
close (STDOUT);
close (STDERR);
close (STDIN);
とやったら上手く行った。
apache2.0系（うちの環境）とapache1.3系（ロリポップ系？）でどうやら違うらしい。
ちなみに、上記3つの順番が違っても1つ足りなくてもダメだった。
close (STDIN);
close (STDOUT);
close (STDERR);
↑これだとなぜか子プロセスが終了するまでブラウザが開放されない
close (STDOUT);
close (STDERR);
close (STDIN);
↑この順番じゃないとダメみたい。
STDOUTだけだと、新しいapacheのときダメだよって聞いていたので、それとは逆の現象だが、解決したからまあいいか。
my $pid;
if($pid = fork){
#親の処理
close (STDOUT);
wait;
}
elsif(defined $pid){
close (STDOUT);
#子の処理
}
・
・
・
みたいな感じで今までOKだったのだが、ロリポップ系サーバなどではこれがうまく行かない。ブラウザの出力自体は切れるのだが、子プロセスの処理を行ってくれない。
WEBサーバによって変わると聞いたことがあるので、ググってみたところ、標準出力を切る部分を、
close (STDOUT);
close (STDERR);
close (STDIN);
とやったら上手く行った。
apache2.0系（うちの環境）とapache1.3系（ロリポップ系？）でどうやら違うらしい。
ちなみに、上記3つの順番が違っても1つ足りなくてもダメだった。
close (STDIN);
close (STDOUT);
close (STDERR);
↑これだとなぜか子プロセスが終了するまでブラウザが開放されない
close (STDOUT);
close (STDERR);
close (STDIN);
↑この順番じゃないとダメみたい。
STDOUTだけだと、新しいapacheのときダメだよって聞いていたので、それとは逆の現象だが、解決したからまあいいか。
私はDocomoの携帯しか持ってないので、事前にauとsoftbankを持ってる友人に頼んで、メールヘッダなどを調査したらこんな感じ↓
■ Docomo
----------------------------------------------------------------------------------
From ****@docomo.ne.jp Wed May 26 17:54:11 2010
Return-Path: <****@docomo.ne.jp>
X-Original-To: ***@igreks.jp
Delivered-To: ***@igreks.jp
Received: from localhost (localhost.localdomain [127.0.0.1])
by ***.igreks.jp (Postfix) with ESMTP id 5DE338B41B2
for <***@igreks.jp>; Wed, 26 May 2010 17:54:11 +0900 (JST)
X-Virus-Scanned: amavisd-new at igreks.jp
Received: from ***.igreks.jp ([127.0.0.1])
by localhost (igreks.jp [127.0.0.1]) (amavisd-new, port ****)
with ESMTP id kkpANBxiUasa for <****@igreks.jp>;
Wed, 26 May 2010 17:54:11 +0900 (JST)
Received: from docomo.ne.jp (mail108.docomo.ne.jp [203.138.203.8])
by ***.igreks.jp (Postfix) with ESMTP id 3E6618B40B0
for <***@igreks.jp>; Wed, 26 May 2010 17:54:11 +0900 (JST)
Date: Wed, 26 May 2010 17:54:09 +0900 (JST)
From: ****@docomo.ne.jp
To: ***@igreks.jp
Subject: =?iso-2022-jp?B?GyRCMSsbKEI=?=
Message-ID:
MIME-Version: 1.0
Content-Type: text/plain; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit
$BK\J8(B
----------------------------------------------------------------------------------
■ au
----------------------------------------------------------------------------------
From ****@ezweb.ne.jp Wed May 26 18:24:29 2010
Return-Path: <****@ezweb.ne.jp>
X-Original-To: ***@igreks.jp
Delivered-To: ***@igreks.jp
Received: from localhost (localhost.localdomain [127.0.0.1])
by ***.igreks.jp (Postfix) with ESMTP id F1F818B41B2
for <***@igreks.jp>; Wed, 26 May 2010 18:24:28 +0900 (JST)
X-Virus-Scanned: amavisd-new at igreks.jp
Received: from ***.igreks.jp ([127.0.0.1])
by localhost (igreks.jp [127.0.0.1]) (amavisd-new, port ****)
with ESMTP id CBSY6-Rv+mf6 for <***@igreks.jp>;
Wed, 26 May 2010 18:24:28 +0900 (JST)
Received: from ezweb.ne.jp (nx3oBP07-06.ezweb.ne.jp [59.135.39.240])
by ***.igreks.jp (Postfix) with ESMTP id D7FC88B40B0
for <***@igreks.jp>; Wed, 26 May 2010 18:24:28 +0900 (JST)
Received: from nxev04mp06 (localhost [127.0.0.1])
by nxev04mp06.ezweb.ne.jp (EZweb Mail) with SMTP id 955ED5BC640B4
for <***@igreks.jp>; Wed, 26 May 2010 18:24:28 +0900 (JST)
From: ****@ezweb.ne.jp
To: ***@igreks.jp
Subject: =?iso-2022-jp?B?GyRCMSsbKEI=?=
Message-ID: <2010052618242860697200007c12@nxev04mp06.ezweb.ne.jp>
Date: Wed, 26 May 2010 18:24:28 +0900
Mime-Version: 1.0
Content-Type: text/plain; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit
$B%6!<%6!<(B
----------------------------------------------------------------------------------
■ Softbank
----------------------------------------------------------------------------------
From ****@softbank.ne.jp Wed May 26 18:24:36 2010
Return-Path: <****@softbank.ne.jp>
X-Original-To: ***@igreks.jp
Delivered-To: ***@igreks.jp
Received: from localhost (localhost.localdomain [127.0.0.1])
by ***.igreks.jp (Postfix) with ESMTP id 975BD8B41B2
for <***@igreks.jp>; Wed, 26 May 2010 18:24:36 +0900 (JST)
X-Virus-Scanned: amavisd-new at igreks.jp
Received: from ***.igreks.jp ([127.0.0.1])
by localhost (igreks.jp [127.0.0.1]) (amavisd-new, port ****)
with ESMTP id HQrmiDMGcT3n for <***@igreks.jp>;
Wed, 26 May 2010 18:24:36 +0900 (JST)
Received: from mmrts049p01c.softbank.ne.jp (mmrts049p01c.softbank.ne.jp [123.108.236.27])
by ***.igreks.jp (Postfix) with SMTP id 6D9898B40B0
for <***@igreks.jp>; Wed, 26 May 2010 18:24:36 +0900 (JST)
Subject: =?ISO-2022-JP?B?GyRCJCYkcyQzGyhC?=
Mime-Version: 1.0
Content-Type:text/plain;charset=ISO-2022-JP
Content-Transfer-Encoding:7bit
Date: Wed, 26 May 2010 18:24:35 +0900
Message-ID: <20100526182435672870.2aea@0016E68F5982>
From: <****@softbank.ne.jp>
To: ***@igreks.jp
Sender:****@softbank.ne.jp
X-Priority: 3
$B%b%j%b%j(B
----------------------------------------------------------------------------------
仕様としては、
・DBはMySQL
・空メの送信先は「reg_kara_mail@igreks.jp」とする
・空メの件名に名前を指定できる。
・登録済みの場合はエラーメールを返す。
・空メ本文にメルマガIDをあらかじめ記載しておく。
・メルマガIDが認識できない場合もエラーメールを返す。
・読者データテーブル名は仮に「user_'メルマガID'」、文字コードはUTF8とする。
これを受けて、スクリプトはざっとこんな感じに。
※おおまかな流れだけで、細かい点は割愛してます
■ 空メール登録処理用CGI（karame.cgi）
-----------------------------------------------------------------------------------
#!/usr/bin/perl
package main;
use strict;
use CGI;
use DBI;
use Unicode::Japanese;
require './lib/get.pl'; #各種データ取得用ライブラリ（詳細割愛）
require './lib/proc.pl'; #各種処理用ライブラリ（詳細割愛）
require './lib/db.pl'; #DB接続、各種SQL実行用ライブラリ（詳細割愛）
require './lib/start.pl'; #メール配信用ライブラリ（詳細割愛）
&db::open(); #DB接続
my $sys_msg = ''; #エラー返信用メッセージ
my ($email, $name, $id);
###### メールから標準入力をパース
my $grep = '[\d\w-.+]+\@[\d\w-]+(\.[\d\w-]+)+'; #メールアドレスの正規表現
while(<>){
if($_ =~ /^From.*?($grep)/i || $_ =~ /^Return-Path:.*?<($grep)>/i){
$email = $1; #メールアドレス
}
if($_ =~ /^Subject:\s*(.+)$/i){
$name .= $1; #名前
}
if($_ =~ /^\s*(=\?ISO-2022-JP.+\?=)\s*$/i){ #件名が途中で改行されてる時のため
$name .= $1;
}
if($_ =~ /^mid:(.+)$/){
$id = $1; #メルマガID
}
}
if($email){
if($id){
my $stg = &get::setting_data($id); #メルマガ設定データ取得
if($stg){
####### 読者テーブル内重複チェック
&db::query("
SELECT * FROM user_$id WHERE email='$email'
");
my $href = $db::sth->fetchrow_hashref();
if($href){
#すでに登録済みの場合
$sys_msg = <<EOM;
送信いただいたメールアドレス「$email」はすでに登録済みです。
このまま次回の配信をお待ちください。
EOM
$sys_msg =~ s/\t//g;
#メール返信処理
&start::return_mail(
'空メール登録処理エラー',
$sys_msg,
);
exit;
}
if($name){
#名前の入力があった場合
$name = Unicode::Japanese->new(
&proc::base64decode($name), #Base64デコード処理
'jis'
)->utf8; #JISからUTF8に変換
}
######## 新規登録
&db::query("
INSERT IGNORE INTO user_$$pd{'id'} (
no, #オートインクリメント
email,
name,
・
・
・
)
VALUES(
'',
'$email',
'$name',
・
・
・
)
");
}
else{
$sys_msg = <<EOM;
登録しようとしたメールマガジンは存在しないか、すでに廃刊されています。
お手数ですが、詳しくは発行者までお問い合わせください。
EOM
}
}
else{
$sys_msg = <<EOM;
送信いただいた情報に不備があり登録できませんでした。
空メール本文の内容は変更せずに送信してください。
何度もこのエラーメールが返信される場合は、お手数ですが発行者までお問い合わせください。
EOM
}
########## エラー返信処理
if($sys_msg){
&start::return_mail(
'空メール登録処理エラー',
$sys_msg,
);
}
&db::close(); #DB切断
exit;
-----------------------------------------------------------------------------------
■Postfixエイリアス設定ファイル（/etc/aliase）に以下を追加
-----------------------------------------------------------------------------------
reg_kara_mail: "|cd 'karame.cgiがあるディレクトリの絶対パス'; ./karame.cgi"
-----------------------------------------------------------------------------------
■リスタート
-----------------------------------------------------------------------------------
# newaliases
# /etc/init.d/postfix restart
-----------------------------------------------------------------------------------
■以下のようなメールを「reg_kara_mail@igreks.jp」宛に送る
件名：自分の名前もしくは空白
本文：mid:melmagaID
以上。
※レンタルサーバなどでエイリアスが設定できない場合は、後からcronなどでPOPアクセスして処理するなどの方法もある。（参考→http://www.igreks.jp/dev/2009/06/pop.html）
この場合は返信メールが即時配信されない。
※ディズニーモバイルとかwilcomは調べてないけど、まあだいたい同じだべってことで。
■ Docomo
----------------------------------------------------------------------------------
From ****@docomo.ne.jp Wed May 26 17:54:11 2010
Return-Path: <****@docomo.ne.jp>
X-Original-To: ***@igreks.jp
Delivered-To: ***@igreks.jp
Received: from localhost (localhost.localdomain [127.0.0.1])
by ***.igreks.jp (Postfix) with ESMTP id 5DE338B41B2
for <***@igreks.jp>; Wed, 26 May 2010 17:54:11 +0900 (JST)
X-Virus-Scanned: amavisd-new at igreks.jp
Received: from ***.igreks.jp ([127.0.0.1])
by localhost (igreks.jp [127.0.0.1]) (amavisd-new, port ****)
with ESMTP id kkpANBxiUasa for <****@igreks.jp>;
Wed, 26 May 2010 17:54:11 +0900 (JST)
Received: from docomo.ne.jp (mail108.docomo.ne.jp [203.138.203.8])
by ***.igreks.jp (Postfix) with ESMTP id 3E6618B40B0
for <***@igreks.jp>; Wed, 26 May 2010 17:54:11 +0900 (JST)
Date: Wed, 26 May 2010 17:54:09 +0900 (JST)
From: ****@docomo.ne.jp
To: ***@igreks.jp
Subject: =?iso-2022-jp?B?GyRCMSsbKEI=?=
Message-ID:
MIME-Version: 1.0
Content-Type: text/plain; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit
$BK\J8(B
----------------------------------------------------------------------------------
■ au
----------------------------------------------------------------------------------
From ****@ezweb.ne.jp Wed May 26 18:24:29 2010
Return-Path: <****@ezweb.ne.jp>
X-Original-To: ***@igreks.jp
Delivered-To: ***@igreks.jp
Received: from localhost (localhost.localdomain [127.0.0.1])
by ***.igreks.jp (Postfix) with ESMTP id F1F818B41B2
for <***@igreks.jp>; Wed, 26 May 2010 18:24:28 +0900 (JST)
X-Virus-Scanned: amavisd-new at igreks.jp
Received: from ***.igreks.jp ([127.0.0.1])
by localhost (igreks.jp [127.0.0.1]) (amavisd-new, port ****)
with ESMTP id CBSY6-Rv+mf6 for <***@igreks.jp>;
Wed, 26 May 2010 18:24:28 +0900 (JST)
Received: from ezweb.ne.jp (nx3oBP07-06.ezweb.ne.jp [59.135.39.240])
by ***.igreks.jp (Postfix) with ESMTP id D7FC88B40B0
for <***@igreks.jp>; Wed, 26 May 2010 18:24:28 +0900 (JST)
Received: from nxev04mp06 (localhost [127.0.0.1])
by nxev04mp06.ezweb.ne.jp (EZweb Mail) with SMTP id 955ED5BC640B4
for <***@igreks.jp>; Wed, 26 May 2010 18:24:28 +0900 (JST)
From: ****@ezweb.ne.jp
To: ***@igreks.jp
Subject: =?iso-2022-jp?B?GyRCMSsbKEI=?=
Message-ID: <2010052618242860697200007c12@nxev04mp06.ezweb.ne.jp>
Date: Wed, 26 May 2010 18:24:28 +0900
Mime-Version: 1.0
Content-Type: text/plain; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit
$B%6!<%6!<(B
----------------------------------------------------------------------------------
■ Softbank
----------------------------------------------------------------------------------
From ****@softbank.ne.jp Wed May 26 18:24:36 2010
Return-Path: <****@softbank.ne.jp>
X-Original-To: ***@igreks.jp
Delivered-To: ***@igreks.jp
Received: from localhost (localhost.localdomain [127.0.0.1])
by ***.igreks.jp (Postfix) with ESMTP id 975BD8B41B2
for <***@igreks.jp>; Wed, 26 May 2010 18:24:36 +0900 (JST)
X-Virus-Scanned: amavisd-new at igreks.jp
Received: from ***.igreks.jp ([127.0.0.1])
by localhost (igreks.jp [127.0.0.1]) (amavisd-new, port ****)
with ESMTP id HQrmiDMGcT3n for <***@igreks.jp>;
Wed, 26 May 2010 18:24:36 +0900 (JST)
Received: from mmrts049p01c.softbank.ne.jp (mmrts049p01c.softbank.ne.jp [123.108.236.27])
by ***.igreks.jp (Postfix) with SMTP id 6D9898B40B0
for <***@igreks.jp>; Wed, 26 May 2010 18:24:36 +0900 (JST)
Subject: =?ISO-2022-JP?B?GyRCJCYkcyQzGyhC?=
Mime-Version: 1.0
Content-Type:text/plain;charset=ISO-2022-JP
Content-Transfer-Encoding:7bit
Date: Wed, 26 May 2010 18:24:35 +0900
Message-ID: <20100526182435672870.2aea@0016E68F5982>
From: <****@softbank.ne.jp>
To: ***@igreks.jp
Sender:****@softbank.ne.jp
X-Priority: 3
$B%b%j%b%j(B
----------------------------------------------------------------------------------
仕様としては、
・DBはMySQL
・空メの送信先は「reg_kara_mail@igreks.jp」とする
・空メの件名に名前を指定できる。
・登録済みの場合はエラーメールを返す。
・空メ本文にメルマガIDをあらかじめ記載しておく。
・メルマガIDが認識できない場合もエラーメールを返す。
・読者データテーブル名は仮に「user_'メルマガID'」、文字コードはUTF8とする。
これを受けて、スクリプトはざっとこんな感じに。
※おおまかな流れだけで、細かい点は割愛してます
■ 空メール登録処理用CGI（karame.cgi）
-----------------------------------------------------------------------------------
#!/usr/bin/perl
package main;
use strict;
use CGI;
use DBI;
use Unicode::Japanese;
require './lib/get.pl'; #各種データ取得用ライブラリ（詳細割愛）
require './lib/proc.pl'; #各種処理用ライブラリ（詳細割愛）
require './lib/db.pl'; #DB接続、各種SQL実行用ライブラリ（詳細割愛）
require './lib/start.pl'; #メール配信用ライブラリ（詳細割愛）
&db::open(); #DB接続
my $sys_msg = ''; #エラー返信用メッセージ
my ($email, $name, $id);
###### メールから標準入力をパース
my $grep = '[\d\w-.+]+\@[\d\w-]+(\.[\d\w-]+)+'; #メールアドレスの正規表現
while(<>){
if($_ =~ /^From.*?($grep)/i || $_ =~ /^Return-Path:.*?<($grep)>/i){
$email = $1; #メールアドレス
}
if($_ =~ /^Subject:\s*(.+)$/i){
$name .= $1; #名前
}
if($_ =~ /^\s*(=\?ISO-2022-JP.+\?=)\s*$/i){ #件名が途中で改行されてる時のため
$name .= $1;
}
if($_ =~ /^mid:(.+)$/){
$id = $1; #メルマガID
}
}
if($email){
if($id){
my $stg = &get::setting_data($id); #メルマガ設定データ取得
if($stg){
####### 読者テーブル内重複チェック
&db::query("
SELECT * FROM user_$id WHERE email='$email'
");
my $href = $db::sth->fetchrow_hashref();
if($href){
#すでに登録済みの場合
$sys_msg = <<EOM;
送信いただいたメールアドレス「$email」はすでに登録済みです。
このまま次回の配信をお待ちください。
EOM
$sys_msg =~ s/\t//g;
#メール返信処理
&start::return_mail(
'空メール登録処理エラー',
$sys_msg,
);
exit;
}
if($name){
#名前の入力があった場合
$name = Unicode::Japanese->new(
&proc::base64decode($name), #Base64デコード処理
'jis'
)->utf8; #JISからUTF8に変換
}
######## 新規登録
&db::query("
INSERT IGNORE INTO user_$$pd{'id'} (
no, #オートインクリメント
email,
name,
・
・
・
)
VALUES(
'',
'$email',
'$name',
・
・
・
)
");
}
else{
$sys_msg = <<EOM;
登録しようとしたメールマガジンは存在しないか、すでに廃刊されています。
お手数ですが、詳しくは発行者までお問い合わせください。
EOM
}
}
else{
$sys_msg = <<EOM;
送信いただいた情報に不備があり登録できませんでした。
空メール本文の内容は変更せずに送信してください。
何度もこのエラーメールが返信される場合は、お手数ですが発行者までお問い合わせください。
EOM
}
########## エラー返信処理
if($sys_msg){
&start::return_mail(
'空メール登録処理エラー',
$sys_msg,
);
}
&db::close(); #DB切断
exit;
-----------------------------------------------------------------------------------
■Postfixエイリアス設定ファイル（/etc/aliase）に以下を追加
-----------------------------------------------------------------------------------
reg_kara_mail: "|cd 'karame.cgiがあるディレクトリの絶対パス'; ./karame.cgi"
-----------------------------------------------------------------------------------
■リスタート
-----------------------------------------------------------------------------------
# newaliases
# /etc/init.d/postfix restart
-----------------------------------------------------------------------------------
■以下のようなメールを「reg_kara_mail@igreks.jp」宛に送る
件名：自分の名前もしくは空白
本文：mid:melmagaID
以上。
※レンタルサーバなどでエイリアスが設定できない場合は、後からcronなどでPOPアクセスして処理するなどの方法もある。（参考→http://www.igreks.jp/dev/2009/06/pop.html）
この場合は返信メールが即時配信されない。
※ディズニーモバイルとかwilcomは調べてないけど、まあだいたい同じだべってことで。
