igreks開発日記

dovecotのよくわからんエラー

2010-03-01T17:24:52Z

久々にメールアドレスでも新しく作ろうと思って、nologinで新規ユーザ作成してみた。

thunderbirdでちゃちゃちゃとアカウント設定して、いざ受信って思ったら、
「接続：ホストにログイン情報を送信しています・・・」
のまま音沙汰なし。

パスワードとかいろいろ確認しても特におかしくないので、とりあえずmaillogを確認したら、こんなメッセージが。

-----------------------------------------------------------------------------------------
dovecot.... mail_location not set and autodetection failed: Mail storage autodetection failed with home=......
-----------------------------------------------------------------------------------------

うーん、これはなんだろう。

なんか雰囲気的に、メールボックスの場所が指定されてないから、メールを取りにいけません的な感じだろうか・・・

おかしいなあ、前までは普通にユーザ作成してメーラーの設定するだけですぐにいけたんだけどなあ・・・
と思いつつ、とりあえず問題ありそうな「/etc/dovecot.conf」を確認。

ってゆうか、このファイル一回も中身見たことないし〜。

メールサーバ入れたときもdovecotの設定なんか一回もやんなかったのに・・・
デフォルトでいままでいけてたんですけどね。

でもなんかこの辺が臭かったので、

-------------------------------------------------------------------------------------------
# Location for users' mailboxes. This is the same as the old default_mail_env
# setting. The default is empty, which means that Dovecot tries to find the
# mailboxes automatically. This won't work if the user doesn't have any mail
# yet, so you should explicitly tell Dovecot the full location.
#
# If you're using mbox, giving a path to the INBOX file (eg. /var/mail/%u)
# isn't enough. You'll also need to tell Dovecot where the other mailboxes are
# kept. This is called the "root mail directory", and it must be the first
# path given in the mail_location setting.
#
# There are a few special variables you can use, eg.:
#
# %u - username
# %n - user part in user@domain, same as %u if there's no domain
# %d - domain part in user@domain, empty if there's no domain
# %h - home directory
#
# See for full list. Some examples:
#
# mail_location = maildir:~/Maildir
# mail_location = mbox:~/mail:INBOX=/var/mail/%u
# mail_location = mbox:/var/mail/%d/%1n/%n:INDEX=/var/indexes/%d/%1n/%n
#
#
#
#mail_location =
-------------------------------------------------------------------------------------------

google様で直訳してみると、locationの設定は必須ですよ〜みたいな感じなのかな？

とりあえず例のまんま設定してみる。

-------------------------------------------------------------------------------------------
mail_location = mbox:~/mail:INBOX=/var/mail/%u
-------------------------------------------------------------------------------------------

てなかんじ。

すると・・・おお！メーラーがちゃんとメールを読みに行った！

なんじゃそりゃ。

ユーザディレクトリにも「mail」ディレクトリが作成されてる。
さっきまで無かったのに・・・
この「mail」ディレクトリって何なのかわかんなかったけど、dovecotが勝手に作ってるんですね・・・

とりあえずpopはOKそうなので、ついでにSMTP（postfix）の方も確認。
/etc/postfix/main.cfを開いて、それっぽい部分を見てみると、

-------------------------------------------------------------------------------------------
# DELIVERY TO MAILBOX
#
# The home_mailbox parameter specifies the optional pathname of a
# mailbox file relative to a user's home directory. The default
# mailbox file is /var/spool/mail/user or /var/mail/user. Specify
# "Maildir/" for qmail-style delivery (the / is required).
#
#home_mailbox = Mailbox
#home_mailbox = Maildir/
-------------------------------------------------------------------------------------------

どうやら、デフォルトのメールボックスは/var/spool/mail/userか、 /var/mail/userで、何もいじらないとここにメールを届けに行くらしい。
というわけで、さっきのdovecotの設定とつじつまがあってるのでOK。

まあ、ちゃんとした人たちはMaildir形式にちゃんと設定してるんだろうけど、横着な私はこれで問題無し。

一応確認のためにpostfixから送信して、dovecotで取りに行ってちゃんと読めたのでめでたし。

しかし軽く7時間かかったのは痛かった。

サーバ立ち上げた時から今まで問題なかったのに、いつからdovecotのデフォルト設定変わったの？って感じ。

アップデートなんてまったくやってないのに。

・・・よくわからないなー

MySQL:新しいテーブル構造に合わせてテーブルをコピー

2010-02-18T01:48:51Z

前記事（http://www.igreks.jp/dev/2010/01/mysql.html）のようにALTER TABLEを使って更新するのもいいのだが、できれば構造のテンプレートに合わせて一発でコピーしたい。

ただ単にテーブルの構造とデータをコピーする場合、普通は、

---------------------------------------------------------------------------------------
CREATE TABLE sample_new LIKE sample_original
INSERT INTO sample_new SELECT * FROM sample_original
---------------------------------------------------------------------------------------

しかし、新しい構造のテーブルにあわせて、構造を変更しながらデータをコピーするといった方法が見つからないため、スクリプトの処理を合わせて実現してみる。
あんまりスマートじゃないけど・・・

まず、最新の構造のテンプレートを作っておく。

■最新のテーブル構造のテンプレート（tbl.pl）
---------------------------------------------------------------------------------------

package tbl;

sub conf{

my %tbl = (

'table_a' => {
'column' => '
id INT AUTO_INCREMENT PRIMARY KEY,
column_1 VARCHAR(36),
column_2 VARCHAR(255),
column_3 VARCHAR(255)
',
'option' => '
ENGINE = MyISAM DEFAULT CHARSET = utf8
'
},

'table_b' => {
'column' => '
id INT NOT NULL AUTO_INCREMENT PRIMARY KEY,
column_1 INT,
column_2 VARCHAR(255),
column_3 VARCHAR(255)
',
'option' => '
ENGINE = MyISAM DEFAULT CHARSET = utf8
'
},
・
・
・
);
return \%tbl;

}
1;

---------------------------------------------------------------------------------------

テンプレートを読み込んで新しいテーブルを一時作成し、
そのテーブルに既存のテーブルのデータをインポートする。

■更新処理（tbl_update.pl）
---------------------------------------------------------------------------------------
#!/usr/bin/perl

package::main;

my $dbh;
・
・
・
# この辺でデータベースへの接続処理（詳細割愛）

print "Content-type: text/html\n\n";

print "

データベースの再構築を開始します

\n";

# 既存のテーブル名をリストで取得
my $sth = $dbh->prepare("SHOW TABLES LIKE 'hoge_%'") || die $dbh->errstr();
$sth->execute();
my @hoge_tbl = ();
while(my @tbl = $sth->fetchrow_array()){

push(@hoge_tbl,$tbl[0]);

}

# テンプレート読み込み
require "./tbl.pl";
my $tbl = &tbl::conf(); # ※リファレンスで受け取り

foreach(@hoge_tbl){

# 既存テーブルのカラム名をリストで取得
my @cols = ();
my $sth = $dbh->prepare("DESCRIBE $_") || die $dbh->errstr();
$sth->execute();
while(my $href = $sth->fetchrow_hashref()){

push(@cols,$href->{'Field'}); # unshiftしちゃだめよ

}
my $cols = join(',',@cols);

#####################################
# テーブル名の末尾に個別にIDとかが付いてなければこの処理はいらない
$_ =~ /hoge_(.+?)(_.+?)?$/;
my $name = $1;
######################################

# 新しい構造の空テーブルを「pre_***」という名前で一旦作成
my $sth = $dbh->prepare("

CREATE TABLE IF NOT EXISTS pre_$_ (
$$tbl{$name}{'column'}
) $$tbl{$name}{'option'}

") || die $dbh->errstr();
$sth->execute();

# 既存のテーブルのデータを、カラム名を明示的に指定して挿入
# これをしないとカラムの数が合いませんよ！と怒られる
my $sth = $dbh->prepare("INSERT INTO pre_$_ ($cols) SELECT * FROM $_"); # ※1
$sth->execute();

# 既存のテーブル削除
my $sth = $dbh->prepare("DROP TABLE IF EXISTS $_");
$sth->execute();

# 新しいテーブルのリネーム（"pre_"をとる）
my $sth = $dbh->prepare("ALTER TABLE pre_$_ RENAME $_");
$sth->execute();

}

print "

データベースの再構築が完了しました。

\n";

exit;
---------------------------------------------------------------------------------------

以上。

新しいテーブルにカラムが追加されてる場合は問題ないが、カラムが削除された場合は、多分※1のところでエラーになる・・・

こういうの一発でできるSQLないのかなぁ。

ハッシュの値(value)の重複チェック

2010-02-15T04:23:23Z

配列関係の重複チェックは一度ハッシュ（%check）に入れると簡単

-----------------------------------------------------------------------------------------

my %hash = (
a => 'あああ',
b => 'いいい',
c => 'ううう',
d => 'あああ',
e => 'おおお',
f => 'あああ'
);

my %check = ();

for(values %hash){
die "$_ が重複してるよ！" if $check{$_};
$check{$_} = 1; #### 1とかaとか好きなの入れる
}

-----------------------------------------------------------------------------------------

LWPのレスポンス確認用メソッドまとめ：Summary of verification methods of HTTP response by LWP

2010-02-06T06:45:30Z

LWPを使ったhttpレスポンスの取得には、HTTP::Request(::Common)モジュールを使ってリクエストのオブジェクトを作っておくと、レスポンス情報を確認するさまざまなメソッドを使用することができる。

HTTPモジュール群にはまず「HTTP::Message」があり、このオブジェクトには幾つかのヘッダとコンテント（ボディ）取得用のクラスが入ってるが、このクラスは抽象クラスである。
つまりHTTP::RequestとHTTP::Responseのための基本クラスとしてだけ使われ、それ自身のインスタンスは生成されることはない。

「HTTP::Response」はHTTP形式のレスポンスをカプセル化するクラスである。
このクラスのインスタンスは通常、LWP::UserAgentオブジェクトのrequestメソッドによって作成され返される。

また、「HTTP::Headers」は同様にHTTP形式のメッセージヘッダをカプセル化するクラスである。
このクラスのインスタンスは通常、HTTP::RequestやHTTP::Responseクラスのメンバー変数として、ライブラリ内部用に作成される。

つまり、

my $url = 'http://yahoo.co.jp';
my $ua = LWP::UserAgent->new();
my $req = &HTTP::Request::Common::GET($url);
my $res = $ua->request($req);

のように、レスポンス用オブジェクト($res)生成しておけば、上の3つのモジュールで定義されているメソッドは全てこのオブジェクト($res)から以下のように参照することができる。

---------------------------------------------------------------------------------------------------

（HTTP::Message）

■$res->protocol([$proto])
・・・そのメッセージに使われるHTTPプロトコルを設定する。protocol()は"HTTP/1.0"または"HTTP/1.1"のような文字列が返る。

■$res->content([$content])
・・・引数が与えられていれば、コンテントを設定する。引数が無ければ、コンテントは触れられずに返される。

■$res->add_content($data)
・・・前のコンテントの末尾にさらにデータを追加する。

■$res->content_ref
・・・コンテント文字列へのリファレンスを返す。
コンテントが巨大であれば、この方法が効率的。また、直接操作が出来る。
例：${$res->content_ref} =~ s/\bfoo\b/bar/g;

■$res->headers;
・・・HTTP::Headersオブジェクトを返す。

■$res->headers_as_string([$endl])
・・・HTTP::Headers->as_stringを呼び出す。

（HTTP::Headers）

■$res->header($field [=> $value],...)
・・・ヘッダの値を取得または設定する。
ヘッダ・フィールド名は大文字／小文字を区別しない。
引数が無い場合は複数の（$field => $values)の組を受け取る。
$valueを複数設定することにより１回の呼び出しでたくさんのフィールドを更新することも可能。$valuesにはスカラまたはスカラのリストへのリファレンスを指定することができる。
$valueが未定義だったり指定されていなければヘッダは変更されない。

複数の値を持つフィールドは、スカラ・コンテキストでは","を区切り文字としてつなげられ返される。

（例）
　$header->header(MIME_Version => '1.0',
　　　　　　User_Agent => 'My-Web-Client/0.01');
　$header->header(Accept => "text/html, text/plain, image/*");
　$header->header(Accept => [qw(text/html text/plain image/*)]);
　@accepts = $header->header('Accept');

■$res->scan(\&doit)
・・・ヘッダそれぞれにサブルーチンを適用する。コールバック・ルーチンは２つのパラメータ（フィールド名と１つの値）で呼び出される。
ヘッダが1つ以上の値を持っていれば、ルーチンはそれぞれの値につき1回呼ばれる。コールバック・ルーチンに渡されるフィールド名はHTTP仕様で提案されている大文字／小文字をもち、推奨されている"Good Practice"の順でやってくる。

■$res->as_string([$endl])
・・・フォーマットされたMIMEヘッダとしてヘッダ・フィールドを返す。
文字列を組み立てるために内部でscan()メソッドを使っているので、結果はHTTP仕様で提案されている大文字小文字で、ヘッダ・フィールドの順序の推奨されている"Good Practice"に従う。
長いヘッダの値はたたまれない。

オプションのパラメータには使用する行末シーケンスを指定できる。デフォルトは"\n"。
この場合、ヘッダに埋め込まれた"\n"文字は、この行末シーケンスで置きかえられる。

■$res->push_header($field, $val)
・・・指定されたヘッダに新しいフィールドの値を追加する。
ヘッダ・フィールド名は大文字小文字を区別しない。
同じフィールド名で、値を持たずに指定した場合、前の値が残る。
引数にはスカラやスカラのリストへのリファレンスを指定することが出来る。

（例）$header->push_header(Accept => 'image/jpeg');

■$res->remove_header($field,...)
・・・指定された名前を持つヘッダを削除する

（HTTP::Response）

■$res->code([$code])
・・・レスポンスコード(301など)を返す。

■$res->message([$message])
・・・レスポンスメッセージを返す。

■$res->request([$request])
・・・このレスポンスを発生したリクエストのリファレンスを返す。
ここまでの間に、リダイレクトや認証のリトライがある場合もあるので、$ua->request()メソッドに渡されたものと同じリクエストである必要はない。

■$res->previous([$previousResponse])
・・・最初のレスポンスがリダイレトクまたは認証されていなければ、レスポンスのチェーンを返す。

■$res->status_line
・・・文字列"$res->code + $res->message"を返す。
もしmessage属性が設定されていなければ、code（HTTP::Statusを参照にした）の公的な名前に置き換えられる。

■$res->base
・・・レスポンスのベースURLを返す。
戻り値はURIオブジェクトへのリファレンス。

ベースURLは以下のいずれかの情報源から１〜３の優先順で取得される。

　1. ドキュメント内容に埋め込まれたもの：例えばHTMLドキュメント内での
　2. レスポンスでの"Content-Base:"または"Content-Locatin:"ヘッダ
　　古いHTTP実装との互換性のため、"Base:"ヘッダも探す。
　3. このレスポンスを要求したURL。
　　これはレスポンスの前に、いくつかのリダイレクトを受信しているかもしれないため、$ua->request()メソッドに渡された元のURLでない場合もある。

■$res->as_string
・・・コンテントのプレーンテキストを返す。
主にデバッグのために使われる。引数は指定できない。

■$res->is_info
■$res->is_success
■$res->is_redirect
■$res->is_error
・・・レスポンスが情報的(informational)であるか、成功したか、リダイレクトであるか、エラーであるかを返す。
（偽ならおそらくundefか0を返す）

■$res->error_as_HTML()
・・・何のエラーが発生したかを示す完全なHTMLドキュメントが入っている文字列を返す。
このメソッドは$res->is_errorがTRUEのときだけ呼ぶべき。

■$res->current_age
・・・ section 13.2.3.によって指定されたレスポンスの"現在の年齢"("current age")を計算する。
レスポンスの年齢は元のサーバサーバーによって送信されてからの時間。
返される値は累計秒。

■$res->freshness_lifetime
・・・ section 13.2.4.で指定されたそのレスポンスの"新鮮期間"("freshness lifetime")を計算する。
"新鮮期間"はレスポンスが生成されてから終了するまでの時間の長さ。
返される値は累計秒。

■$res->is_fresh
・・・freshness_lifetime()とcurrent_age()の値をベースに、レスポンスが新鮮であればTRUEを返す。
レスポンスがもはや新鮮でなければ、もう一度取り出されるか、元のサーバによって再評価されるべきである。

■$res->fresh_until
・・・このエンティティがもはや新鮮ではない時刻を返す。

------------------------------------------------------------------------------------------------------

参考URL：
http://homepage3.nifty.com/hippo2000/perltips/HTTP/Headers.html
http://homepage3.nifty.com/hippo2000/perltips/HTTP/Message.html
http://homepage3.nifty.com/hippo2000/perltips/HTTP/Response.html

LWPでwebサイトの文字コード(charset)を取得する:Get the charcter set of a website by LWP)

2010-02-06T06:28:56Z

----------------------------------------------------------------------------------------------

#!/usr/bin/perl -w

use strict;
use LWP::UserAgent;
use HTTP::Request::Common;

# オブジェクト作成
my $ua = LWP::UserAgent->new();
my $url = 'http://yahoo.co.jp';
my $req = &HTTP::Request::Common::GET($url);

# レスポンスを得る
my $res = $ua->request($req);

# フィールド名を指定してヘッダを取得
my $con_type = $res->header('Content-Type');

#処理
if($con_type =~ /shift_jis/i){
　　# (sjis用エンコーディング処理)
}
elsif($con_type =~ /euc-jp/i){
　　# (ujis用エンコーディング処理)
}
elsif($con_type =~ /utf-8/i){
　　# (utf8用エンコーディング処理)
}
　　・
　　・
　　・

----------------------------------------------------------------------------------------------

※charsetをダイレクトに返してくれるメソッドはどうやら無いらしい・・・
あったら教えてください。

Crypt::SSLeayが無くてもLWPでhttpsがリクエストできる件

2010-02-03T00:29:43Z

多くの参考サイトや本では、LWPモジュール群を利用してのSSLアクセスには「Crypt::SSLeay」モジュールが必要と説明されているが、どうやら「Net::SSLaey」モジュールがあれば可能なようだ。

もちろんサーバにSSL環境（OpenSSLとかmodSSLとか）があるっていうのが前提ではあるが。

OpenSSLとLWPのつなぎ役をしてくれるのがCrypt::SSLeayだが、もともと、OpenSSLとSSLeayとの高度な機能インタフェースを提供するモジュールが「Net::SSLaey」モジュールである。

以下確認作業

■まず適当なスクリプトでPerlの@INCの中身を確認----------------------------------------------------------------------------------------------
#!/usr/bin/perl

print "Content-type: text/plain\n\n";

foreach(@INC){
print $_.'\n';
}

exit;
----------------------------------------------------------------------------------------------

■結果↓

----------------------------------------------------------------------------------------------
/usr/local/lib/perl5/site_perl/5.10.0/i386-linux-thread-multi
/usr/local/lib/perl5/site_perl/5.10.0
/usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi
/usr/lib/perl5/vendor_perl/5.10.0
/usr/lib/perl5/vendor_perl
/usr/lib/perl5/5.10.0/i386-linux-thread-multi
/usr/lib/perl5/5.10.0
/usr/lib/perl5/site_perl
.
----------------------------------------------------------------------------------------------

■次に、Crypt::SSLeayとNet::SSLeayが入っているか確認↓

----------------------------------------------------------------------------------------------
（コマンド）
$ su
# cd /

# find -path *Crypt/SSL*

#
（↑Crypt::SSLeayは入っていない）

# find -path *Net/SSL*

./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/Net/SSLeay
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/Net/SSLeay/Handle.pm
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/Net/SSLeay.pm
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/auto/Net/SSLeay
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/auto/Net/SSLeay/https_cat.al
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/auto/Net/SSLeay/do_https4.al
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/auto/Net/SSLeay/get_httpx3.al
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/auto/Net/SSLeay/get_http.al
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/auto/Net/SSLeay/put_http.al
./usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/auto/Net/SSLeay/want_read.al
　　　・
　　　・
　　　・
（以下省略）

（↑@INCでは「/usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi」にNet::SSLeayが入っている）
----------------------------------------------------------------------------------------------

■試しに名前を変えてみる↓

----------------------------------------------------------------------------------------------
# cd /usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi/Net
# mv SSLeay.pm SSLeay.pm2
----------------------------------------------------------------------------------------------

■スクリプト↓でhttpsにリクエストしてみる

----------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use LWP::UserAgent;
use HTTP::Request::Common;

my $ua = LWP::UserAgent->new();

my $url = "https://www.hogehoge.jp"; # 実在するセキュアサイト

$request = &HTTP::Request::Common::GET($url);
$response = $ua->request($request);

print "Content-type: text/plain\n\n";
print $response->status_line;

exit;
----------------------------------------------------------------------------------------------

■実行結果↓

----------------------------------------------------------------------------------------------

501 Protocol scheme 'https' is not supported

（httpsプロトコルはサポートしていません）
----------------------------------------------------------------------------------------------

■SSLeay.pmを元に戻す↓

----------------------------------------------------------------------------------------------
# mv SSLeay.pm2 SSLeay.pm
----------------------------------------------------------------------------------------------

■さっきのスクリプトをもう一度実行↓

----------------------------------------------------------------------------------------------

302 Found

（ファイルが存在します＝接続成功）
----------------------------------------------------------------------------------------------

めでたしめでたし。

特定のプロセスを実行しているファイル名を調べる

2010-01-27T11:38:50Z

あるプロセスがサーバに過大な負荷をかけているとき、その犯人と、原因のプログラムファイルを発見する一番早い（？）方法。

まずtopコマンドやpsコマンドで、そのプロセスのプロセス番号を調べる。

-------------------------------------------------------------------------------------------

$ su

# top

-------------------------------------------------------------------------------------------

プロセス番号がわかったら、

-------------------------------------------------------------------------------------------

# ls -l /proc/(プロセス番号)/exe

-------------------------------------------------------------------------------------------

として、実行ファイルのシンボリックリンクを参照する。
※エディタで直接/proc/(プロセス番号)/exe にアクセスしてもバイナリファイルなので見れません。

結果↓

------------------------------------------------------------------------------------------

lrwxrwxrwx 1 hoge.hoge 0 2010-01-27 05:23
/proc/プロセス番号/exe -> /home/●●/hoge/○○○

------------------------------------------------------------------------------------------

つまり「●●」が犯人で「○○○」が問題のファイル。

あとは犯人に警告するなりプロセスをkillするなりご自由に。

WEBサーバからアクセスできない場所(DocumentRoot外)のファイルをダウンロードさせる

2010-01-15T01:51:54Z

DocumentRoot以外の場所にあるファイルをダウンロードさせようとして、プログラム側で「Location」させても、普通はアクセスできない。

そういった場合は前記事（http://www.igreks.jp/dev/2009/10/perlmysql2.html）の応用で、「cat」コマンドを利用するとダウンロードできるようになる。

-----------------------------------------------------------------------

#!/usr/bin/perl -w

use strict;

my $dir = '../../hoge'; #Documentroot外のディレクトリ
my $file = 'huga'; #その中にあるファイル

print "Content-Type: application/octet-stream\n";
print "Content-Type: application/download; name=$file\n";
print "Content-Disposition: attachment; filename=$file\n";
print "\n";
#### print content
system "cat $dir/$file";

exit;

-----------------------------------------------------------------------

※DocumentRoot以下に置いてBasic認証かけるよりは安全？
※LWP転送するときもOK

MySQL:テーブルに特定のカラムが無ければ追加

2010-01-07T20:41:00Z

SQLだけでこういう処理をする方法が調べてもわからないので、スクリプト側でチェックしてみる。

メイン
------------------------------------------------------------------------------------------
#!/usr/bin/perl -w

use strict;
use DBI;
require './db.pl';

&db::open();

　my $table = 'table_name';
　##追加カラム情報セット
　my @add = (
　　['field1' ,'INT' ],
　　['field2' ,'VARCHAR(255)' ],
　　['field3' ,'DATE' ],
　　['field4' ,'INT', ],
　　['field5' ,'VARCHAR(255)' ],
　　['field6' ,'VARCHAR(255)' ],
　　['field7' ,'INT' ]
　);
　my $cols = '';
　##現在のテーブル情報を取得
　&db::query("DESCRIBE $table");
　while(my $href = $db::sth->fetchrow_hashref()){
　　##カラム名をセット
　　$cols .= '<>'.$href->{'Field'}.'<>';
　}
　##無ければ追加
　foreach(@add){
　　if($cols !~ /<>$_[0]<>/){
　　　　&db::query("ALTER TABLE $table ADD $_[0] $_[1]");
　　}
　}

&db::close();
exit;
---------------------------------------------------------------------------------------

DB接続(db.pl)
---------------------------------------------------------------------------------------
package db;

use strict;

sub open{
my $dbs = "DBI:mysql:dbname:dbhost";
our $dbh = DBI->connect($dbs,dbuser,dbpass);
if(!$dbh){
die "データベースに接続できません";
}
}

sub query{
my ($sql) = @_;
our $sth = $db::dbh->prepare($sql) || die $db::dbh->errstr();
my $exec = $sth->execute || die $sth->errstr();
return $exec;
}

sub close{
$db::sth->finish;
$db::dbh->disconnect;
}

1;
---------------------------------------------------------------------------------------

実行中プロセスの監視（TOP）

2009-12-17T17:09:08Z

実行中のプロセスのCPU使用率やメモリ占有率などをリアルタイムで監視するUNIXコマンド。

-----------------------------------------------------------------

$ su （rootになる）

# top

（プロセス一覧が表示される）

"q"で終了
----------------------------------------------------------------

以上。

オプションとして便利なのは、

-d: 更新間隔を指定する: -d ss.tt (秒.10分の1秒)
-u: 指定した実効UIDかユーザ名にマッチするプロセスだけをモニターする: -u somebody

例えばWEBサーバが実効しているプロセスだけを0.5秒間隔に確認したい場合は、

--------------------------------------------
# top -d 0.5 -u apache
--------------------------------------------

でOK。

perlでSMTPサーバを指定してメール送信（TLS/SSL接続も可）

2009-12-16T05:07:51Z

とりあえずサンプルスクリプト↓

-----------------------------------------------------------------------

use strict;
use CGI::Carp qw(fatalsToBrowser);
use Net::SMTP;
use Net::SMTP::SSL;
use Net::SMTP::TLS;
use Encode qw(from_to encode);

#メールアドレス設定
my $from = 'hoge@gmail.com';
my $mailto= 'huga@nantoka.com';

#件名設定
my $subject = 'SMTPを指定してメール送信！';
from_to($subject, 'shiftjis', 'iso-2022-jp');
encode('MIME-Header-ISO_2022_JP', $subject);

#メールヘッダー設定
my $header = << "MAILHEADER";
From: $from
To: $mailto
Subject: $subject
Mime-Version: 1.0
Content-Type: text/plain; charset = 'ISO-2022-JP"
Content-Trensfer-Encoding: 7bit

MAILHEADER

#メール本文設定
my $message = << 'MAILBODY';
本日は晴天なり。

あああいいいううう
さよーなら！
MAILBODY

#文字コードをJISに変換
from_to($message, 'shiftjis', 'iso-2022-jp');

#SMTP設定（適宜変更してください）
my $server = 'smtp.gmail.com';　#ホスト名
my $auth = 1;　#SMTPAuthを使用する場合は1
my $tls = 0;　#TLS接続を使う場合は1
my $ssl = 1;　#SSL接続を使う場合は1
my $port = 465;　#ポート指定。指定しないと25番が勝手に設定される
my $user = 'hoge@gmail.com';　#SMTPAuthのユーザ名
my $pass = 'passwaord';　#SMTPAuthのパスワード

#メール送信オブジェクト設定
my $smtp = '';

#TLSのときは、オブジェクト生成時にAuthデータを渡す
if($tls){
　$smtp = Net::SMTP::TLS->new(
　　$server,
　　Port => $port ,
　　User => $user ,
　　Password => $pass
　) || die "Connect failed over tls";
}
elsif($ssl){
　$smtp = Net::SMTP::SSL->new(
　　$server,
　　Port => $port
　) || die "Connect failed over ssl";
}
else{
　$smtp = Net::SMTP->new($server, Port => $port) || die "Connect failed";
}
if(!$tls && $auth){
　$smtp->auth($user, $pass) || die "auth failed";
}

#メール送信
$smtp->mail($from);
$smtp->to($mailto);
$smtp->data();
$smtp->datasend($header);
$smtp->datasend($message);
$smtp->dataend();
$smtp->quit;

print < Content-type: text/html

送信しました～！
EOM

exit;
1;

---------------------------------------------------------------------------------

※Net::SMTP::SSLおよびNet::SMTP::TLSを使うには、IO::Socket::SSLモジュールが必要。
※IO::Socket::SSLをインストールするには、Net::SSLeayモジュールが必要
※試したところ、gmailの場合は、TLS使用＆ポート587でも送信できた。
※例ではエンコードにEncodeモジュールを使っているが、Jcodeとか使いたい人はお好きなように。

一度requireされたファイルをもう一度読み込む

2009-12-12T09:36:35Z

自動でファイルの書き換えをした場合とかに、最後に古いファイル・新しいファイルのチェックを行うために辿り着いた作戦。

新しい同名・同パッケージ名のファイルを別のディレクトから"require"すればOK。
同名のパッケージ名が新しく読み込んだパッケージで上書きされる。

ただし、useはコンパイル時に参照されるからだめかも知れない。
試してないけど。

---------------------------------------------------------------------------------------------

sub update_files_and_check{

　my $dir = '.';　##　古いファイルが入ったディレクトリ
　###　一度古いfile_list.plを読み込む
　require "$dir/file_list.pl";
　print "

現在あるファイルは、

\n";
　foreach(@file_list::req){
　　print $_ ."
\n";
　}
　print "です。";

　my $dir = '.';　##　古いファイルが入ったディレクトリ
　my $newdir = './newdir'; ## 新しいファイルが入ったディレクトリ（この中に新しいfile_list.plも入っている）

　###　ファイル書き換え

　opendir(NEW_DIR,$new_dir) || die "Can't open $new_dir !";
　　while(my $doc = readdir(NEW_DIR)){
　　　if($doc !~ /^\.+$/){
　　　　open(FILE,"$new_dir/$doc") || die "Can't open $new_dir/$doc !";
　　　　my $buff = '';
　　　　binmode FILE;
　　　　while(){
　　　　　$buff .= $_;
　　　　}
　　　　close(FILE);
　　　　if(-e "$dir/$doc"){
　　　　　unlink "$dir/$doc" || die "Can't delete $dir/$doc!";
　　　　}
　　　　open(FILE,">$dir/$doc") || die "Can't open $dir/$doc !";
　　　　flock(FILE,2);
　　　　print FILE $buff;
　　　　flock(FILE,8);
　　　　close(FILE);
　　　}
　　}
　closedir();

　###　チェック＆不要ファイル削除
　if(! eval "require $new_dir/file_list.pl;"){
　## ↑ のrequireが成功すれば、この時点で変数「@file_list::xxx」が上書きされる
　## "require $dir/file_list.pl;" にしてしまうと、最初にすでに読み込んでるので失敗する。

　　print "新しいファイルが参照できません。";
　　exit;
　}
　foreach(@file_list::req){
　　if(!-e "$dir/$_"){
　　　print "$_が見つかりません！！";
　　　exit;
　　}
　}
　foreach(@file_list::des){
　　if(-e "$dir/$_"){
　　　unlink "$dir/$_" || die "$dir/$_が削除できません！";
　　}
　}
}

---------------------------------------------------------------------------------------------

（書き換えられた新しいfile_list.pl）
------------------------------------------------------------------------------------
package file_list;

use strict;

### 今回必要なファイル
our @req = ( 'aaa.pl','bbb.pl','ccc.txt');

### 不要になったファイル
our @des = ('ddd.pl','eee.pl');

1;
------------------------------------------------------------------------------------

perl2exeに四苦八苦

2009-11-17T06:51:51Z

かねてから気になっていたperl2exe（perlスクリプトファイルを実行ファイルにしてくれるソフト）についに挑戦。

Win32環境での情報などは結構転がってるのだが、Unix版で参考になるサイトがないので、仕方なく本家のユーザーマニュアルを読みながらやってみる。

まずは本家からダウンロード。
http://www.indigostar.com/perl2exe.htm

私の場合はperl5.10.0でLinux上でコンパイル予定なので、

・Perl2Exe V9.100 for Linux (Jan 18 2008)

↑これを選んでダウンロード＆解凍。

なにやらマニュアルを見ると、

・exeファイルの作り方は、コマンドにて、
　「perl2exe yourscript.pl」
とするだけ。ふむふむ。

・特別なモジュールを読み込む場合は、スクリプト中に
　　#perl2exe_include "somemodule.pm";
的なことを書けばよいと・・・

まあこの辺はWin32版と同じだな。

ほんでもって、Unixホストで動かす場合は、同梱されてるインタプリタじゃなくて、動かしてるサーバのインタプリタとコア/ローカルモジュールを使用する設定にできるらしい。

後々、こっちの方が楽そうなので、切り替えてみる。

--------------------------------------------------------------------
cd ~/perl2exe
rm -rf perl5
perl ./setup_perl2exe.pl
--------------------------------------------------------------------

「切り替えました！」的なことが表示されたので、多分OK。

とりあえず試しに使ってみる。

まず最初に、
--------------------------------------------------------------------
cd ~/perl2exe
./setup
--------------------------------------------------------------------

実行ファイル生成
--------------------------------------------------------------------
cd ~/perl2exe
./perl2exe hellocgi.pl
--------------------------------------------------------------------

同じディレクトリに「hellocgi」という実行ファイル（バイナリファイル）ができた！！

とりあえず動作確認。
--------------------------------------------------------------------
cd ~/perl2exe
./hellocgi
--------------------------------------------------------------------
（あくまで実行ファイルなのでファイル名を指定するだけ）

・・・・よっしゃ成功！！

次に、WEBサーバ（ブラウザ）から実行できるか実験。

マニュアルにはtelnetを使って・・・みたいなこと書いてあったけど、面倒くさいんで、

#!/usr/bin/perl -w

system "./hellocgi";

exit;

とだけ書いたperlスクリプトを実行ファイルと同じ場所に置いて、このファイルにアクセスする。

よしよし、ちゃんと表示される。html出力もOKですな♪

じゃあいよいよ、もっと複雑なDBが絡んだスクリプトに挑戦してみようってことで、やってみたのだが、もちろん一発でうまくいくわけがなく、以下のエラーが連発。

Warning: Can't locate VMS/Stdio.pm
at /usr/lib/perl5/5.10.0/File/Temp.pm line 149
@INC = /usr/local/lib/perl5/site_perl/5.10.0/i386-linux-thread-multi, /usr/local/lib/perl5/site_perl/5.10.0, /usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/vendor_perl/5.10.0, /usr/lib/perl5/vendor_perl, /usr/lib/perl5/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/5.10.0, ., .

Warning: Can't locate Compress/Bzip2.pm
at /usr/local/lib/perl5/site_perl/5.10.0/HTTP/Message.pm line 315
@INC = /usr/local/lib/perl5/site_perl/5.10.0/i386-linux-thread-multi, /usr/local/lib/perl5/site_perl/5.10.0, /usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/vendor_perl/5.10.0, /usr/lib/perl5/vendor_perl, /usr/lib/perl5/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/5.10.0, ., .

Warning: Can't locate Compress/Bzip2.pm
at /usr/local/lib/perl5/site_perl/5.10.0/HTTP/Message.pm line 447
@INC = /usr/local/lib/perl5/site_perl/5.10.0/i386-linux-thread-multi, /usr/local/lib/perl5/site_perl/5.10.0, /usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/vendor_perl/5.10.0, /usr/lib/perl5/vendor_perl, /usr/lib/perl5/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/5.10.0, ., .

Warning: Can't locate Compress/Bzip2.pm
at /usr/local/lib/perl5/site_perl/5.10.0/HTTP/Message.pm line 496
@INC = /usr/local/lib/perl5/site_perl/5.10.0/i386-linux-thread-multi, /usr/local/lib/perl5/site_perl/5.10.0, /usr/lib/perl5/vendor_perl/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/vendor_perl/5.10.0, /usr/lib/perl5/vendor_perl, /usr/lib/perl5/5.10.0/i386-linux-thread-multi, /usr/lib/perl5/5.10.0, ., .

（以下省略）

チーン。

まあ、エラーの言ってる意味はわかるのだが、Compress/Bzip2とか、聞いたこと無いようなモジュールまで要求してきやがる。

どうやら動作条件に関係なく、モジュール中にuseとかrequireとかの命令があったら、evalで呼ばれてても、とにかくそのモジュールはロードしなきゃならん仕様らしい。

仕方ないからインストールしてやるかと思い、cpan2rpm使おうとしたら「見つかりません！」的な。

ここまできたら、全部入れてやればいいんだろと思い、全部cpanからダウンロードしてきてmake installを実施。

しかしインストール中に今度は、

/bin/sh: gcc: command not found......

Cコンパイラまで追加すんのかよ！と思いつつ、こちらのサイト
http://memorva.jp/memo/linux/gcc_curses.php
を参考にしつつ、gccをインストール。

--------------------------------------------------------
yum install gcc*
--------------------------------------------------------

まあyumで一発だからいいけど。

これでようやく要求された全てのモジュールのmake install が完了。

インストール中に何やらいっぱい警告だのエラーだの表示されたけど、とりあえずpmファイルが入ったからいいや的な。

そしてもう一度実行ファイルを生成！

・・・お？

今度はエラーが出ない。

イエーイ！コンパイル成功〜〜〜〜！

さっそく実行〜！

あれ？

Software error:

DynaLoader object version 1.0801 does not match $DynaLoader::VERSION 1.08 at PERL2EXE_STORAGE/DynaLoader.pm line 93.
Compilation failed in require at PERL2EXE_STORAGE/DBI.pm line 157.
BEGIN failed--compilation aborted at PERL2EXE_STORAGE/DBI.pm line 157.
Compilation failed in require at ** line 15.
BEGIN failed--compilation aborted at ** line 15.

・・・うーむ・・

どうやらDBIの設定がいろいろ必要らしい。

苦戦は続く・・・

そして改めて説明をよく見ると、「Mysqlを使用する場合は、DBD::Mysql_PPを使用してください」
みたいなことが書かれている・・・

ということは、通常のCを使うデータベースドライバが使えないっつーことか。

このあたりで、ひょっとすると、これはものすごく使えないソフトなのでは・・・という不安がよぎる。

調べてみると案の定、Mysql_PPはいつまでたってもバージョンが0代だし、処理がくそ遅いという評判。

まあ全てPurePerlでやろうってんだからそうなるだろうな。

さらにMysql_PPの依存モジュールであるNet::Mysqlモジュールでもようわからんエラーが続出。

そして、ついに対応するのをあきらめた私。

結論：

データベース連携するプログラムはPerl2exeで（気軽に）使えない。
そうじゃないものなら使用する価値はまあまあある。
ただしスクリプトにモジュール名が書いてあったら必ず必要。

以上、ご参考までに。

ディレクトリの中を子ディレクトリ内も含め全て出力

2009-11-14T03:49:53Z

おそらくこんなことするモジュールとかあると思うんだけど、簡単そうなので自力で。

ただしperl5.6以降限定。

----------------------------------------------------------------------------------------------
use strict;

my $target_dir = './dir';

print "Content-type: text/plain\n\n";
&read_all($target_dir);

sub read_all{
　my ($dir) = @_;
　opendir(my $dh,$dir)|| die "Directory open error :$dir";
　　print '__DIR_'.$dir.'_START__'."\n";
　　while(my $doc = readdir($dh)){
　　　if($doc !~ /^\.+$/){
　　　　if(-d "$dir/$doc"){
　　　　　&read_all("$dir/$doc");　##ループ
　　　　}
　　　　elsif(-e "$dir/$doc" && $doc =~ /^[\d\w]+\.[\d\w]+$/){　##ここの正規表現はお好きなように
　　　　　open(FILE,"$dir/$doc") || die "File open error :$dir/$doc";
　　　　　　print '__FILE_'.$doc.'_START__'."\n";
　　　　　　while(){
　　　　　　　print $_;
　　　　　　}
　　　　　　print '__FILE_'.$doc.'_END__'."\n".;
　　　　　close(FILE);
　　　　}
　　　}
　　　else{
　　　　next;
　　　}
　　}
　　print '__DIR_'.$dir.'_END__'."\n";
　closedir($dh);
}

exit;

-----------------------------------------------------------------------------------------

※perl5.6以降だと、ループの度にディレクトリハンドル（上で言う$dh）を自動生成してくれる。そうじゃないと一回目でclosedirされて多分ループが続かない。
※ヘッダ出力はお好きなように。
※使い道・・・・・多分ほとんどない。
　ダウンロードしたりLWP転送するときも、tar.gzとかzipにして一発出力したほうが手っ取り早いから・・・
　圧縮展開が面倒くさくて、ファイルも少量のときくらいはこれでやってもいいと思うけど。

HTML(XHTML)のreadonly属性とdisabled属性の違い

2009-11-06T04:49:23Z

今更基本的なことだが、form部品の中に、

例えば

とすると、「checked」にしていても、送信先でvalue値が空になってしまうらしい。
（firefoxでしか試してないけど）

チェックボックスを空のまま固定するんならいいけど、チェックを入れた状態で固定したいときに保存処理を行うとチェックされてない状態と同じ状態で保存されてしまうので困る。

そしたら「readonly」というのがあったらしく、disabledの代わりにこれを使ったらよかったらしい。

（XHTMLの場合は、readonly='readonly'とする）

だったら「disabled」なんていらねーんじゃねーか？
と思ったんだけど、頭いい人は何かしらのときに使うんだべな。

ちなみにIEじゃサポートされて無いって噂なんだが今はダイジョブなのかな？

2010/2/14追記：

readonlyにすると、テキストフォームなら入力できないが、チェックボックスの場合はチェックができてしまい、値も送信されちゃうので、そういうときは
"checked disabled"にしといて、別にhiddenフィールドでチェックボックスのvalueを送信します。

<form action='' method='post'>
（中略）

（中略）
<input type='hidden' name='aaa' value='1'>
</form>