clicktx::Tech::Memo

perlモジュールのバージョンを一発で調べられるコマンド

$ pmvers DBIx::Cutom
0.168

cpanmがインストールしてあれば

$ cpanm pmvers

でインストールできます。

もうこんな事しなくていいんです。

perl -MDBI -e 'print $DBIx::Custom::VERSION'

DBIx::Customが生SQL感覚でも使えてお気に入りなのだけれど、ちょっこしハマったのでメモ。

DBIx::Custom – search.cpan.org

MySQL（に限らないと思う）でwhereに関数を利用したい時は多々あると思います。
例えば、更新時刻を見て7日以上古ければ選択しないという条件をwhereに指定したい時、

CREATE TABLE  `table` (
    `name` VARCHAR( 5 ) ,
    `update_time` TIMESTAMP
)

SELECT * FROM `table` WHERE update_time > SUBDATE(NOW(), interval 7 day);

このようなSQLだとします。

行の選択 select / DBIx::Custom リファレンス – サンプルコードによるPerl入門によれば、where句の設定は、

where => {title => 'Perl', author => 'Ken'}

と、ハッシュリファレンスで渡すことになっています。

= 以外での比較は DBIx::Custom::Whereオブジェクト を作成して渡すことになっているのですが、ハッシュリファレンスで SUBDATE(NOW(), interval 7 day) を渡すとうまくいかないので悩んでいました。

append => ” で文字列を追加できるので、無理やり実装してみたのですが作者にツイートしてみたところ、

がーん、そうなのか。恥ずかしい。。さらに、

がーん、DBIx::Custom::Where でも文字列が指定できたのか。。。（恥恥

という事で、

use DBIx::Custom;
my $dbi = DBIx::Custom->connect(
    ...........  端折ります
);
my $result = $dbi->select(
    table => 'table',
    where => 'create_time > SUBDATE(NOW(),  interval 7 day)', 
);

あるいは、

use DBIx::Custom;
my $where = $dbi->where;
$where->clause([
    'and', 'create_time > SUBDATE(NOW(),  interval 7 day)'
]);
my $result = $dbi->select(
    table => 'table',
    where => $where, 
);

で、出来るって事なんですね。（ソース嫁！）

id:perlcodesampleさんありがとうございました！
DBIx::Customいいよー。

ところで

SYNOPSYSにあるinsertとかupdateとかが失敗するのはボクの日頃の行いが悪いせいでしょうか？

    # Insert 
    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
    
    # Update 
    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
      where  => {id => 5});

    # Insert 
    $dbi->insert( param => {title => 'Perl', author => 'Ken'}, table  => 'book' );
    
    # Update 
    $dbi->update( param => {title => 'Perl', author => 'Ken'}, table  => 'book',
      where  => {id => 5} );

だと性交いや、成功するのですが。
param が必要？？（だからソース嫁！）

追記：DBIx::Customのバージョンが 0.168 だったからのようです…APIが追加された模様。

Text::Mecabがインストール出来なかった。
そういえば昔諦めた気がする。
で、エラー内容を見てみる。

# perl Makefile.PL
Path to mecab config? [/usr/local/bin/mecab-config] 
detected mecab version 0.98
Using compiler flags '-I/usr/local/include -DMECAB_MAJOR_VERSION=0 -DMECAB_MINOR_VERSION=98'...
Using linker flags '-L/usr/local/lib -lmecab -lstdc++'...

Text::MeCab needs to know what encoding you built your dictionary with
to properly execute tests.

Encoding of your mecab dictionary? (shift_jis, euc-jp, utf-8) [euc-jp] utf-8
Using utf-8 as your dictionary encoding
Detected the following mecab information:
   version: 0.98
   cflags: -I/usr/local/include -DMECAB_MAJOR_VERSION=0 -DMECAB_MINOR_VERSION=98 -I src
   libs: -L/usr/local/lib -lmecab -lstdc++
   include: /usr/local/include
/root/.cpanm/work/1294395897.25225/Text-MeCab-0.20011/assertlibeiKR8srG: error while loading shared libraries: libmecab.so.1: cannot open shared object file: No such file or directory
/root/.cpanm/work/1294395897.25225/Text-MeCab-0.20011/assertlibEejMJieF: error while loading shared libraries: libmecab.so.1: cannot open shared object file: No such file or directory
wrong result: 'mecab', 'mecab'

libmecab.so.1 が見つからないらしい。
/usr/local/lib/libmecab.so.1 にインストールされている。

CentOSの標準設定ではPATHが通っていないらしいので、/usr/local/lib/ 配下のライブラリが読み込まれない様子。

で、/etc/ld.so.conf あたりをいじる必要がある。

# vi /etc/ld.so.conf

/usr/local/lib    ←最終行に追記

ldconfigを実行して、ライブラリ読み込みパスを更新。

# ldconfig 

※pathが通っていない場合は /sbin/ldconfig

Text::Mecab のディレクトリへ移動して手動でインストール

perl Makefile.PL
make
make test
make install

ImageMagickのインストールはyumで管理するのが一番簡単。
ただし、CentOSのImageMagickはバージョンが古い（v6.2.8）

ImageMagickのperlモジュール（PerlMagick？）はCPANでインストールすると入らないので、yumでスコッといれる。 .. continue reading ..

Email::Valid

http://search.cpan.org/~rjbs/Email-Valid-0.184/lib/Email/Valid.pm

現在でも更新されている感じのモジュール。携帯向けに Email::Valid::Loose と言うモジュールもある（有名なMIYAGAWAさん作）通常ならばこのモジュールでいいと思う。

Mail::CheckUser

http://search.cpan.org/~ilyam/Mail-CheckUser-1.21/CheckUser.pm

Data::Dumper の作者らしい。18 Sep 2003 となっているので更新はだいぶ前。でもこのモジュールはなかなか良くて、存在ユーザーをある程度（？）調べてくれる。存在ユーザーのチェックは送信先のメールサーバの設定によって違うのかもしれない。ソースに
## gTLD Wildcard IPs
$NXDOMAIN= {………}
って感じでトップレベルドメイン（？）のAレコードやらCNAMEと思われるものが定義されているけど、これって更新されないのかなぁ？

で、こちらのモジュールでは携帯向けのアドレスで @ の前に . が付くもの（abc..@docomo.ne.jp など）は使えません。RFC822違反だそうです。

そこで Mail::CheckUser::Loose なるモジュールを作成・・・した訳ではないけど、リメイクして使いました。

自分の環境では /usr/lib/perl5/site_perl/5.8.5/Mail/CheckUser.pm でしたので、/usr/lib/perl5/site_perl/5.8.5/Mail/CheckUser と言うディレクトリを作り、その中に CheckUser.pm をコピペして Loose.pm にリネーム。

その Loose.pm を数カ所変更するだけです。

7行目付近

package Mail::CheckUser;
↓ ::Loose を追記
package Mail::CheckUser::Loose;

190行目付近

sub last_check() {
    return $Mail::CheckUser::Last_Check;
}
↓ ::Loose を追記
sub last_check() {
    return $Mail::CheckUser::Loose::Last_Check;
}

214行目付近

my $STRING_RE = ('[' . quotemeta(join '',
                                 grep(!/[<>()\[\]\\\.,;:\@"]/, # ["], UnBug Emacs
                                      map chr, 33 .. 126)) . ']');
↓ \. を削除
my $STRING_RE = ('[' . quotemeta(join '',
                                 grep(!/[<>()\[\]\\,;:\@"]/, # ["], UnBug Emacs
                                      map chr, 33 .. 126)) . ']');

244行目付近

    my $resolver = $Mail::CheckUser::Net_DNS_Resolver || new Net::DNS::Resolver;
↓ ::Loose を追記
    my $resolver = $Mail::CheckUser::Loose::Net_DNS_Resolver || new Net::DNS::Resolver;

スキル不足で継承とかよくわからないので（汗

use Mail::CheckUser::Loose;
my $check_email='h.o.g.e.@docomo.ne.jp';

$Mail::CheckUser::Loose::Timeout = 15;
$Mail::CheckUser::Loose::Treat_Timeout_As_Fail = 'true';

if(check_email($check_email)) {
    print "有効なアドレスです。";
}else {
    print "無効なアドレスです。",last_check()->{reason};
}

こんな感じで使ったりしてます。

以下修正後の全ソース

.. continue reading ..