Mojolicious – GitHubより引用

    package MyApp;
 
    use Mojo::Base 'Mojolicious';
 
    use DBIx::Custom;
 
    has dbi => sub {
        my $dbi = DBIx::Custom->connect(...);
        return $dbi;
    };
 
    sub startup {
        my $self = shift;
 
        ### YOU MUST NOT CALL dbi() method in starup().
    }

リンク先にはBad Exampleもあるので参考に。

DBIx::Custom select メソッドの whereの項目を見ると様々な指定方法が出来ることが分かる。

注意する点はStringを渡す時。

where => "url = 'http://hoge.com/huga.cgi?key=value' ",

上のように条件に ? が含まれる場合、SQLの作成に失敗する。（DBIx::Custom::QueryBuilder::build_queryでかな？）

? がメタ文字として扱われるため？（\?とエスケープしてもダメ）

Hashリファレンスで渡すと大丈夫です。

where => {url => 'http://hoge.com/huga.cgi?key=value' },

これを踏まえてコードにすると、安全なのはこんな感じのコードになるのかな。

    my $id = 1;
    my $url = 'http://hoge.com/huga.cgi?key=value';
    $result = $dbi->select(
        table   =>  'table_name',
        column  => [qw/title content url/],
        where => [
                    ["and", "{= id}", "url = :url", "update_time > SUBDATE( NOW(), interval 7 day )"],
                    { id => $id, url => $url},
        ],
    );

※ {= id} は “id = :id” とも書ける（url = :urlも同様）。あえて両方含めてみた。

where にはDBIx::Custom::Whereオブジェクトも指定できますが、DBIx::Custom::Whereオブジェクトを生成する時にも同様で、? を含めた条件には注意が必要。

追記：タグ機能は廃止予定だそうです。
http://twitter.com/#!/perlcodesample/status/97162783644319744

$ pmvers DBIx::Cutom
0.168

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

$ cpanm pmvers

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

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

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

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が追加された模様。

#!/usr/bin/env perl

use strict;
use warnings;
use lib "../lib";
use App;

app->start('cgi');
exit;

こんな感じで呼び出すと通常のCGIとしてならなんの問題もなく実行出来るのだけれど、SpeedyCGIで実行しようとすると初回実行時に不具合が出る（テンプレートが読み込まれない？）上記実行方法でも２回目以降（キャッシュ後）は動作している感じ。

FastCGIやmod_perlでのエントリーは見かけるんだけど、いかんせんマイナーなSpeedyCGI。結構便利なのにあまり使われていないのかなぁ。

で、とりあえず解決方法が見つかったのでメモ。結論から言えば起動スクリプトで Mojo::Server::CGI を使ってアプリを実行すればいいみたい。

ApacheでCGI（SpeedyCGI）としてデプロイする

起動用スクリプトを mojoアプリケーション本体と同じディレクトリに置く。これは必須ではないので公開するときには配置を変えたり出来る。
（例えば App/public/mojo.cgi として App/public を公開ディレクトリにするなど）

__DATA__セクションにテンプレートを書けるけど、ここではテストのため外部ファイル化している。

最小構成

App +
    - App.pm
    - mojo.cgi
    - templates +
                - index.html.ep

スクリプト

起動用スクリプト mojo.cgi

#!/usr/bin/env speedy

use strict;
use warnings;

use Mojo::Server::CGI;
$ENV{MOJO_APP} = 'App';
#$ENV{SCRIPT_NAME} = '';
Mojo::Server::CGI->new->run;
exit;

App.pm と 起動スクリプトが同じディレクトリの場合は use lib; しなくても大丈夫のようだ。別のディレクトリに起動スクリプトを置く場合、例えばApp/public/mojo.cgi とするなら use “../”; が必要になる。

mojoアプリケーション本体 App.pm

package App;

use strict;    # use Mojolicious::Lite;で自動でされるが明示的に
use warnings;  # しておく。
use utf8;
use Mojolicious::Lite;

# テンプレートへ渡すハッシュリファレンス
my $params = {};

# インデックスページ
get '/' => sub {
    my $self = shift;

    $params->{title}="Hello World!";
    $params->{messe} = "ようこそ 世界へ！";
    $self->stash(params => $params);
} => 'index';

# mojo.cgi/任意の文字に対応
get '/:foo' => sub {
    my $self = shift;

    $params->{title}= $self->param('foo');
    $params->{messe} = "このページは" . $self->param('foo') . "です";
    $self->stash(params => $params);
} => 'index';

テンプレートファイル templates/index.html.ep

<!doctype html>
<html>
    <head>
    <title><%= $params->{title} %></title>
    </head>
    <body>
    <h1><%= $params->{messe} %></h1>
    </body>
</html>

上記は最低限のファイル構成だけれど、テンプレートでレイアウト使っても動作していたのでSpeedyCGI化もこの方法なら大丈夫そう。

参考

PODにあるコードは動作しないので注意。renderメソッドのAPIが変わったのかな？ソースを見ると引数の最初に送り先のメールアドレスを指定しないとダメみたい。

それと、Email::MIME::MobileJP にあるソースも間違えているので注意。syntax=>’TTerse’ は newする時に引数で指定する事。

use Email::MIME::MobileJP::Template;
use Email::Sender::Simple;

    my $token='123';
    my $to_email = '<foo@hoge.jp>'; # <>で囲わないとdocomoで受信したときToがおかしなことに。

    my $mail_maker = Email::MIME::MobileJP::Template->new(
                    'Text::Xslate' => {
                            syntax => 'TTerse',
                            path => ['email_tmpl/']     # テンプレートの保存場所
                    }
    );

    my $mail = $mail_maker->render(
                    $to_email,                  # 送信先
                    'signup.eml',               # テンプレートファイル
                    {token => $token}    # テンプレートで利用する変数
    );
    # メールを送信
    Email::Sender::Simple->send($mail);

テンプレートファイル

path で指定したディレクトリにテンプレートファイルを作成する。MIMEヘッダはテンプレートでしか指定できない。Fromは記述しないと致命的なエラーとなるので注意。

./email_tmpl/signup.eml

Subject: [Example] サインアップ!
From: <name@hoge.com>

    以下をクリックせよ
    http://example.com/signup/[% token %]

携帯電話宛のメールが正しく送れない？

メールテンプレートで、Fromに指定するメールアドレスは<>で囲わないとdocomoへ送ったときにUnknown user となってしまった。from=<> となっている。これは自分の環境の問題？

エラーになったテンプレートファイル例

Subject: [Example] サインアップ!
From: name@hoge.com

    以下をクリックせよ
    http://example.com/signup/[% token %]

Postfixのエラーログ

Apr  5 17:44:56 vm postfix/smtp[24073]: 7D4ED32358D: to=<xxxxx.@docomo.ne.jp>, relay=mfsmax.docomo.ne.jp[203.138.180.112]:25, delay=0.17, delays=0.09/0.01/0.03/0.04, dsn=5.0.0, status=bounced (host mfsmax.docomo.ne.jp[203.138.180.112] said: 550 Unknown user xxxxx.@docomo.ne.jp (in reply to end of DATA command))
Apr  5 17:44:56 vm postfix/cleanup[23741]: A169832358F: message-id=<20110405084456.A169832358F@mail.hoge.jp>
Apr  5 17:44:56 vm postfix/qmgr[1698]: A169832358F: from=<>, size=2480, nrcpt=1 (queue active)

あと、送信先のメールアドレスは

my $to_email = '<foo@hoge.jp>';

のように指定しないと携帯（docomoムーバ）で受信したときにおかしな挙動となる。メールを開くと返信不可マークのToヘッダが表示されている（メールアドレスは送った携帯のメアド）。返信しようとすると返信先を選択する画面になる。

メール送信の実装はガラケーとカオスな文字コードのおかげでやたらと面倒なことが多い。

簡単に使えるフレームワークとして、とりあえず Linux+Apacheで動けばおｋという前提で。

なにせフレームワーク初心者の戯事なのでそのあたりは察してください。

準備

httpでアクセス可能な場所にappというディレクトリを作成。
その中にapp.cgiファイルを作る。
ソース的にはこんな感じ。

#!/usr/bin/perl
##  又は、#!/usr/bin/env perl

use lib './lib';
use Mojolicious::Lite;

#use strict;         # use Mojolicious::Lite;の時点で
#use warnings;   # 両方共適用される
use utf8;

my $contents = {};

# Hello World!!
get '/' => sub {
    my $self = shift;

    $contents ->{messe} = "Hello World!!";
    $self->stash(contents=>$contents);

}=>'index';

app->start('cgi');

__DATA__

@@ index.html.ep
<html>
  <body>
    <h1>index page</h1>
    <%= $contents->{messe} %>
  </body>
</html>

構成

app（ディレクトリ）
  |- app.cgi（perl cgi）

lib以下にmojo関連のモジュールを置く

ダウンロード先もリンクに掲載されています。

解凍したmojoディレクトリの中にlibというディレクトリがあるのでまるっとアップロードする（1.2MB程ある）

app（ディレクトリ）
  |- app.cgi（perl cgi）
  |- lib
      |- mojo
      |-  .... 他たくさん

動作確認

app.cgi に実行権限を与える（700や705など）

http://hoge.com/app/app.cgi
にアクセスして無事indexページが表示されれば成功。

以下に全てのファイルが入ったzipがダウンロードできます。
appのサンプル

これでよいのか？

このような使い方は邪道なのかもしれないけど、手軽に簡単にフレームワークを使ったPerlスクリプトを書きたいとか、設置したいとかの要望はあると思うのですよ。

ただし、すべての機能が使えるかどうかは試していないのであしからず。

例えばこんなメールアドレスには送信出来ない。
例）read_rfc822.@docomo.ne.jp

元ソースの正規表現部分

# regex for e-mail addresses where full=$1, user=$2, domain=$3
# see pod documentation about this regex

my $word_rx = '[\x21\x23-\x27\x2A-\x2B\x2D\x2F\w\x3D\x3F]+';
my $user_rx = $word_rx         # valid chars
             .'(?:\.' . $word_rx . ')*' # possibly more words preceded by a dot
             ;
my $dom_rx = '\w[-\w]*(?:\.\w[-\w]*)*'; # less valid chars in domain names
my $ip_rx = '\[\d{1,3}(?:\.\d{1,3}){3}\]';

$address_rx = '((' . $user_rx . ')\@(' . $dom_rx . '|' . $ip_rx . '))';
; # v. 0.61

@EXPORT_OK に $address_rx が設定されているので、$Mail::Sendmail::address_rx の正規表現を変更すればエラーチェックに引っかからないようになる。

my $word_rx = '[\x21\x23-\x27\x2A-\x2B\x2D\x2F\w\x3D\x3F\.]+'; # \.を追記する
my $user_rx = $word_rx . '(?:\.' . $word_rx . ')*' ;
my $dom_rx = '\w[-\w]*(?:\.\w[-\w]*)*'; # less valid chars in domain names
my $ip_rx = '\[\d{1,3}(?:\.\d{1,3}){3}\]';
my $address_rx = '((' . $user_rx . ')\@(' . $dom_rx . '|' . $ip_rx . '))';
$Mail::Sendmail::address_rx= $address_rx;

正規表現を無効にした場合、当然の事ながらその前にメールアドレスの正当性をチェックしておく必要があると思う。（携帯メールアドレスを有効にするなら Email::Valid::Loose 等）

モダンなperlモジュール

メール送信系のモジュールは山ほどあるので何がいいか悩むところ。Mail::Sendmail のエントリーだけど、 Email::Sender がモダンなモジュールとして紹介されているのでリンクを載せておく。

気になる点は Moose に依存しているという事。

どうやらパッチを当ててからmakeする必要があるようだ。
参考：Apache2.2にmod_SpeedyCGIを組み込む方法（パッチファイルのあて方） / レンタルサーバー BIG-server.com

パッチファイルのダウンロード

パッチファイル：CGI::SpeedyCGI with apr-1.0

※パッチファイルはwgetで入手できないのでダウンロードしておいてFTP等でアップロードする必要がある。

SpeedyCGIのインストール

$ wget http://www.cpan.org/modules/by-authors/id/H/HO/HORROCKS/CGI-SpeedyCGI-2.22.tar.gz
$ tar zxvf CGI-SpeedyCGI-2.22.tar.gz

#####
CGI-SpeedyCGI-2.22/mod_speedycgi2 に
ダウンロードしたパッチをFTP等でアップロードする
#####

$ cd CGI-SpeedyCGI-2.22/mod_speedycgi2
$ patch -p1 < patch-mod_speedycgi2.c	＃パッチをあてる
can't find file to patch at input line 3
Perhaps you used the wrong -p or --strip option?
The text leading up to this was:
--------------------------
|--- src/mod_speedycgi2.c.orig	Tue Oct  7 13:03:48 2003
|+++ src/mod_speedycgi2.c	Sun Jan 23 20:42:43 2005
--------------------------
File to patch: ../src/mod_speedycgi2.c    # パッチをあてるファイルを指定

$ cd ../
$ perl Makefile.PL

Optional mod_speedycgi support.

Mod_speedycgi increases performance under Apache by avoiding the fork/exec
overhead associated with each request under normal SpeedyCGI.  However, it
requires a working copy of "apxs" in your path, Apache with mod_so
support, and additional Apache configuration.

Compile mod_speedycgi (default no)? yes    # yesを入力

$ make
$ make test
$ sudo make install

・・・エラー。

make[1]: apxs: コマンドが見つかりませんでした
make[1]: *** [install] エラー 127

sudo make install -i   # エラーを無視するオプションをつけてインストール。

mod_SpeedyCGIがインストールされないので、Apacheモジュールディレクトリにコピーする。
README通り、CGI-SpeedyCGI-2.22/mod_speedycgi2/.libs に mod_speedycgi.so が作成されているので /usr/lib/httpd/modules にコピーする（CentOSの場合）

$ cd mod_speedycgi2/.libs
$ sudo cp mod_speedycgi.so /usr/lib/httpd/modules

基本

use Date::Calc qw(:all);

# 今日
my ($yyyy,$mm,$dd) = Today();
print "$yyyy/$mm/$dd"; 

# 実行結果
2011/1/21

昨日の日付（日付計算）

use Date::Calc;

my ($yyyy,$mm,$dd) = Date::Calc::Today();
@y = Date::Calc::Add_Delta_Days($yyyy, $mm, $dd, -1);
my $yesterday= join('/',@y);

print "昨日=$yesterday\n";

# 実行結果
昨日=2011/1/20

Date::Calc::Add_Delta_Days($yyyy, $mm, $dd, -1);の-1を-7にすれば7日前、5にすれば5日後となる。

前月1日と月末を算出

use Date::Calc;

@y = Date::Calc::Add_Delta_YMD($yyyy, $mm, 1, 0 ,-1, 0); #前月1日
$start = join('/',@y);
@y = Date::Calc::Add_Delta_YMD($yyyy, $mm, 1, 0, 0, -1); #前月末日
$end = join('/',@y);

print "前月1日=$start\n";
print "前月末日=$end\n";

# 実行結果
前月1日=2010/12/1
前月末日=2010/12/31

Date::Calc – 日付の計算にもサンプルが。
日付の不正を確認、指定した月の日数を取得、タイムスタンプを取得など。