仕事のこと Archive

Moose が 0.74 になったのに併せて Class::MOP が 0.81 になって今まで警告なしに動いていたスクリプトで警告が出るようになった。

The compute_all_applicable_attributes method has been deprecated. Use get_all_attributes instead.
 at /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi/Class/MOP/Class.pm line 929
        Class::MOP::Class::compute_all_applicable_attributes('Class::MOP::Class::__ANON__::SERIAL::41=HASH(0x8a0b850)') called at /usr/lib/perl5/site_perl/5.8.8/Data/Visitor/Callback.pm line 42
        Data::Visitor::Callback::BUILDARGS('Data::Visitor::Callback', 'plain_value', 'CODE(0x9c09398)') called at generated method (unknown origin) line 4
        Data::Visitor::Callback::new('Data::Visitor::Callback', 'plain_value', 'CODE(0x9c09398)') called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/ConfigLoader.pm line 86
        Shiori::ConfigLoader::load('Shiori::ConfigLoader=HASH(0x9bf1c50)') called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/ConfigLoader.pm line 33
        Shiori::ConfigLoader::new('Shiori::ConfigLoader') called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/DateTime.pm line 44
        Shiori::DateTime::now('Shiori::DateTime') called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/Schema/Tag.pm line 162
        Shiori::Schema::Tag::update_shiori_count('Shiori::Schema::Tag=HASH(0x9c0a634)') called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/Schema/Shiori.pm line 260
        Shiori::Schema::Shiori::create_tags('Shiori::Schema::Shiori=HASH(0x9bf15d8)') called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/API/Shiori.pm line 97
        Shiori::API::Shiori::__ANON__() called at /usr/lib/perl5/site_perl/5.8.8/DBIx/Class/Storage/DBI.pm line 626
        DBIx::Class::Storage::DBI::txn_do('DBIx::Class::Storage::DBI::mysql=HASH(0x9a341c4)', 'CODE(0x9a35620)') called at /usr/lib/perl5/site_perl/5.8.8/DBIx/Class/Schema.pm line 734
        DBIx::Class::Schema::txn_do('Shiori::Schema=HASH(0x9a4c4d4)', 'CODE(0x9a35620)') called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/API/Shiori.pm line 110
        eval {...} called at /home/travail/public_html/SVNHOME/Shiori/bin/utils/shiori/../../../lib/Shiori/API/Shiori.pm line 110
        Shiori::API::Shiori::update('Shiori::API::Shiori=HASH(0x9a216e0)', 'HASH(0x9b39534)') called at ./update.pl line 24
        main::main() called at ./update.pl line 11

出力された警告の3行目を見ると

Class::MOP::Class::compute_all_applicable_attributes('Class::MOP::Class::__ANON__::SERIAL::41=HASH(0x8a0b850)') called at /usr/lib/perl5/site_perl/5.8.8/Data/Visitor/Callback.pm line 42

と言われる。
素直に Data::Visitor::Callback の42行目あたりを覗いてみると BUILDARGS の中で compute_all_applicable_attributes をコールしている。

sub BUILDARGS {
    my ( $class, @args ) = @_;

    my $args = $class->SUPER::BUILDARGS(@args);

    # ここね
    my %init_args = map { $_->init_arg => undef } $class->meta->compute_all_applicable_attributes;

    my %callbacks = map { $_ => $args->{$_} } grep { not exists $init_args{$_} } keys %$args;

Class:MOP の 0.80_01 の Changes で

- compute_all_applicable_attributes is deprecated, use get_all_attributes

となっている。

Data::Visitor の AUTHOR の Yuval は Class::MOP の CONTRIBUTOR だからそのうち直る。って言うか、Class::MOP は IRC ないのか？

追記
じゃ、42行目の

$class->meta->compute_all_applicable_attributes;

を

$class->meta->get_all_attributes;

に変更したらいいのかと言うとそうわけでもなく、Data::Visitor::Callback では Squirrel で Moose と Mouse の切り分けを行っていて Moose を使用していた場合は get_all_attributes でいいのだけれど、Mouse を使用していた場合は見事に

Can't locate object method "get_all_attributes" via package "Mouse::Meta::Class"

でコケる。

Can't locate object method "get_all_attributes" via package "Mouse::Meta::Class"

は Mouse を 0.20 にすると解決する。

私信になりますが、改めてという意味で別記事で。あと、はてなのアカウント持っていないので。

QueueQ4M (0.00018) 動いてます。

• Any::Moose - 0.05
• Moose - 0.72
• Mouse - 0.17
• Queue::Q4M - 0.00018

の環境ですっごい動いてます。

本来ならパッチを送りたいところでしたが如何せん Mouse と Moose に不慣れなものでああいった記事を書きました。
修正ありがとうございます。

Queue::Q4M をバージョン 0.00017 にアップグレードしたら 0.00016 まで動いていたスクリプトが動かなくなった。

• Any::Moose - 0.04
• Moose - 0.71
• Mouse - 0.17
• Queue::Q4M - 0.00017

Queueu::Q4M を実際に使ってるプロジェクトではモジュール化してしまってデバッグがちょこっとしずらいので、簡単なスクリプトを書いてみる。
ちなみに、そのプロジェクトでは Moose も Mouse も使っていないので use Queue::Q4M より先に　Moose なり Mouse なりがロードされていることはない。

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
#use Moose;
#use Mouse;
use Queue::Q4M;

our $table = 'queue_export';

main();
exit;

sub main {
    my $q4m = Queue::Q4M->connect(
        connect_info => [
            'dbi:mysql:dbname=shiori_local;host=192.168.1.1;port=3308',
            'username', 'password'
        ]
    );
    while ( $q4m->next($table) ) {
        my $queue = $q4m->fetch_hashref( $table,
            [qw(created_on member_id type)] );
        warn Dumper($queue);
    }
}

こんなコードを実行してキューを入れてみると

[travail@mina]~% ./queue_export.pl
Attribute (__res) does not pass the type constraint because: Validation failed for 'Maybe[Queue::Q4M::Result]' failed with value Queue::Q4M::Result=ARRAY(0x9c32cac) at /usr/lib/perl5/site_perl/5.8.8/Mouse/Meta/Attribute.pm line 339
        Mouse::Meta::Attribute::verify_type_constraint_error('Mouse::Meta::Attribute=HASH(0x9c058b0)', '__res', 'Queue::Q4M::Result=ARRAY(0x9c32cac)', 'Maybe[Queue::Q4M::Result]') called at (eval 18) line 5
        Mouse::Meta::Attribute::__ANON__('Queue::Q4M=HASH(0x9be2978)', 'Queue::Q4M::Result=ARRAY(0x9c32cac)') called at /usr/lib/perl5/site_perl/5.8.8/Queue/Q4M.pm line 159
        Queue::Q4M::next('Queue::Q4M=HASH(0x9be2978)', 'queue_export') called at ./queue_export.pl line 22        main::main() called at ./queue_export.pl line 12

なんてエラーが出てきちゃう。0.00016 までは動いていたのになぁ。
0.00017 の Changes を見てみると

0.00017 - 20 Feb 2009
  - s/Squirrel/Any::Moose/g

Moose, Mouse の切り替えを Any::Moose に変えたみたい。
ということで、さっきのスクリプトの "use Moose", "use Mouse" のコメントアウトを順番にはずして試してみると、"use Moose" されているときはスクリプトが動いて、"use Mouse" されているときは動かない。

Queue::Q4M - 0.00016 の場合

• 明示的に Moose, Mouse をロードしていない場合でも動く
• 明示的に Moose をロードしている場合でも動く
• 明示的に Mouse をロードしている場合でも動く

Queue::Q4M - 0.00017 の場合

• 明示的に Moose, Mouse をロードしていない場合は動かない
• 明示的に Moose をロードしている場合は動く
• 明示的に Mouse をロードしている場合でも動かない

この結果は Mouse を 0.16 に下げても同じだったし、Any::Moose を 0.03 に下げてもだめだった。
と言うか、Queue::Q4M のインストールで DB につなぎにいかないでインストールしてたんですよね。面倒なので。
改めて DB つないでテストしてみたら同じエラーがちゃんと出てた。テストがちゃんと書かれててもインストールする側がちゃんと実行しなけりゃ意味ないですね。ごめんなさい、ごめんなさい。

Firefox でちょん切れるです。IE に至ってはパースエラー。

とあるプロジェクトで吐いた RSS がどうも調子が悪い。
その RSS はこんな感じの。

ちょん切れちゃってる RSS

4つ目の item の「Emacs の Tramp こんなに便利とは - ひげぽん OSとか作っちゃうかMona-」から下がちょん切れてる。ソースを見ても確かに20件あるのに5つ目の item の「mixi Engineers’ Blog » DBMによるテーブルデータベース その弐」以降の item が表示されない。

  4つ目の item
  <item rdf:about="http://d.hatena.ne.jp/higepon/20090126/1232937495">
    <title> Emacs の Tramp こんなに便利とは - ひげぽん OSとか作っちゃうかMona-</title>
    <link>http://d.hatena.ne.jp/higepon/20090126/1232937495</link>
    <description>便利だ。</description>
    <content:encoded>便利だ。</content:encoded>
    <dc:date>2009-01-27T03:05:52</dc:date>
    <dc:subject>emacs</dc:subject>
    <dc:subject>TIPS</dc:subject>
    <dc:subject>ssh</dc:subject>
    <dc:subject>Tramp</dc:subject>
  </item>
  5つ目の item
  <item rdf:about="http://alpha.mixi.co.jp/blog/?p=292">
    <title>mixi Engineers&#8217; Blog &raquo; DBMによるテーブルデータベース その弐</title>
    <link>http://alpha.mixi.co.jp/blog/?p=292</link>
    <description></description>
    <content:encoded></content:encoded>
    <dc:date>2009-01-27T03:04:22</dc:date>
    <dc:subject>mixi</dc:subject>
    <dc:subject>mikio</dc:subject>
    <dc:subject>DBM</dc:subject>
    <dc:subject>TokyoCabinet</dc:subject>
  </item>

RSS のソースをのぞくと気になるところを発見。mixi Engineers' Blog の ’ と » が非常に怪しい。以前、 HTML をパースして title タグを取ろうとしたときも「うぐぅ」って言っていたような気もする。きっと今回もそれが原因だと思う。
グーグルさんで調べてみると RSS(XML) で使用できる実体参照は

• &(&)
• &lt;(<)
• &gt;(>)
• &apos;(')
• &quot;(")

mixi Engineers' Blog の &raquo; は RSS(XML) では使用することができないので今回僕が吐いた RSS がちょん切れてしまって「うぐぅ」となっているのだろうと思います。
文字参照の &#8217; の方も多分使用できないのだと思います。

うぐぅ。
上記の使用できる実体参照・文字参照はあくまでデフォルトでということで、&#8217; と &raquo; が定義された DTD を読み込めばよいそうです。
ということで、今回読み込んだ DTD はこれ。

http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd

その DTD を読み込んだ RSS がこれ。

ちょん切れちゃってない RSS

途中でちょん切れることなく表示されていますよね？XML のソースを見ると

  <item rdf:about="http://alpha.mixi.co.jp/blog/?p=292">
    <title>mixi Engineers&#8217; Blog &raquo; DBMによるテーブルデータベース その弐</title>
    <link>http://alpha.mixi.co.jp/blog/?p=292</link>
    <description></description>
    <content:encoded></content:encoded>
    <dc:date>2009-01-27T03:04:22</dc:date>
    <dc:subject>mixi</dc:subject>
    <dc:subject>mikio</dc:subject>
    <dc:subject>DBM</dc:subject>
    <dc:subject&>TokyoCabinet</dc:subject>
  </item>

&#8217; と &raquo; のままですね。ちゃんと参照されているみたいです。

めでたし、めでたしと言いたいところだけれども、はてブなんかの RSS のソースを見ると &#8217; は ’ に、&raquo; は » になっていますが RSS を吐く際にアプリ側で変換しているのでしょうか？
この場合、常套手段って何なんでしょう？XML だと言っているのに XHMLT の DTD を読み込むのは間違っている気がしてならない。RSS2.0 の場合はどうなのだろうか？Atom の場合は？
うぬぅ。

そうそう、僕の MT には記事を書いている途中に記事の「公開状態」がこっそり「公開」になる新機能が着いています。書いている途中に記事を保存するとうっかり PING を送信してしまいます。
その更新扱いにされている自分の記事をRSSリーダー越し眺めているときってS目線で見ればいいのかM目線で見ればいいのか複雑な気持ちになります。

追記：
W3C の RSS の構文チャックするとダメよダメダメダメ星人って言われる。

前の記事、立った！mysql が立ったよ！で書いた通り mysql のレプリケーションがずれてしまったのでそれを直します。
なので多分、この日々のことも落ちます。

と書きましたが、数時間経つと同じエラーが出て mysql が落ちます。
innodb_flush_method = O_DSYNC にしても数時間経つと同じようにエラーを吐いて mysql が落ちます。これはもう mysql が flush する部分のソース読むしかないのかな。

/var/lib/mysql/ibdata1 は 12G。ファイルサイズが原因なんじゃないかとは感じていますがマスタの mysql は落ちずに頑張ってくれているので、単純にファイルサイズの問題でもないとは思うんですけどねぇ・・・。誰か知ってます？

まぁ、クララなんですけどね。

今回のエラーのキーワードは何と言っても

081111  1:56:26  InnoDB: Error: the OS said file flush did not succeed
081111  1:56:27  InnoDB: Operating system error number 5 in a file operation.
InnoDB: Error number 5 means 'Input/output error'.

の部分なのでとりあえず perror をしてみる。

[travail@mina]/home/travail% perror 5
OS error code   5:  Input/output error

うん、あまり意味ないですね。
でも、flush はキーワードだと思うので google さんに聞いてみると。
MySQL :: MySQL 5.1 リファレンスマニュアル :: 13.5.4 InnoDB 起動オプションとシステム変数

ここの、「innodb_flush_method」がとっても怪しいですよね。

もし fdatasync  (デフォルト)に設定すると、InnoDB  はデータとログ ファイルの両方
をフラッシュする為に fsync() を利用します。
なんたらかんたら・・・

「データとログファイルの両方を」なんてよくわからない言葉を使っていますが、データとはバッファのことではないかと。innodb_log_buffer_size で指定している、あのバッファ。
ログファイルはログファイルですよね。innodb_log_file_size で指定しているやつかな。
で、僕は innodb_flush_method を /etc/my.cnf で指定していなかったのでデフォルトの fdatasync で動いていたみたいなんですね。
なので、「innodb_flush_method = O_DIRECT」 とかに適当に設定したら立っちゃったんですよねぇ、mysql。
なんでかは知らない。知らないけどこれは忘れないように書いておきたいと思います。

• fdatasync
• バッファとログファイルを flush するのに fsync(2) を使用する。（fdatasync って言ってんのに fdatasync(2) を使っていない）
• fsync(2) はファイル更新の際にメタ情報（stat）を更新する。fdatasync(2) は更新しない。
• そもそも、どのフラグ立ててファイルをオープンして fsync(2) してるのか不明。
• O_DSYNC
• バッファとログファイルを flush するのに fsync(2) を使用するのは fdatasync を指定した場合と一緒。ただ、バッファ、ログファイルを O_SYNC でオープンする。
• O_DSYNC と言っているものの、O_DSYNC フラグを立ててファイルをオープンするわけでなない。
• O_SYNC フラグでファイルをオープンすると、書き込み（write(2)）が終わるまで必ず呼び出しもとのプロセスをブロックする。
• O_DIRECT
• バッファとログファイルを fsync(2) で flush。O_DIRECT フラグを立ててオープン。
• ファイルに対する I/O のキャッシュを最小化しようとする。
• このフラグを使用すると一般的に機能が低下する。
• 「O_DIRECT でいつも困るのは、インタフェース全部が本当にお馬鹿な点だ。たぶん危ないマインドコントロール剤で頭がおかしくなったサルが設計したんじゃないかな」 -- Linus

innodb_flush_method を O_DIRECT にして何でクララが立ち上がったかはわからないけれど、O_DIRECT はやめて fdatasync か O_DSYNC にしようかと思います。
クララが立ったのはいいのですが5,000万レコードのレプリケーションは見事にずれていたので週末にでも復旧作業しないといけません。やれやれです。

あ、それと記事を書いている途中に「公開状態」がいつの間にか「公開」になっているんですけど誰ですか？

いつの間にか mysql が落ちていた。そしてまだ立ち上がらない。

081111  1:56:26  InnoDB: Error: the OS said file flush did not succeed
081111  1:56:27  InnoDB: Operating system error number 5 in a file operation.
InnoDB: Error number 5 means 'Input/output error'.
InnoDB: Some operating system error numbers are described at
InnoDB: http://dev.mysql.com/doc/refman/5.0/en/operating-system-error-codes.html
InnoDB: File operation call: 'flush'.
InnoDB: Cannot continue operation.

Number of processes running now: 0
081111 01:56:29  mysqld restarted
081111  1:56:30  InnoDB: Database was not shut down normally!
InnoDB: Starting crash recovery.
InnoDB: Reading tablespace information from the .ibd files...
InnoDB: Restoring possible half-written data pages from the doublewrite
InnoDB: buffer...
081111  1:56:31  InnoDB: Starting log scan based on checkpoint at
InnoDB: log sequence number 7 2108323381.
InnoDB: Doing recovery: scanned up to log sequence number 7 2108364559
InnoDB: 1 transaction(s) which must be rolled back or cleaned up
InnoDB: in total 63 row operations to undo
InnoDB: Trx id counter is 0 10543104
081111  1:56:31  InnoDB: Starting an apply batch of log records to the database...
InnoDB: Progress in percents: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 
InnoDB: Apply batch completed
InnoDB: In a MySQL replication slave the last master binlog file
InnoDB: position 0 144, file name mysqld-bin.000020
InnoDB: Starting in background the rollback of uncommitted transactions
081111  1:56:32  InnoDB: Rolling back trx with id 0 10542683, 63 rows to undo
081111  1:56:33  InnoDB: Started; log sequence number 7 2108364559
081111  1:56:37 [Warning] Neither --relay-log nor --relay-log-index were used; so replication may break when this MySQL server acts as a slave and has his hostname changed!! Please use '--relay-log=/var/run/mysqld/mysqld-relay-bin' to avoid this probl
em.

InnoDB: Rolling back of trx id 0 10542683 completed
081111  1:56:37  InnoDB: Rollback of non-prepared transactions completed
081111  1:56:37 [Note] /usr/libexec/mysqld: ready for connections.
Version: '5.0.45'  socket: '/var/lib/mysql/mysql.sock'  port: 3306  Source distribution
081111  1:56:37 [Note] Slave I/O thread: connected to master 'repl@192.168.1.1:3306',  replication started in log 'mysqld-bin.000020' at position 1058192307
081111  1:56:37 [Note] Slave SQL thread initialized, starting replication in log 'mysqld-bin.000020' at position 1058178872, relay log '/var/run/mysqld/mysqld-relay-bin.000230' position: 16306827
081111  2:37:28  InnoDB: Error: the OS said file flush did not succeed
081111  2:37:28  InnoDB: Operating system error number 5 in a file operation.
InnoDB: Error number 5 means 'Input/output error'.
InnoDB: Some operating system error numbers are described at
InnoDB: http://dev.mysql.com/doc/refman/5.0/en/operating-system-error-codes.html
InnoDB: File operation call: 'flush'.
InnoDB: Cannot continue operation.

はじめて見るログです。読んだ感想としては「イヤな感じ」がしますよね。
何が原因なのかわからないし、ぶっちゃけちゃうとわからなくてもいいかなぁ、なんて思ってます。
落ちたのがスレーブ側なのでもう一回スレーブ組み直してもいいなぁと。
ただ、ひとつだけ大きな DB があって約5,000万レコード。マスタからこのデータ持ってくるの面倒。
週末にでもやってみましょうかね。

その5,000万レコードの DB は Catalyst + DBIC で作ったアプリの DB なんですけど、この量のレコードでも結構普通に動くものです。DBIC で sth 直接握って SQL 発行したりしなくても大丈夫。
ま、僕くらいしか使ってないからね。

それはそうと、MT の「公開状態」の設定がデフォルトで「公開」になっていたんですけど、誰ですかいじったのは？誰にも言いませんのでコメントください。

時折悩むのが Catalyst の attribute の ':'（コロン）。
Catalyst::Manual::Cookbook では

sub end : Private {

でも、Helper で生成される Controller では

sub index :Path :Args(0) {

コロンの後ろに半スペ入れるの？入れないの？
Helper で生成される方は半スペが入ってないので今ではそれに合わせていますけど、以前は CookBook の方に合わせて書いていたからどうしようもなく直したい。

で、みなさんはどう書く？

例えばこんなコードを実行すると

#!/usr/bin/perl

use strict;
#use warnings;
use Storable qw//;

my $coderef = sub {};
my $freezed = Storable::freeze($coderef);
my $thawed  = Storable::thaw($freezed);

exit;

怒られます。

Can't store CODE items at blib/lib/Storable.pm (autosplit into blib/lib/auto/Storable/_freeze.al) line 339, at ./storable.pl line 12

これの解決として、$Storable::Deparse に真値を入れてあげればよいみたい。上記のコードに 「$Storable::Deparse = 1」 にみたいなことをして再度実行してみると

Can't eval, please set $Storable::Eval to a true value at blib/lib/Storable.pm (autosplit into blib/lib/auto/Storable/thaw.al) line 415, at ./storable.pl line 13

と怒られる。
今度は「please set $Storable::Eval to a true value」と言ってくれているので freeze のときに怒っていた人とは別の人ですね、きっと。 優しさを感じます。mst ではないことは確かですね。
で、結局スクリプトはこうなります。

#!/usr/bin/perl

use strict;
#use warnings;
use Storable qw//;
use Data::Dumper;

$Storable::Deparse = 1;
$Storable::Eval    = 1;

my $coderef = sub {};
my $freezed = Storable::freeze($coderef);
my $thawed  = Storable::thaw($freezed);

exit;

Cache::*** 系をデバッグしてて適当に Catalyst の $c をキャッシュしようと思ったら「Can't store CODE」のエラーに出くわしたんですね。今まで CODE をキャッシュしたことがなかったのかなぁと思うとそうでもないような気がします。でも、キャッシュしたことがなかったんでしょうね。

Hyper Estraier の estcmd search で複数の属性に対して検索をかける場合、

estcmd search -attr '@uri STRINC mydoc @id NUMBT 1 100' /tmp/casket

ではなくて、

estcmd search -attr '@uri STRINC mydoc' -attr '@id NUMBT 1 100' /tmp/casket

とする。

ユーザーガイドに

とあるのでそのままの意味で -attr を複数指定すればいいんだけど1時間以上悩んだ。google さんに聞いても実際に -attr を複数指定しているコマンドの例文なんて全然ひっかからないし。もう、じぇ～んじぇん。
しまいには、

estcmd search -attr '@uri STRINC mydoc AND @id NUMBT 1 100' /tmp/casket

とか試してみたりして。
もちろんこんな構文が通用するわけもなく、ごく当たり前に0件っていう結果が返ってくるわけだけど、さすがにこのコマンドを試した自分が恥ずかしくなった。
何と言うか、クラスでも人気の女の子に

いやいや、ちょっと待って。即答しないで。「な～んちゃって」って言わせてよ。みたいな感じですよね。Hyper Estraier にもこの「な～んちゃって」の部分を汲み取ってほしかったんですけどね。残念です。

前の記事で shot さんからコメントをもらったので再度 perl のバージョンアップしてみることに。RPM は perl-5.8.8-15.el5_2.1.i386.rpm かな。

yum update で perl をアップデートしていい感じに

Errno architecture (i386-linux-thread-multi-2.6.18-8.el5) does not match executable architecture (i386-linux-thread-multi-2.6.18-53.1.14.el5pae) at /usr/lib/perl5/site_perl/5.8.8/Errno.pm line 11.
Compilation failed in require at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine.pm line 7.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine.pm line 7.
Compilation failed in require at (eval 2) line 3.
      ...propagated at /usr/lib/perl5/5.8.8/base.pm line 85.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine/CGI.pm line 4.
Compilation failed in require at (eval 1) line 3.
      ...propagated at /usr/lib/perl5/5.8.8/base.pm line 85.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine/HTTP.pm line 4.
Compilation failed in require at /home/travail/public_html/SVNHOME/Shiori/script/shiori_server.pl line 7.
BEGIN failed--compilation aborted at /home/travail/public_html/SVNHOME/Shiori/script/shiori_server.pl line 8.

こんなエラーが出たら、Errno と Scalar::Util を rebuild。
まずは Errno から。

[travail@cabane]/tmp% wget http://search.cpan.org/CPAN/authors/id/G/GB/GBARR/Errno-1.10.tar.gz
[travail@cabane]/tmp% tar xzvf Errno-1.10.tar.gz
[travail@cabane]/tmp% cd Errno-1.10
[travail@cabane]/tmp/Errno-1.10% perl Makefile.PL
[travail@cabane]/tmp/Errno-1.10% make
[travail@cabane]/tmp/Errno-1.10% make test
[travail@cabane]/tmp/Errno-1.10% sudo make install

続いて、Scalar::Util

[travail@cabane]/tmp% wget http://search.cpan.org/CPAN/authors/id/G/GB/GBARR/Scalar-List-Utils-1.19.tar.gz
[travail@cabane]/tmp% tar xzvf Scalar-List-Utils-1.19.tar.gz
[travail@cabane]/tmp% cd Scalar-List-Utils-1.19
[travail@cabane]/tmp/Scalar-List-Utils-1.19% perl Makefile.PL
[travail@cabane]/tmp/Scalar-List-Utils-1.19% make
[travail@cabane]/tmp/Scalar-List-Utils-1.19% make test
[travail@cabane]/tmp/Scalar-List-Utils-1.19% sudo make install

Errno と Scalar::Util の rebuild が済んだら DBIC を使ったスクリプトを動かしてみると

WARNING: DBIx::Class::StartupCheck: This version of Perl is likely to exhibit
extremely slow performance for certain critical operations.
Please consider recompiling Perl.  For more information, see
https://bugzilla.redhat.com/show_bug.cgi?id=196836 and/or
http://lists.scsys.co.uk/pipermail/dbix-class/2007-October/005119.html.
You can suppress this message by setting DBIC_NO_WARN_BAD_PERL=1 in your
environment.

なんて警告が。
CentOS 5 の perl は未だに例のパッチが当たったままらしいです。ということで、例のパッチ取り除いた自前の RPM を入れ直しました。う～ん。

なんとなく yum update したら

=============================================================================
 Package                 Arch       Version          Repository        Size
=============================================================================
Updating:
 perl                    i386       4:5.8.8-15.el5_2.1  updates            12 M

Transaction Summary
=============================================================================

なんて言われて、「お、perl が落ちてくる」なんて思って軽い気持ちで yes した。

ちょうど新しいモジュールを作っていて perl のアップデート後に prove したらエラーがバンバン。しかも、Errno がどうのとか言われるので僕が作っているモジュールのエラーの気がしない。何となくいやな思いもしつつ、Catalyst の myapp_server.pl を svc -t /service/myapp_server/ で再起動すると案の定エラーが出て動かない。ログをのぞくと

Errno architecture (i386-linux-thread-multi-2.6.18-8.el5) does not match executable architecture (i386-linux-thread-multi-2.6.18-53.1.14.el5pae) at /usr/lib/perl5/site_perl/5.8.8/Errno.pm line 11.
Compilation failed in require at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine.pm line 7.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine.pm line 7.
Compilation failed in require at (eval 2) line 3.
      ...propagated at /usr/lib/perl5/5.8.8/base.pm line 85.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine/CGI.pm line 4.
Compilation failed in require at (eval 1) line 3.
      ...propagated at /usr/lib/perl5/5.8.8/base.pm line 85.
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.8/Catalyst/Engine/HTTP.pm line 4.
Compilation failed in require at /home/travail/public_html/SVNHOME/Shiori/script/shiori_server.pl line 7.
BEGIN failed--compilation aborted at /home/travail/public_html/SVNHOME/Shiori/script/shiori_server.pl line 8.

わー！わー！
もう大変！頭の中でちっさいさわが「わー！わー！」って叫び回ってました。
わー！わー！絶対 perl のバージョン上げたせいだ！わー！わー！
どうしよう！？OS 入れ直しとかになったらどうしよう！？
わー！わー！今のなし！今のなし！もう一回やらせて！

頭の中のちっさいさわを一人一人なだめて、落ち着かせたところで思い出しました。
「自家製の perl の RPM があるじゃなか」

FC5 FC6でPerlが遅い問題

ここら変の話で CentOS 5 でも同じ状況だったのでパッチを当てた perl を自前で用意していたのだ。自分で rebuild した RPM が /usr/src/redhat/RPMS/i386 に残っていたのであとは

[root@mina]/usr/src/redhat/RPMS/i386# rpm -Uvh --oldpackage perl-5.8.8-10.2.i386.rpm

でダウングレード。
再度、svc -t /service/myapp_server/ してログをのぞくと

Weak references are not implemented in the version of perl at /usr/lib/perl5/site_perl/5.8.8/Catalyst.pm line 24
BEGIN failed--compilation aborted at /usr/lib/perl5/site_perl/5.8.8/Catalyst.pm line 24.
Compilation failed in require at /home/travail/public_html/SVNHOME/Shiori/script/../lib/Shiori.pm line 29.
BEGIN failed--compilation aborted at /home/travail/public_html/SVNHOME/Shiori/script/../lib/Shiori.pm line 29.
Compilation failed in require at /home/travail/public_html/SVNHOME/Shiori/script/shiori_server.pl line 58.

これはもう見慣れたエラーですよね。

[travail@cabane]/tmp% wget http://search.cpan.org/CPAN/authors/id/G/GB/GBARR/Scalar-List-Utils-1.19.tar.gz
[travail@cabane]/tmp% tar xzvf Scalar-List-Utils-1.19.tar.gz
[travail@cabane]/tmp% cd Scalar-List-Utils-1.19
[travail@cabane]/tmp/Scalar-List-Utils-1.19% perl Makefile.PL
[travail@cabane]/tmp/Scalar-List-Utils-1.19% make
[travail@cabane]/tmp/Scalar-List-Utils-1.19% make test
[travail@cabane]/tmp/Scalar-List-Utils-1.19% sudo make install

再度、svc -t /service/myapp_server/ でアプリが動いていることを確認。
フロントとバックエンドの2台のサーバでこの作業を行って無事復旧。
今回は結構スリリングだった。

ちょっとした野暮用で Hyper Estraier をインストールしてみることに。

インストール
下記の最新版を使用します。リンクは .tar.gz への直リンクです。

libiconv (1.12)
QDBM (1.8.77)
Hyper Estraier (1.4.13)

方針は「とりあえず Hyper Estraier を動かしてみましょう」なので、インストールは至極簡単な ./configure, make, make check sudo make install のお決まりのコースで。そもそもオプションもそんなに多くないみたい。

まずは libiconv から。

[travail@mina]~% wget http://ftp.gnu.org/pub/gnu/libiconv/libiconv-1.12.tar.gz
[travail@mina]~% tar xzvf libiconv-1.12.tar.gz
[travail@mina]~% cd libiconv-1.12
[travail@mina]~% ./configure --prefix=/usr/local
[travail@mina]~% make
[travail@mina]~% make check
[travail@mina]~% sudo make install

スコンと入るので続いて QDBM。
QDBM は --enable-zlib オプションを使用します。Hyper Estraier がデータを圧縮する際に zlib を使用できるようにするオプションらしいです。

[travail@mina]~% wget http://qdbm.sourceforge.net/qdbm-1.8.77.tar.gz
[travail@mina]~% tar xzvf qdbm-1.8.77.tar.gz
[travail@mina]~% cd qdbm-1.8.77
[travail@mina]~% ./configure --prefix=/usr/local --enable-zlib
[travail@mina]~% make
[travail@mina]~% make check
[travail@mina]~% sudo make install

QDBM もスッコーンと入ってしまうので最後に Hyper Estraier。

[travail@mina]~% wget http://hyperestraier.sourceforge.net/hyperestraier-1.4.13.tar.gz
[travail@mina]~% tar xzvf hyperestraier-1.4.13.tar.gz
[travail@mina]~% cd hyperestraier-1.4.13
[travail@mina]~% ./configure --prefix=/usr/local
[travail@mina]~% make
[travail@mina]~% make check
[travail@mina]~% sudo make install

Hyper Estraier もサクッと入ってインストールは完了。

インデックスの作成
インデックスの作成自体は簡単で、Hyper Estraier のページから引用すると

あなたがWebサイトを運営していて、そのコンテンツが「/home/www/public_html」以下に置いてあるとしましょう。その下にある全てのHTMLファイルを登録したインデックスを「/home/www/casket」として作成することにします。それには、以下のコマンドを実行します。

cd /home/www
estcmd gather -il ja -sd casket /home/www/public_html

らしいです。
ただ、これだとおもしろくないので MySQL のデータを引っ張ってきてインデックスを作成してみたいと思います。下記のサイトを参考にします。

Hyper Estraier で検索

インデックス作成用のスクリプトが書いてあるのでそれをいじって実行すればインデックスを作成することができます。今回は上記のHyper Estraier で検索に倣ってドラフト文書からインデックスを作成したいと思います。
ドラフト文書とは

@key1=value1
@key2=value2
@key3=value3

Here is TEXT PART

のような @key=value の形をした属性部が複数行並び、改行をひとつ入れてテキスト部が存在します。属性部とテキスト部は改行で区切られて文字コードは UTF-8 でなくてはなりません。

ドラフト文書からインデックスを作成するには estcmd put というコマンドを使用しますが、estcmd put の構文は

estcmd put [-tr] [-cl] [-ws] [-apn|-acc] [-xs|-xl|-xh|-xh2|-xh3] [-sv|-si|-sa] db [file]

となっていて、引数の [file] を省略すると estcmd put はプロンプトを返さずに標準入力を待ち受けます。もし標準入力からドラフト文書を入力するのであればこんな感じになります。

[travail@mina]~% /usr/local/bin/estcmd put -cl /tmp/casket/ [ Enter ]
@uri=http://hibinokoto.jp/archive/2008/09/01/ [ Enter ]
@title=なつやすみおわっちゃった [ Enter ]
@cdate=2008-09-01T21:34:19 [ Enter ]
 [ Enter ]
きのうでながかったなつやすみもおわっちゃった。 [ Enter ]
ちょうしでんてつにのったり、けっこんしたり、たんじょうびプレゼントにかわぐつをもらったりした。[ Enter ]
９がつはかれのたんじょうびがあるのでプレゼントをかんがえなくちゃいけない。[ Enter ]
ハルヒの DVD がほしいといっていなぁ・・・。[ Enter ]
[ Ctrl + D ]
/usr/local/bin/estcmd: INFO: status: name=/tmp/casket/ dnum=244 wnum=2735 fsiz=7269823 crnum=0 csiz=0 dknum=0
/usr/local/bin/estcmd: INFO: 245 (http://kokuban.in/view/1217480299): registered
/usr/local/bin/estcmd: INFO: flushing index words: name=/tmp/casket/ dnum=244 wnum=2736 fsiz=7270053 crnum=0 csiz=0 dknum=19
/usr/local/bin/estcmd: INFO: cleaning dispensable keys: name=/tmp/casket/ dnum=244 wnum=2735 fsiz=7270053 crnum=0 csiz=0 dknum=18
/usr/local/bin/estcmd: INFO: closing: name=/tmp/casket/ dnum=244 wnum=2729 fsiz=7270053 crnum=0 csiz=0 dknum=0

スクリプトを回した方が100万倍らくちんですね。今回はHyper Estraier で検索のスクリプトをちょっと修正してインデックスを作成しました。

検索
さて、インデックスの作成が済んだら検索を行いたいところですがコマンドラインからの検索ではなく検索用のスクリプトを書いてみたいと思います。
google さんに聞いてみると CPAN の Search::Estraier か Hyper Estraier に同梱されている Estraier.pm のふたつが使えるようです。
Search::Estraier は Plugger でも採用されるモジュールになりますが LWP::UserAgent を使用しているのが気になります。

・LWP::UserAget で get をコールした時点でメモリが約2M太る
・YAML や JSON, XML でないデータを自前でパースしている
・node （インデックス置き場）をどこにする？

バッチのスクリプトで use Search::Estraier; してメモリが約2M太ったら痛いですよね。
って言うか、せっかく Hyper Estraier に Estraier.pm が同梱されているのだからそれを使いましょうよというお話ですよね。Perl のバージョンが 5.6.2 の環境では ExtUtils::typemap に 'const char *' のマッピングがないと怒られてインストールすることができませんでしたが、5.8.8 と 5.8.0 の環境ではインストールできました。下記のようになります。

[travail@mina]~% cd hyperestraier-1.4.13
[travail@mina]~% cd perlnative
[travail@mina]~% ./configure
[travail@mina]~% make
[travail@mina]~% make check
[travail@mina]~% sudo make install

これまたらくちんですね。続いて検索用のスクリプト。

searcher.pl

#!/usr/bin/perl

use strict;
use warnings;
use Estraier;
use Data::Dumper;

my $db = Database->new;
# read-mode
$db->open('/tmp/casket', Database::DBREADER) or die $!;

my $cond = Condition->new;
$cond->set_phrase('dvd');

# ORDER BY @uri ASC
$cond->set_order('@uri STRA');

# fetch document
my $result = $db->search($cond);

# the number of documents
my $dnum = $result->doc_num;

foreach my $num ((0..$dnum - 1)) {
    # get @id
    my $doc_id = $result->get_doc_id($num);

    # retrieve document by @id
    my $doc = $db->get_doc($doc_id, 0);

    # get @uri
    my $uri   = $doc->attr('@uri')
    # get @title
    my $title = $doc->attr('@title')

    warn Dumper($uri);
    # http://hibinokoto.jp/archive/2008/09/01/
    warn Dumper($title);
    # なつやすみおわっちゃった
}

$db->close;
exit;

ドラフト文書のテキスト部に「dvd(DVD)」という単語を含む文書を @uri の昇順で検索するスクリプトです。このスクリプトで先ほどプロンプトから入力した文書が検索されるわけですが、検索条件の set_phrase() に 'DVD' でなく 'dvd' を指定しています。Hyper Estraier では大文字と小文字を区別しないそうです。
set_phrase() に 'cd AND dvd' と指定すると「cd(CD)」と「dvd(DVD)」を両方含む文書が検索されます。'OR' を指定すれば 「cd(CD)」か「dvd(DVD)」を含む文書が検索されます。'AND' と 'OR' は演算子なので大文字にしなければなりません。
じゃあ、「and」と「or」を含む文書はどう検索するの？ということですが、それは 'and AND or' のようにしてくださいとのことです。演算子は大文字でってことですね。

@uri や @title などの属性に検索をかけることもできますが Perl バインディングの詳しい API は作者の平林さんちの幹夫くんのページで。

Extraier.pm の POD

CatalystとConfig

以前、バッチ用のスクリプトや他の Catalyst アプリから設定ファイルを読み込むために Config::Multi を使って Catalyst 自体をロードしない MyApp::ConfigLoader を作ろうとしました。

Re:Catalystアプリオレオレポリシーでも紹介した通り Catalyst アプリの設定ファイルは以下のような構成になっています。

MyApp/
  + etc/
    + conf/
      myapp.yml            ## 開発、本番環境の共通設定
      myapp_local.yml      ## 開発環境の設定
      myapp_service.yml    ## 本番環境の設定
    + httpd/
      app.myapp.conf       ## 本番環境のバックエンド用 modperl
      startup.pl           ## 言わずと知れた startup.pl
      www.myapp.conf       ## 本番環境のフロントの apache
      www.myapp_local.conf ## 開発環境のフロントの apache
    + validation
      profile.yml          ## Catalyst::Plugin::FormValidator::Simple::Auto

開発、本番環境で同じものは myapp.yml に書いて、開発、本番環境で違うものは myapp_local.yml, myapp_service.yml でそれぞれ上書きします。myapp_local.yml と myapp_service.yml の切り替えは Catalyst::Plugin::ConfigLoader.pm が

・$ENV{CATALYST_CONFIG_LOCAL_SUFFIX}
・$ENV{MYAPP_CONFIG_LOCAL_SUFFIX}
・$c->config->{config_local_suffix}
・local

の順で行いますよね。なので、開発環境では $ENV{MYAPP_CONFIG_LOCAL_SUFFIX} には何も設定せずに myapp_local.yml を読み込ませるようにして、本番環境では　$ENV{MYAPP_CONFIG_LOCAL_SUFFIX} に service を設定して myapp_service.yml を読み込ませています。

さて、Config::Multi を使って myapp_local.yml と myapp_service.yml の切り替えは $ENV{CONFIG_MULTI_MYAPP} を使えばできるようです。つまり、開発環境では $ENV{CONFIG_MULTI_MYAPP} になにも設定せず、本番環境では ${CONFIG_MULTI_MYAPP} に service を設定するということです。

MyApp::ConfigLoader を作ろうと思った当時は MyApp::Plugin::ConfigLoader まで作ろうという発想はなかったんですね。要するに、MyApp 自体は Catalyst::Plugin::ConfigLoader を使って、MyApp の バッチ用スクリプトや daemontools のデーモン、他の Catalyst アプリからは MyApp::ConfigLoader を使うという発想です。
それで勝手に「う～ん、同じ意味で別の環境変数を設定しないといけないのかぁ・・・」ってなったわけですね。
そうなると、本番環境の crontab にも $ENV{CONFIG_MULTI_MYAPP} を設定しないといけないし、daemontools の setenv 用（/service/myapp/env/CONFIG_MULTI_MYAPP）にも設定しないといけないわけですね。
それは面倒だ、と言うか絶対忘れる。だって、俺、さわだぜ。それに、さわだもん。
で、どうしたかと言うと、Config::Multi を使うのは諦めて

Catalystに依存しないconfigの読み込み

dann さんに倣って MyApp::Utils と MyApp::ConfigLoader を作りました。
もう一度言いますけど、当時は MyApp::Plugin::ConfigLoader まで作るっていう発想がなかったんです。

で、今日上の perl-mongers の記事を読んでみると MyApp::Plugin::Config まで作ってるじゃないですか。Catalyst をロードしないように MyApp::ConfigLoader 的なものを作っていると思いますけど、これって開発、本番用の設定ファイルの切り替えとか、各々の設計の好みだったりポリシーだったりに左右される問題だと思うんですけど、みなさんどうしてます？

これで2時間潰したぜ。

プログラマーが放置したスペルミス

スペルミスらしいぜ。

daemontools 付属のコマンド envdir。

envdir runs another program with environment modified according to files in a specified directory.

指定されたディレクトリ内にあるファイルに記述されたものを環境変数として使ってプログラムを動かすよ。

まずは、よくある run スクリプト。

#!/bin/sh

exec setuidgid username /path/to/script 2>&1

これで実行している /path/to/script 内で ENV_FOO = foo, ENV_BAR = bar という環境変数を参照している場合。

#!/bin/sh

exec setuidgid username envdir ./env /path/to/script 2>&1

今回の場合だと、「指定されたディレクトリ」というのが "./env" です。
なので、/service/my_service/env というディレクトリを作成し、そのディレクトリ内に設定したい環境変数名でファイルを作成し、そのファイルの中に設定したい環境変数の値を書き込みます。

/service/my_service/env/ENV_FOO（中身は foo）
/service/my_service/env/ENV_BAR（中身は bar）

また、ENV_FOO が空ファイルでかつ ENV_FOO が既に設定されている場合（別の場所で export とかしている場合）は ENV_FOO を環境変数から削除されます。ENV_FOO がそもそも環境変数にない場合は空ファイルを作成しても envdir は何もしません。（ENV_FOO = '' みたいなことにはならない）

Catalyst アプリの設定ファイルを読み込んで実行させるスクリプトを daemontools で起動させる場合は /service/my_app/evn/MYAPP_CONFIG_LOCAL_SUFFIX なんかを作成しておくといいよね、というしめ方をしてみる。

iCal, iChat, iPhoto, iMovie, iWeb とか iなんちゃらって恥ずかしいよね。

さて、Mac に慣れてきてわけですけど、ちょっと疑問が。
みんな使ってる Quicksilver のホットキーについて。
Windows のときは SK Launch というものを使っていました。ランチャを起動したときに起動したいアプリケーションのアイコンが聖剣伝説のアイテムを選択するときのような動きになっていてすごくかわいい。

このランチャのホットキーを Alt + Q にしていたんですね。
で、Quicksilver のホットキーを command + Q にしたんですよ。キーの位置が Alt + Q と command + Q で似ているし、Quicksilver の Q でいい感じじゃん、なんて思って。
そんな設定で過ごしていたんですけど、あるとき気付いてしまったんですね。Mac ってアプリケーションを終了させるショートカットが command + Q になっていることに。
「あ〜、かぶってるじゃん」みたいなことになって、Quicksilver のホットキーを command + Q から option + Q に変えました。command + Q に比べるとだいぶ打ちずらいんですけどね。

という訳で、みなさんは Quicksilver のホットなキーをどういう風に割り当ててますか？

先日 CPAN にアップした DBIx::Class::Schema::Slave が perl.org の #dbix-class で話題に挙っていたという噂を同僚から聞いた。DBIx::Class はいわゆる野良モジュールにうるさいと話を聞いたことがあるので、僕のモジュールもそれで話題に挙ったのか？ということはその同僚の話からはよくわからなかった。
ただ、「作るなら一言言ってくれればよかったのに」とか「それ丁度実装しようとしていたところなのに」とか、そういうことを言っていたらしい。
というわけで、#dbix-class に join。

僕：Does anyone know DBIx::Class::Schema::Slave?

しばらく経って

m○○：avoid it like the plague

と、いきなりぶっ飛ばされる。
その後も m○○ は同じような調子で続ける。
多分、これが「DISる」というやつで、IRC に流れるログをただ眺めるだけしかできないこの状況を「gkbr」というのだなぁと実感する。
m○○ の話だと DBIx::Class::Schema::Slave にもいいところはあるのでそれを DBIx::Class の方で実装しちゃえば DBIx::Class::Schema::Slave の author にメールを書けるんだよね、とのこと。
そのメールが届くのも怖いので「僕がその author なんだけど」とここで白状した。
「oh!」と m○○。
僕が当の author だとは気づいていなかったみたい。外人さんって本当に oh! って言うんですね。

その後、m○○ ってどんな人かと調べてみると DBIx::Class の author なんですね。数十人いる contributor とは別の。Catalyst でも結構コアな部分を担当している人。DBIx::Class ではラスボス。
FFⅡ で例えるならオープニングで黒騎士ではなく皇帝が出てきちゃう感じ。
マリオで言えば、１−１でクリボーじゃなくていきなりクッパが出てきちゃう感じ。きのこのブロックも叩けずに終わっちゃった。
そう考えるとえらい人に言わせちゃったなぁと言う感じですね。

author だと白状してしまった後は結構優しい感じで、「今度何か作るときは教えてね。そのときは svn のレポジトリをあげるよ」と言ってくれました。それはうれしいですけど、DBIx::Class の方で早く master と slave を任意で切り替えられるようにしてほしいですね。

追記 2008-06-31
DBIx::Class::Schema::Slave は CPAN からおいおい消します。

例えばこんな MyApp::Schema の場合。

package MyApp::Schema;

use strict;
use warnings;
use base 'DBIx::Class::Schema::Loader';

__PACKAGE__->loader_options(
    relationships => 1,
    components    => [ qw/
        ResultSetManager
        InflateColumn::DateTime
        InflateColumn::URI
        Core
    / ],
);

1;

my $blog = $schema->resultset('Blog')->find( $id );
$blog->url;

これで URI オブジェクトが返ってきてほしい。
InflateColumn::URI はまさにそれをやってくれるコンポーネントなんですが、inflate, deflate の設定が

package MyApp::Schema::Blog;

use strict;
use warnings;
use base 'DBIx::Class';

# 中略

__PACKAGE__add_columns( qw/
    ...
    'created_on', { data_type => 'datetime', ... },
    'url', { data_type => 'varchar', is_uri => 1, ... },
    ...
/ );

みたいに、is_uri => 1 とすることになっている。
上記のMyApp::Schema のように __PACKAGE__->load_classes をしなかった場合、 url は inflate も deflate もされない。
InflateColumn::URI::register_column で

return unless defined $info->{'is_uri'};

なんてしているから。
DB をスキャンして is_uri なんていう情報は取れないからね。__PACKAGE__->load_classes 前提の実装になっているみたい。POD にそう書いているわけではないのではまった。

一方、created_on は InflateColumn::DateTime で inflate, deflate されます。それは InflateColulmn::DateTime::register_column で

return unless defined($info->{data_type});
my $type = lc($info->{data_type});
$type = 'datetime' if ($type =~ /^timestamp/);
...
if ($type eq 'datetime' || $type eq 'date') {
    # 以下 inflate, deflate の処理の設定

カラムの型が DATETIME, TIMESTAMP, DATE であった場合は inflate, deflate の設定をする実装になっているから。これは DB をスキャンしても __PACKAGE__->load_classes でも取れるもんね。

要は、DBIx::Class::Schema::Slave のデバッグをしていて InflateColumn::URI で inflate, deflate されないバグに出くわしたけど、これって InflateColumn::URI がそういう実装になっているから仕方のないことじゃんってことです。僕は悪くなかったんだって言いたいだけです。

ところで、DBIx::Class::Schema::Loader base の MyApp::Schema を使っていて、かつ __PACKAGE__->load_classes していない人ってどれくらいいるのでしょうね？DBIx::Class::Schema::Slave にとって __PACKAGE__->load_classes なしの DBIx::Class::Schema::Loader って鬼門なんですよね。ResultSetManager とタッグを組まれるとさらに不安です。

きっとかわいいのだろう。
僕と彼女の間にはパー、ないしチョキで2回程勝ってやっと追いつける位の距離があった。グーではきっと追い抜いてしまう。

「ちょっと。君の顔が見たいから僕とじゃんけんしてくれないか」

そう声を掛ける程の興味を掻き立てられるわけでもないし、声を掛けるにしたっていささか突飛過ぎるではないか。僕と彼女が間宮兄弟の様な間柄であったなら別の話だが。
そう思いつつも視線は彼女に向けたまま歩きつづける。歩く速度はそのままで。
急ぐ理由はないのだ。むしろ、急がない理由はいくらでもある。

その急がない理由とやらと仕事と言うか趣味と言うか、最近書いているプログラムの実装を考えていると彼女はおもむろに左手を動かした。その左手は彼女のお尻の左頬をぐっと大胆に掴み、ずれたパンツを直したのだ。街中で正々堂々と。あまりにも正々堂々としたその仕草で呆気に取られてしまった。言葉を発するにしても「！！」が精一杯だ。

平日の午後に街中でお尻に食い込んだパンツを正々堂々と直す女の子を見かけたときに発する言葉を僕は知らない。「グワシってやった。今、グワシってやった」そう心の中で呪文のように繰り返すだけだった。
霧雨が眼鏡を濡らす鬱陶しい午後だった。

さて、Perl で存在しないクラスを use base すると

#!/usr/bin/perl

use base 'Foo';

print "GUWASHI!\n";

print "GUWASHI!\n"; は実行されず

Base class package "Foo" is empty.
    (Perhaps you need to 'use' the module which defines that package first.)

なんてエラーが出てしまいます。
このままだとおパンツ様が食い込んだままになって気持ち悪いので、どうにかしてグワシとしたいものです。
そこで、

#!/usr/bin/perl

$Foo::VERSION = 1;
use base 'Foo';

print "GUWASHI!\n";

と、$Foo::VERSION をでっちあげてやると無事グワシできるようになるわけです。
詳しくは base.pm の import を読んでみるとよいです。実際は、$Foo::GUWASHI = 'OSHIRI'; とかでもいいんですけどね。
とにかく、Foo のシンボルをでっちあげればいいわけです。

で、これと同じ理由で $Foo::VERSION なんかをでっちあげてやると Class::Inspector::loaded が真になります。

#!/usr/bin/perl

use Class::Inspector;

# Warning: something's wrong ...
warn Class::Inspector->loaded('Foo');

# 1 ...
$Foo::VERSION = 1;
warn Class::Inspector->loaded('Foo')

Class::Inspector::loaded で真が返ってくると Class::C3::ensure_class_loaded で真が返ってきます。Class::C3::ensure_class_loaded で真が返ってくると Class::C3::load_***_components で存在しないクラスを親に持つことができます。

こういった Perl のちょっと気持ち悪いとこを使って DBIx::Class::Schema::Slave では MyApp::Schema::Blog から実際には存在しない MyApp::Schema::Blog::Slave なんていう result_source クラスをでっちあげています。
先ほどバージョン 0.02300 をアップロードしました。
今回でこの記事に書いたような実装に変行しました。こうすると DBIx::Class::Schema::Slave で class_mappings と source_registrations を書き換えなくて済むんですね。DBIx::Class::Schema::register_source に next してやればそっちでスレーブを加味した class_mappings と source_registrations を作ってくれて精神衛生上いい。
あと前の記事の

$schema->resultset('Blog::Slave')->articles で返ってくる Article は
スレーブのものなので update や delete はできません。
逆に、$slave_article->blog で返ってくる Blog もスレーブのものになっているはずです。
（これはテストしてないですけど。今度、テストに加えておきます）

このテストを加えました。（t/06_search_related.t, t/33_related_resultset.t）

ネームスペースを DBIx::Class::Schema:Replicated にグワシっと変えてしまおうかなぁ、なんて思ってます。まだ変えないけど。

追記 (2008-05-14 16:30)：
DBIx-Class-Schema-Slave-0.02300 では DBIx::Class::Schema::Loader base な MyApp::Schema では動かなくなってます。

my $schema = MyApp::Schema->connect( @master_connect_info );
my $master_foo = $schema->resultset('Foo')->find( $id );
my $slave_foo  = $schema->resultset('Foo::Slave')->find( $id );

上記のようなコードでマスタはうまく接続できて find できるけど、スレーブの方は

Can't call method "resolve" on an undefined value at /usr/lib/perl5/site_perl/5.8.8/DBIx/Class/Row.pm line 720.

なんてエラーが出ます。
DBIx::Class::Schema::Loader base な MyApp::Schema でも __PACKAGE__->load_classes してれば大丈夫なんですけどね。__PACKAGE__->load_classes をせずに全くもって DBIx::Class::Schema::Loader に任せっきりにしている場合は上記のエラーが出ます。バグです。直します。

う～ん。どうやら、

・DBIx::Class::Schema::Loader base な MyApp::Schema
・MyApp::Schema->load_classes をコールしていない
・ResultSetManager をコンポーネントで指定している

場合に変な挙動になるみたい。やっかいだなぁ。

先月末から DBIx::Class::Schema::Slave というモジュールを書いています。
DBIx::Class でプリケーション環境でマスタとスレーブに接続するためのライブラリはすでに CPAN にあがっていて

DBIx::Class::Storage::DBI::Replicated

ただ、これは nitsuji さんの記事にあるように

DBIx::Classでスレーブに接続する - nitsujiの日記

メソッドチェーンが変ることがなくインターフェイスはそのままなので使う側は特に何も気にすることなく使えるのがいいのだけれど、参照系のクエリは問答無用でスレーブに接続されてしまうのがちょっと難点。
インターフェースはそのままで、かつマスタとスレーブどちらも参照できるものをと思って作ったのが DBIx::Class::Schema::Slave。
ネームスペースの通り、DBIx::Class::Schema のレイヤで実装してあります。
POD に書いてありますが一応使い方を簡単に。
モデルとしてブログを挙げてみます。
MyApp::Schema, MyApp::Schema::Blog, MyApp::Schema::Article があるとします。
まずは、MyApp::Schema から。

package MyApp::Schema;

use strict;
use warnings;
use base qw/ DBIx::Class::Schema /;

__PACKAGE__->load_components( qw/ Schema::Slave / );
__PACKAGE__->slave_moniker('::Slave');
__PACKAGE__->slave_connect_info( [ 
    [ 'dbi:mysql:database:hostname=192.168.1.2', 'user', 'password', { ... } ],
    [ 'dbi:mysql:database:hostname=192.168.1.3', 'user', 'password', { ... } ],
    [ 'dbi:mysql:database:hostname=192.168.1.4', 'user', 'password', { ... } ],
 ] );
__PACKAGE__->load_classes;

まずは、load_components でコンポーネントとして DBIx::Class::Schema::Slave をロードします。
続いて、slave_moniker に '::Slave' なんかをセットします。
そして、slave_connect_info にスレーブの connect_info をセットします。
最後に、load_classes。

次は各テーブルのクラス。

package MyApp::Schema::Blog

use strict;
use warnings;
use base qw/ DBIx::Class /;

__PACKAGE__->load_components( qw/
    ResultSetManager
    ...
    ...
    Row::Slave
    Core
/ );
__PACKAGE__->has_many(
    articles => 'MyApp::Schema::Article',
    'blog_id',
);
# 以下通常の設定やメソッドを定義

各テーブルのクラスでは DBIx::Class::Schema::Slave に同梱されている DBIx::Class::Row::Slave を load_components するだけです。
DBIx::Class::Row::Slave はスレーブに対しての insert, update, delete で throw_exception します。
なので、create, update_or_create, update_all, delete_all なんかも問答無用で throw_excepotion されます。
find_or_new は throw_exception しません。find_or_create は find の場合は大丈夫ですが、create の場合は throw_exception されます。

使い方はこんな感じになります。

my $schema = MyApp::Schema->connect( @master_connect_info );
my $master_blog = $schema->resultset('Blog')->find( $id );
my $slave_blog  = $schema->resultset('Blog::Slave')->find( $id );

# マスタに対しての update, delete は正常に終了
$master_blog->title( $title );
$master_blog->update;
$master_blog->articles->delete;

# スレーブに対しての update, delete はエラー
$slave_blog->title( $title );
$slave_blog->update;
$slave_blog->articles->delete;

my $itr_slave_article = $schema->resultset('Blog::Slave')->search_related( 'articles', {}, {} );
# これもエラー
$itr_slave_article->delete;

スレーブにつなぎたいときは result_set に 'Blog::Slave' ('::Slave' は slave_moniker にセットした文字列) を渡せばいいだけです。
$schema->resultset('Blog::Slave')->articles で返ってくる Article はスレーブのものなので update や delete はできません。
逆に、$slave_article->blog で返ってくる Blog もスレーブのものになっているはずです。（これはテストしてないですけど。今度、テストに加えておきます）

MyApp::Schema に slave_connect_info でスレーブの接続情報を ARRAYREF of ARRAYREF でセットしていますが、どのスレーブにつなぎにいくかはデフォルトではランダムです。
もし、任意に接続先を設定したい場合は MyApp::Schema に sub select_connect_info() を定義してください。

package MyApp::Schema;

use strict;
use warnings;
use base qw/ DBIx::Class::Schema /;

__PACKAGE__->load_components( qw/ Schema::Slave / );
__PACKAGE__->slave_moniker('::Slave');
__PACKAGE__->slave_connect_info( [ 
    [ 'dbi:mysql:database:hostname=192.168.1.2', 'user', 'password', { ... } ],
    [ 'dbi:mysql:database:hostname=192.168.1.3', 'user', 'password', { ... } ],
    [ 'dbi:mysql:database:hostname=192.168.1.4', 'user', 'password', { ... } ],
 ] );
__PACKAGE__->load_classes;

sub select_connect_info {
    my $self = shift;

    my @connect_info = @{$self->slave_connect_info};
    my $connect_info = undef;

    # @connect_info から好きなものを選んでね

    return $connect_info;
}

先ほどバージョン 0.02200 を CPAN にあげたのでよかったら試してみてください。
0.02000 ～ 0.02101 はすっごいバグがあったので CPAN から削除しました。
手元にあったら使わないようにしてくださいね。

あぁ、そうそう。
DBIx::Class::Schema のレイヤでやっているので Catalyst で使う場合でも何も意識しなくても大丈夫です。

$c->model('Blog::Slave')->find( $id );
とか
$c->model('Article::Slave')->find( $id )->blog;

ただ、Catalyst から Model を切り離そうとゴリゴリしちゃってる場合はどうかわかりませんが。
まだまだ EXPERIMENTAL なのでおかしなところがあればフィードバックもらえたらうれしいです。
うれションします。

前の記事で masaki さんに「そこは auto_create するところな気がします．」と教えてもらったのでちょろちょろっといじってみる。
個人的には CPAN に上がっている方より CodeRepos に上がっている方が好きなので。

Bakelatte/etc/conf/bakelatte.yml

authentication:
  default_realm: member
  realms:
    member:
      credential:
        class: OpenID
      store:
        class: DBIx::Class
        user_class: DBIC::Bakelatte::Member
        id_field: url
      auto_create_user: 1

Bakelatte/lib/Bakelatte/Controller/Login.pm

=head2 do_login

=cut

sub do_login : Local {
    my ( $self, $c ) = @_;

    $c->log->info('*** Bakelatte::Controller::Login::do_login ***');

    $c->req->base( URI->new( $c->config->{service_url} ) );
    $c->req->uri( URI->new( $c->config->{service_url} . $c->req->path ) );
    if ( $c->authenticate ) {
        ## SUCCESS
        $c->res->redirect('/');
    } else {
        ## FAILURE
        $c->load_template('login/index.tt');
    }
}

Bakelatte/lib/Bakelatte/Schema/Member.pm

package Bakelatte::Schema::Member;

use strict;
use warnings;
use base qw/ DBIx::Class /;
use DateTime;

__PACKAGE__->load_components( qw/ ResultSetManager +Bakelatte::DBIC Core / );
__PACKAGE__->table('member');
__PACKAGE__->add_columns( qw/
    id
    created_on
    modified_on
    nickname
    atom
    declared_atom
    declared_foaf
    declared_rss
    display
    foaf
    foafmaker
    rss
    url
/);
__PACKAGE__->set_primary_key('id');

sub auto_create : ResultSet {
    my ( $class, $hashref, $c ) = @_;

    my $dt     = DateTime->now( time_zone => $c->config->{time_zone} );
    my $member = $class->create( {
        created_on    => $dt || undef,
        modified_on   => $dt || undef,
        nickname      => undef,
        atom          => $hashref->{atom} || undef,
        declared_atom => $hashref->{declared_atom} || undef,
        declared_foaf => $hashref->{declared_foaf} || undef,
        declared_rss  => $hashref->{declared_rss} || undef,
        display       => $hashref->{display} || undef,
        foaf          => $hashref->{foaf} || undef,
        foafmaker     => $hashref->{foafmaker} || undef,
        rss           => $hashref->{rss} || undef,
        url           => $hashref->{url} || undef,
    } );

    return $member;
}

1;

これくらい実装してグッとガッツポーズをするとこんなのが出来上がる。
livedoor, yahoo, jugem, typekey などなどの OpenID でログインすることが出来る。はてなはアカウント持ってないから試してないけどググッとガッツポーズすれば何とかいけるはず。

auto_create って今回はじめて使ってみたけど、こんな感じの実装でよいのかしらん？
ドキュメント読んでも config の設定の仕方とか auto_create の定義の仕方とかよくわからなかった。 Authentication 周りのソースを読むと、どうも自分で実装しなくちゃいけないのかなぁ・・・、ってなった。
第3引数に $c が渡ってきちゃうとことか見ると、たぶん他のやり方があるんじゃないかなぁなんて気がしてます。

masaki さん、どうも。

Cred::OpenID と find_user - masaki@catalyst - Catalystグループ

この部分は Store::Null を使うと find_user は User::Hash 作って返すだけなので，
OP の認証が通ったかどうかだけで判断できるかな．
find_user が何を返すかは使う Store 次第で，config で store 書かなかった場合は
Store::Null が使われるようになってる．

そうなんですけどね、そうなんですけどね。find_user が何が返ってくるかはロードしているこちら側次第ってことなんですけどね。
だとすると、Store に Store::DBIx::Class を指定して authentication する場面が思いつかないんですよねぇ。
OpenID でログインするようなアプリを作ったとして、はじめてログインする場合、OP での認証は成功したとしても find_user でアプリの DB からユーザが SELECT 出来ないからみんなログイン出来ないなぁ・・・、って。
基本、Store::Null で User::Hash ってことなんですかね？

たいしたことではないんですけど、レプリケーションを構築したら是非ともたってみたかったこと。

まずは bakelatte_create.pl で マスタ用 Model を生成。

[travail@mina]~/public_html/SVNHOME/Bakelatte/script% ./bakelatte_create.pl model DBIC::Bakelatte DBIC::Schema Bakelatte::Schema
created "/home/travail/public_html/SVNHOME/Bakelatte/script/../lib/Bakelatte/Model/DBIC/Bakelatte"
 exists "/home/travail/public_html/SVNHOME/Bakelatte/script/../t"
created "/home/travail/public_html/SVNHOME/Bakelatte/script/../lib/Bakelatte/Model/DBIC/Bakelatte.pm"
created "/home/travail/public_html/SVNHOME/Bakelatte/script/../t/model_DBIC-Bakelatte.t"

続いて、スレーブ用 Model を生成。

[travail@mina]~/public_html/SVNHOME/Bakelatte/script% ./bakelatte_create.pl model DBIC::Bakelatte::Slave DBIC::Schema Bakelatte::Schema
created "/home/travail/public_html/SVNHOME/Bakelatte/script/../lib/Bakelatte/Model/DBIC/Bakelatte"
 exists "/home/travail/public_html/SVNHOME/Bakelatte/script/../t"
created "/home/travail/public_html/SVNHOME/Bakelatte/script/../lib/Bakelatte/Model/DBIC/Bakelatte/Slave.pm"
created "/home/travail/public_html/SVNHOME/Bakelatte/script/../t/model_DBIC-Bakelatte-Slave.t"

Bakelatte/etc/conf/bakelatte_local.yml（開発環境用） を編集。

## マスタ用
Model::DBIC::Bakelatte:
  schema_class: Bakelatte::Schema
  connect_info:
    - dbi:mysql:bakelatte_local:hostname=192.168.1.1
    - username
    - password

## スレーブ用
Model::DBIC::Bakelatte::Slave:
  schema_class: Bakelatte::Schema
  connect_info:
    - dbi:mysql:bakelatte_local:hostname=192.168.1.2
    - username
    - password

Bakelatte/etc/conf/bakelatte_service.yml（本番環境用） を編集。

## マスタ用
Model::DBIC::Bakelatte:
  schema_class: Bakelatte::Schema
  connect_info:
    - dbi:mysql:bakelatte:hostname=192.168.1.1
    - username
    - password

## スレーブ用
Model::DBIC::Bakelatte::Slave:
      schema_class: Bakelatte::Schema
  connect_info:
    - dbi:mysql:bakelatte:hostname=192.168.1.2
    - username
    - password

Bakelatte::Model::DBIC::Bakelatte を編集。

package Bakelatte::Model::DBIC::Bakelatte;

use strict;
use base 'Catalyst::Model::DBIC::Schema';

__PACKAGE__->config( Bakelatte->config->{'Model::DBIC::Bakelatte'} );

Bakelatte::Model::DBIC::Bakelatte::Slave を編集。

package Bakelatte::Model::DBIC::Bakelatte::Slave;

use strict;
use base 'Catalyst::Model::DBIC::Schema';

__PACKAGE__->config( Bakelatte->config->{'Model::DBIC::Bakelatte::Slave'} );

準備完了。

## マスタから SELECT
$c->model('Bakelatte::Member')->find( $id );

## スレーブから SELECT
$c->model('Bakelatte::Slave::Member')->find( $id );

今まで作ったアプリをこんな感じで実装し直しています。

Catalyst::Authentication::Credential::OpenID - OpenID credential for Catalyst::Authentication framework. - search.cpan.org

OpenID 2.0 もサポートしたもの。
残念ながら Catalyst::Plugin::Authentication::User::Hash しかサポートしていない。

そういう点では、CodeRepos に上がっているモジュールの方がいいと思う。

/lang/perl/Catalyst-Authentication-Credential-OpenID - CodeRepos::Share - Trac

CodeRepos の方は Catalyst::Authentication::Store::DBIx::Class も使えるところがいい。そこはいいんだけど、OP(IdP) での認証に成功してリダイレクトで戻ってきた後の $realm->find_user の真偽で authentication の真偽を決めてしまうのが個人的に微妙なところ。

Net::OpenID::Consumer をアプリから直接触っていれば OP(IdP) での認証が出来たのか、出来なかったのかの判断が出来るんですけど CodeRepos のやつで Catalyst::Authentication::Store::DBIx::Class を使うとその判断が出来ない。
OP(IdP) での認証が出来てさらに $c->find_user でアプリの DB からユーザが SELECT 出来たか否かで authentication の真偽が決まる。そこまでやっちゃう。

CPAN の方は Catalyst::Plugin::Authentication::User::Hash なので（今はこれしか使えない） OP(IdP) で認証出来たら $realm->find_user で Catalyst::Authentication::User::Hash オブジェクトを作るし、認証出来なかったら作らない。要するに、$c->user で Catalyst::Authentication::User::Hash が取れれば OP(IdP) での認証は成功しているということ。

OP(IdP) からのリダイレクトでクエリが付いてくるのでこれで判断出来るんだけど、それで判断しろってことなのかなぁ？
「そういうもんだよ」って言うのであれば、「あっ、そういうもんなんだぁ」で納得するんですけどね。
どういうもんなんでしょうね？

現場指向のレプリケーション詳説

こことは見てやればいいんじゃないんすか。
別に気にしてなんかいなっすよ。5,000,000レコードなんて。
いや、ほんとっす。自分ドジなんで。これくらいのことには慣れてるっす。
ただ、仕事でじゃなくてよかったなって思ってるっす。

あ、この本はいいと思いますよ。

まぁ、これ読んでもドジは直らないっすけどね。
うすっ！

SayCheese のサムネイル生成、表示のロジックを変更のつづき。

サムネイルの表示ロジックを変更する過程でテーブルからサムネイルの画像データを格納していたカラム（original, large, medium, small）を DROP。
これで、テーブル自体のサイズはかなり小さくなっているはずなんだけど、/var/lib/mysql/ibdata1 は20Gとかなり大きいまま。
このサイズを圧縮しましょうという作業。

とりあえず、グーグルさんに聞いてみると。

拡張され続ける InnoDB のデータファイルのサイズを小さくする方法 - cl.pocari.org

上記のページの例をちょっとまとめると

・tablename という InnoDB のテーブルが一つ
・デフラグ前の ibdata1 のサイズが 754974720 Byte (720MB)
・my.cnf の [mysqld] に innodb_file_per_table を設定
・mysql の再起動で InnoDB のテーブル毎にデータファイル（tablename.ibd）を生成
・この時点で tablename.ibd のサイズはまだ 754974720 Byte (720MB)
・ALTER TABLE tablename TYPE=InnoDB; でデフラグ
・デフラグ後の tablename.ibd のサイズは 98304 Byte (96KB)
・ね、すごく小さくなったでしょ！

InnoDB のテーブルごとに .ibd を生成するのは気になるし、デフラグ後の ibdata1 のサイズが書いてないのがもっと気になる。

MySQL :: MySQL 5.1 リファレンスマニュアル :: 13.5.3.1 Per-Table テーブルスペースを利用する

注意:InnoDB  は、共有テーブルスペースに内部データ ディレクトリと取り消しログを置くので、
いつもそれを必要とします。.ibd  ファイルは InnoDB  の作動に充分ではありません。

.ibd だけじゃなくて共有テーブルスペース（デフォルトで ibdata1）も必要ってことなんだと思う。
だから、デフラグ後の ibdata1 のサイズも気になるところ。

と、いくつか気になるところもあるけれど ibdata1 の圧縮開始。
まずは、/etc/my.cnf を編集

[mysqld]
innodb_file_per_table ## これを追加

mysql の再起動すると各DBのディレクトリ内に .ibd ファイルが生成されているわけですが、ibdata1 のサイズは依然として20G。
ちょっと気にしつつもデフラグ開始。

ALTER TABLE thumbnail TYPE=InnoDB;

まぁ、こんな単純な SQL を打つだけなんだけど、僕は特別な理由がない限りテーブルは全て InooDB で作っているので結構時間がかかる。
いくつかのサイズの大きいテーブルをデフラグして ibdata1 をサイズを確認してみるとやっぱり20Gのまま。小さくなっている気配がない。
テーブルの数も結構あるし、ibdata1 のサイズも変らないのでちょっと my.cnf を元に戻して mysql を再起動。
アプリを触ってみると見事に Internal Server Error！
原因は DB 周りだろうから /var/log/mysqld.log を覗いてみると。

080322 21:20:04080322 21:20:04 [ERROR] MySQL is trying to open a table handle but the .ibd file for
table saycheese/thumbnail does not exist.
Have you deleted the .ibd file from the database directory under
the MySQL datadir, or have you used DISCARD TABLESPACE?
Look from section 15.1 of http://www.innodb.com/ibman.html
how you can resolve the problem.

あれですよ、MySQL のリファレンスに

もし innodb_file_per_table ラインを my.cnf  から削除してサーバを再起動すると、
InnoDB  は共有テーブルスペース ファイル内にテーブルを再度作成します。

なんて書いてあったからカジュアルなノリで my.cnf を編集して mysql を再起動したのに何ですかこの仕打ちは。
とりあえず、ログに出ている URL を見てみることに。

InnoDB Website

悲しくなった。

この作業で約5,000,000レコードを損失。
まぁ、開発環境用のデータだからいいっちゃぁいいんだけど。
えぇっと、一応 ibdata1 の圧縮は成功ということで。（だって、5,000,000レコード消えちゃったからね！！）

mysql でレプリケーションを構築するための第一歩。
まぁ、この作業を抜いてもレプリケーションの構築はできるけど、何せ SayCheese で使っているテーブル1つ（だいたい29,000レコード）で 20G ディスクを使ってしまって ALTER TABLE や mysqldump するのにとっても時間がかかる。
レプリケーションするときには ALTER TABLE や mysqldump を何度かするのでその度に時間がかかるのもいやだし、そもそも DB にそんなに大きなレコードを入れるのもよくないなぁということでこれを機にロジックを変更。
結構大幅な変更になるので TRY-travail-digest-thumbnail なんていうブランチを切って作業開始。

以前の SayCheese のサムネイルのデータ（original, large, medium, small）は DB に格納していた。
こうしておくと、

## コントローラで
my $thumbnail = $c->model('SayCheese::DBIC::Thumbnail')->find_by_url( $url );
$c->stash->{thumbnail} = $thumbnail;

## テンプレートで
[% thumbnail.original %] ## original サイズのサムネイル
[% thumbnail.large %] ## large サイズのサムネイル
[% thumbnail.medium %] ## medium サイズのサムネイル
[% thumbnail.small %] ## small サイズのサムネイル

なんてできてらくちん。何よりもサムネイルのデータが DB に入っていることの安心感。
でも、そんな実装だと DB が破綻してしまいそうなので実ファイルを生成することにする。

create_digest_thumbnail.pl なんてスクリプトを書いて約29,000個 x 4サイズのファイルを生成。

#!/usr/bin/perl

use strict;
use warnings;
use FindBin qw/ $Bin /;
use lib "$FindBin::Bin/../lib";
use lib '/home/public/cgi/lib';
use SayCheese;
use SayCheese::Utils qw/ url2thmubpath /;
use SayCheese::FileHandle;

my $config = SayCheese->config;
my $schema = SayCheese::Schema->connect( @{$config->{'Model::SayCheese'}->{connect_info}} );
$schema->storage->debug( 1 );
my $itr_thumbnail = $schema->resultset('SayCheese::Schema::Thumbnail')->search;
while ( my $thumbnail = $itr_thumbnail->next ) {
    foreach my $size ( qw/ original large medium small / ) {
        my $thumbpath = url2thumbpath( $thumbnail->url, $size );
        my $fh = SayCheese::FileHandle->new( $thumbpath, "w" );
        $fh->print( $thumbnail->$size );
        $fh->close;
    }
}

exit;

ちょっと脱線。
今回、はじめて SayCheese::Utils を作ってみた。 $url と $size を引数に取って、その $url で $size なサイトのサムネイルが保存されているパスを返すというもの。これって Utils 的だよね？
あと、SayCheese::FileHandle。FileHandle を use base したモジュール。
slurp という関数を追加。$fh->slurp でファイルの内容をごそっと返してくれるもの。
行単位でなくて丸ごと返してくれるものってないのかなぁ？CPAN で見当たらなかったので自分で用意したけど、知ってたら教えてください。

=head2 slurp

    Returns a scalar containing the contents of the temporary file.

=cut

sub slurp {
    my $self = shift;

    my $buff;
    $buff .= $_ while <$self>;

    return $buff;
}

脱線終わり。

で、create_digest_thumbnail.pl を実行。寝る。

おはようございます。
create_digest_thumbnail.pl が無事完了して今度は API として用意している表示のロジックを変更。

変更前

=head medium

    Return medium size thumbnail.

=cut

sub medium : PathPart('medium') Chained('') Args('') {
    my ( $self, $c ) = @_;

    my $url = $c->req->uri->path_query;
    my $obj = $c->cache->get( $url ) || {};
    if ( $obj ) {
        $c->log->info('*** Cache Hit! ***');
        ## set Expires, Last-Modified, Content-Length for client cache
        $c->res->headers->header(
            'Expires'        => DateTime::Format::HTTP->format_datetime( $c->dt->add( seconds => $c->config->{cache}->{expires} ) ),
            'Last-Modified'  => DateTime::Format::HTTP->format_datetime( $c->dt ),
            'Content-Length' => length $obj->large,
        );
    } else {
        $c->log->info('*** Cache Not Hit... ***');
        $obj = $c->thumbnail->find_by_url( $url );
        if ( $obj ) {
            $c->cache->set( $url, $obj );
            ## set Expires, Last-Modified, Content-Length for client cache
            $c->res->headers->header(
                'Expires'        => DateTime::Format::HTTP->format_datetime( $c->dt->add( seconds => $c->config->{cache}->{expires} ) ),
                'Last-Modified'  => DateTime::Format::HTTP->format_datetime( $c->dt ),
                'Content-Length' => length $obj->medium,
            );
        } else {
            $obj->{medium} = $c->no_image_m;
        }
    }

    $c->res->content_type( qw( image/jpeg image/gif image/png ) );
    $c->stash->{template}  = 'include/medium.inc';
    $c->stash->{thumbnail} = $obj;
    $c->output_file;
}

変更後

=head medium

    Return medium size thumbnail.

=cut

sub medium : PathPart('medium') Chained('') Args('') {
    my ( $self, $c ) = @_;

    my $url = $c->req->uri->path_query;
    my $thumbnail = $c->cache->get( $url );
    if ( $thumbnail ) {
        $c->log->info('*** Cache Hit! ***');
        $c->forward( 'set_http_header', [ length( $thumbnail ) ] );
    } else {
        $c->log->info('*** Cache Not Hit... ***');
        my $thmubpath = url2thumbpath( $url, 'medium' );
        if ( -e $thumbpath ) {
            $c->log->info("*** Thumbnail Found! $thumbpath ***");
            $thumbnail = $c->slurp_thumbnail( $thumbpath );
            $c->cache->set( $url, $thumbnail );
            $c->forward( 'set_http_header', [ length( $thumbnail ) ] );
        } else {
            $thumbnail = $c->no_image('medium');
        }
    }

    $c->forward( 'post_process', [ $thumbnail ] );
}

$c->forward( 'post_process', [ $thumbnail ] ) は stash にテンプレートやサムネイルを埋め込んだりするだけの処理。何てことない”後処理”をやらせているだけ。detach でも構わないけどこの後何かするかもしれないので forward にする。

続いて生成のロジックを変更。
サムネイルの生成は saycheese.pl というスクリプトを Gearman の Worker として daemontools で起動させている。
saycheese.pl は結構長いので変更後のみを書いてみる。

saycheese.pl

#!/usr/bin/perl

use strict;
use warnings;
use FindBin qw/ $Bin /;
use lib "$Bin/../lib";
use lib '/home/public/cgi/lib';
use SayCheese;
use SayCheese::Constants;
use SayCheese::Schema;
use LWP::UserAgent;
use Digest::MD5 qw/ md5_hex /;
use Gearman::Worker;
use Image::Magick;

my $config = SayCheese->config;
my $worker = Gearman::Worker->new( job_servers => $config->{job_servers} );
my $ff     = 'firefox';
my $ext    = $config->{thumbnail}->{extension};
my $sleep  = 15;
my $ua     = LWP::UserAgent->new(
    agent   => $config->{user_agent}->{agent},
    from    => $config->{user_agent}->{from},
    timeout => $config->{user_agent}->{timeout},
);
$ua->default_header( Accept => [ qw(text/html text/plain image/*) ] );
$ENV{DISPLAY} = $config->{DISPLAY};

$worker->register_function(
    saycheese => sub {
        my $job = shift;
        my $url = $job->arg;

        warn "STARTING saycheese.pl\n";
        warn "URL : $url\n";

        ## finished?
        my $schema = SayCheese::Schema->connect( @{$config->{'Model::DBIC::SayCheese'}->{connect_info}} );
        my $obj    = $schema->resultset('Thumbnail')->find_by_url( $url );
        if ( $obj ) {
            warn sprintf qq{EXISTS : %s exists as id %d.\n}, $obj->url, $obj->id;
            if ( $obj->is_finished ) {
                warn sprintf qq{ALREADY FINISHED : %s is already finished as id %d.\n}, $obj->url, $obj->id;
                warn "FINISH saycheese.pl\n\n";
                return $obj->id;
            }
        }

        ## URL exists?
        warn "FETCHIGN DOCUMENT : $url\n";
        my $res = $ua->get( $url );
        if ( $res->is_success ) {
            warn "OK : $url exists.\n";
        } else {
            warn sprintf qq{ERROR : %s.\n}, $res->status_line;
            warn "FAIL saycheese.pl\n\n";
            return FAIL;
        }

        ## open URL
        my $tmp  = sprintf q{/tmp/%d-%d.%s}, time, $$, $ext;
        my $cmd1 = sprintf q{%s -remote "openURL(%s)"}, $ff, $url;
        my $r1   = system $cmd1;
        warn "EXECUTE COMMAND : $cmd1\n";
        if ( $r1 ) {
            warn "ERROR : Can't render, $cmd1 return $r1.\n";
            warn "FAIL saycheese.pl\n\n";
            return FAIL;
        }
        warn "RENDERING : $url\n";
        warn "SLEEP : $sleep seconds\n";
        sleep $sleep;

        ## make original size thumbnail
        my $cmd2 = "import -display $ENV{DISPLAY} -window root -silent $tmp";
        my $r2   = system $cmd2;
        warn "EXECUTE COMMAND : $cmd2\n";
        if ( $r2 ) {
            warn "ERROR : Can't import, $cmd2 return $r2.\n";
            warn "FAIL saycheese.pl\n\n";
            return FAIL;
        }

        $obj = $schema->resultset('Thumbnail')->update_or_create( {
            created_on  => DateTime->now->set_time_zone( $config->{time_zone} ),
            modified_on => DateTime->now->set_time_zone( $config->{time_zone} ),
            url         => $url,
            digest      => md5_hex( $url ),
        }, 'unique_url' );
        warn sprintf qq{UPDATE OR CREATE : %s as id %d.\n}, $obj->url, $obj->id;

        ## make thumbnails
        my $img = Image::Magick->new;
        $img->Read( $tmp );
        $img->Set( quality => 100 );
        $img->Crop( width => ORIGINAL_WIDTH, height => ORIGINAL_HEIGHT, x => 7, y => 116 );

        ## original size
        $img->Write( $obj->original_path );
        warn sprintf qq{WRITING THUMBNAIL : original size tumbnail, %d x %d.\n}, ORIGINAL_WIDTH, ORIGINAL_HEIGHT;

        ## large size
        my $l = $img->Clone;
        $l->Scale( width => LARGE_WIDTH, height => LARGE_HEIGHT );
        $l->Write( $obj->large_path );
        warn sprintf qq{WRITING THUMBNAIL : large size thumbnail, %d x %d.\n}, LARGE_WIDTH, LARGE_HEIGHT;

        ## medium size
        my $m = $img->Clone;
        $m->Scale( width => MEDIUM_WIDTH, height => MEDIUM_HEIGHT );
        $m->Write( $obj->medium_path );
        warn sprintf qq{WRITING THUMBNAIL : medium size thumbnail, %d x %d.\n}, MEDIUM_WIDTH, MEDIUM_HEIGHT;

        ## small size
        my $s = $img->Clone;
        $s->Scale( width => SMALL_WIDTH, height => SMALL_HEIGHT );
        $s->Write( $obj->small_path );
        warn sprintf qq{WRITING THUMBNAIL : small size thumbnail, %d x %d.\n}, SMALL_WIDTH, SMALL_HEIGHT;

        unlink $tmp;
        warn "UNLINK : $tmp.\n";

        ## Return id, or FAIL(0)
        if ( $obj ) {
            $obj->is_finished( 1 );
            $obj->update;
            warn "FINISH saycheese.pl\n\n";
            return $obj->id;
        } else {
            warn "FAIL saycheese.pl\n\n";
            return FAIL;
        }
    }
);

$worker->work while 1;

これでサムネイルがちゃんと作れることを確認したらthumbnailテーブルから original, large, medium, small カラムを ALTER TABLE DROP thumbnail COLUMN。この作業に4時間。

さて、これで SayCheese を叩いて無事サムネイルが表示されて終了。
おつかれちゃ～ん。

あれあれ？
さっき、「だいたい29,000レコード」って言ってたのに全然少ないじゃん！
なんて思った方。これには悲しいお話がありまして。
僕は最近開発と本番で DB をわけているんですね。今回であれば、saycheese_local （開発）と saycheese （本番）になるんですけど。
SayCheese を作りはじめたのはもう1年くらい前になるので、その習慣がなかったんです。
で、その習慣がついたときにはすでに saycheese のサイズが数Gになっていて saycheese_local を作るのを躊躇っていたんです。時間がかかるから。
今回のロジックの変更で DB がだいぶ小さくなったので開発用DBに saycheese_local を作ろうって思ったわけですよ。で、以下のコマンドを実行。

mysqldump -u travail -p --opt saycheese | mysql -u travail -p saycheese

すぐ終わると思ったけどそうでもないので煙草に火を点けてしばし待つ。
待つ。
待つ。
待つ？
なんかおかしいので Ctl + c。
画面を眺めてみる。
「わー。わー。わー。なし、なし。今のなし」って言いました。本当に。
だって、実行したコマンドを見ると saycheese をダンプして saycheese に流し込んでるんですよ。コマンドの後半のパイプ以降は
mysql -u travail -p saycheese
じゃなくて
mysql -u travail -p saycheese_local
でしょ。しかも、ご丁寧に --opt を付けているもんだから saycheese がいったん DROP TABLE されてるわけですよ。
saycheese がどうなっているのか気になったのでthumbnailテーブルを COUNT してみたら1882件。
泣きながらバックエンドのサーバにサムネイルを rsyc するスクリプトを書いてレコードは全部 DELETE して寝た。
おやすみなさい。

以前から家のサーバでレプリケーションを構築した。
レプリケーションの構築だけならグーグルさんに聞いて小一時間でできそうだけど、その作業に入る前にいくつかしなくてはいけないことがあったのでそれぞれ別の記事に書に。

・SayCheese のサムネイル生成、表示のロジックを変更。
・/var/lib/mysql/ibdata1 の圧縮
・レプリケーションの構築

結果から言うと、自分ドジだなぁ・・・、って。

Re:Re:Catalystアプリオレオレポリシー - よく帰れない人のブログ

久しぶりのえんとりー

めがねのひとに触発されてオレオレポリシー。
Re:Catalystアプリオレオレポリシー

仕事も個人もCatalystなんで、特にポリシーは分けてない。
会社のみんなも俺のポリシーでやればいいのに。

よく帰れない人が触発されてRe:Re:Catalystアプリオレオレポリシーを書いてくれた。（久しぶりすぎてこのブログを忘れてた）
なので、ちょっとだけRe:Re:Re:Catalystアプリオレオレポリシー。

・MyApp::Pluginとかは作らない。
　だってそのアプリでしか使わないならMyApp.pmに書けば良いじゃない。
　もしMyApp.pmが長くなってきたらそのとき考える。
　他のアプリでも使いそうだったら全部C::P::Hogeにする。
　CPANにあげなくてもC::P::Hogeにする。
　そういうのはrun_script.plの中でPERL5LIBに足してパス通す。

確かにその通り。
と思って Plugin に書いていた処理を MyApp.pm に実装し直そうと思ったけどダメだ。
だって、その Plugin の setup で NEXT してるんだもん。
MyApp.pm に同じように setup を実装して NEXT しても動かない。
だいたいこんな感じの実装。

package SayCheese::Plugin::NoImage;

use strict;
use warnings;
use base 'Class::Data::Inheritable';
use IO::File;

__PACKAGE__->mk_classdata('_medium');

sub setup {
    my $c = shift;

    my $config = $c->config;
    my $mfh = IO::File->new( $config->{no_image}->{medium}, IO::File::O_RDONLY );

    my $mdata;
    while ( $mfh->sysread( my $mbuf, 8192 ) ) {
        $mdata .= $mbuf;
    }

    __PACKAGE__->_medium( $mdata );

    $c->NEXT::setup( @_ );
}

sub no_image { shift->_medium }

1;

MyApp.pm に setup() の内容を含めて no_image() として実装すれば動くのかな。
それだと、IO::File->new() が毎リクエスト動いちゃうので嫌だなぁと。
アプリ起動時に1回だけ処理されればいい内容なので明らかに setup() 内に実装する内容。
と言うことで、MyApp::Plugin はなくせませんでした。

・設定系は全部myapp.yml

本番、開発環境用の yaml はないってこと？

・myapp.ymlはリポジトリに入れず、myapp.yml.orgを入れる
　myapp.ymlは動いてる環境に合わせて。myapp.yml.orgはデフォルト
　更新があったらスクリプト使ってマージ。

今度詳しく。

・テンプレートはDreamWeaverで編集
　タグとか打ってらんねーよ！

DreamWeaver 買ってよ！

・ログは全部C::P::Log::Dispatch

C::P::Log::Dispatch ってどう？いい？
僕の場合ロガーは貧弱で C::P::Dumper くらいしか使ってない。

dbic_console.pl # MyApp::Schemas::MyAppを使ってDBICでほにゃる用のコンソール

これ気になる。
今度詳しく。

menu.yml # 外に出してないC::P::MenuMaker用の設定ファイル

BtoC だと Authetication はあっても Authorization はないって場合がほとんどだから MenuMaker らしきものを見たことがない。
C::P::MenuMaker いいなぁ。CPAN まだぁ？

Catalystアプリオレオレポリシー - unknownplace.org

   1. アプリ名にかかわらず設定ファイルはconfig.yamlとconfig_local.yaml
   2. でも変更することがないほとんどの設定はyamlには書かない。yamlがごちゃっとするときもい
   3. ForceUTF8系モジュールは使用しない。内部がきちんとutf8で統一されていれば必要ない。
   4. MyApp::UtilsとかいうのでいろいろBKなことをまとめてする。uri_forを気に入るように直したり、FillInFormの挙動変えたり

仕事では Sledge。個人では Catalyst。
仕事で使っていれば社内のコーディングルールだったり暗黙の了解だったりで均一的なポリシーっていうものができあがってくるけど、個人で使ってるとそういうものがなかなか作れないのが困る。

「はて、みんなは Catalyst ではどんなコーディングをしているのだろうか？」なんて。

僕自身、いまだに Catalyst のポリシーっていうものが明文化できずにいる。
まぁ、多少はあるけれどね。それでも気分だったり、何となくだったりで恣意的なものだ。
なので、Re:Catalystアプリオレオレポリシー。

1. アプリ名にかかわらず設定ファイルはconfig.yamlとconfig_local.yaml

プロジェクトを立ち上げたら必ず MyApp/etc を作る。

MyApp/
  + etc/
    + conf/
      myapp.yml            ## 開発、本番環境の共通設定
      myapp_local.yml      ## 開発環境の設定
      myapp_service.yml    ## 本番環境の設定
    + httpd/
      app.myapp.conf       ## 本番環境のバックエンド用 modperl
      startup.pl           ## 言わずと知れた startup.pl
      www.myapp.conf       ## 本番環境のフロントの apache
      www.myapp_local.conf ## 開発環境のフロントの apache
    + validation
      profile.yml          ## Catalyst::Plugin::FormValidator::Simple::Auto

開発環境のバックエンドは myapp_server.pl を daemontools で起動しているので app.myapp_local.conf 的なものは用意していない。今のところ不自由はないけれど、app.myapp_local.conf を読み込ませた modperl が必要になるかもしれない。とも思っている。

2. でも変更することがないほとんどの設定はyamlには書かない。yamlがごちゃっとするときもい

変更の予定がないものもことごとく yaml に書いている。「設定」であれば何でも。
Model の connect_info, crawler の UA, イテレータでデフォルトで使う rows などなど。
本番、開発環境で同じ内容のものは myapp.yml へ。本番、開発環境で違うものはそれぞれ myapp_service.yml, myapp_local.yml で上書き。
バッチとかでハードコードしたくないので yaml にどんどん書いちゃう。
例えば、

#!/usr/bin/perl

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use lib "$FindBin::Bin/../Mina/lib";
use lib "/home/public/cgi/lib";

use Shiori; ## これが Catalyst プロジェクト
use Mina;   ## 他の Catalyst プロジェクト
use LWP::UserAgent;
use DateTime;

my $config = Shiori->config;
my $dt     = DateTime->now->set_time_zone( $config->{time_zone} );
my $ua     = LWP::UserAgent->new(
    agent   => $config->{user_agent}->{agent},
    from    => $config->{user_agent}->{from},
    timeout => $config->{user_agent}->{timeout},
);
$ua->default_header( Accept => [ qw(text/html text/plain image/*) ] );

my $schema   = Shiori::Schema->connect( @{$config->{'Model::Shiori'}->{connect_info}} );
my $itr_page = $schema->resultset('Shiori::Schema::Page')->hot_pages( {}, { rows => $config->{default_rows} } );

while ( my $page = $itr_page->next ) {
    my $res = $ua->get( $page->url );
    if ( $res->is_success ) {
        ## do something
    } else {
        ## do something
    }
}

こんな感じに。
だから、yaml にどんどん書いちゃう。確かに yaml がごちゃっとしてきもいかも。

3. ForceUTF8系モジュールは使用しない。内部がきちんとutf8で統一されていれば必要ない。

おっしゃる通り。
ソースも DB も文字コードは UTF8。まぁ、僕は個人で開発しているのでサクッと EUC から UTF8 に乗り換えちゃったんですけどね。職場ではその乗り換えもなかなか難しいですよね。

4. MyApp::UtilsとかいうのでいろいろBKなことをまとめてする。uri_forを気に入るように直したり、FillInFormの挙動変えたり

MyApp::Utils は作ったことがない。
いったん MyApp::Utils を作り出すとまさに BK のまとまりになって Utils ではなくなってしまうので。なるべく CPAN を使って済ます。
それでも使いずらいようであれば lib/Myapp/Plugin/Nanchara.pm を作ってプラグインとしての使い方を考える。できれば、/home/public/cgi/lib/Catalyst/Plugin/Nanchara.pm として全サービスで使えるプラグインにしちゃう。欲を言えば、/usr/lib/perl5/site_perl/5.8.8/Catalyst/Plugin/Nanchara.pm を作って CPAN にあげちゃう心意気で。
それがダメなら、もう知らない。寝る。
とにかく、Utils とか Manager 系のモジュールは作らない。たぶんそれは Utils でも Manager でもなくなってしまうから。
好みの問題。とも言える。

Re:Catalystアプリオレオレポリシーはこんな感じ。
おまけとして、僕の Catalyst のプロジェクトの構成。

MyApp/
  + bin/               ## バッチ処理用のスクリプト
    ...
    ...
  + etc/               ## conf, httpd, validation などアプリの設定ファイル
    ...
    ...
  + lib/
    + MyApp/
    Myapp.pm           ## 言わずと知れた MyApp.pm
      + Controller/    ## Controller だよ
        ...
        ...
        + AjaxRequest/ ## AJAX リクエスト用の Controller は別に作る
          ...
          ...
      DBIC.pm          ## deflate, inflate させたり
      Errors.pm        ## Catalyst::Plugin::FormValidator::Simple::OwnCheck
      + Model/
        + DBIC/
          Mina.pm      ## 他プロジェクト（Mina はいわゆる Member）の Model
          MyApp.pm     ## MyApp の Model
      + Plugin/        ## MyApp でしか使えない Plugin
          ...
          ...
      + Schema/        ## 言わずと知れた Schema
          ...
          ...
      Schema.pm
      + View/
        File.pm        ## div タグだけの HTML や画像を返す場合の View
        JSON.pm        ## JSON を返す View
        TT.pm          ## 通常の process を行う TTSite base な View
  + root/
    + lib/             ## View::TTSite を使うと lib/config/, lib/site/, site/ が作成される
      + config/        ## テンプレート内で使用する TT のタグの定義
        col            ## 色(site.rgb = {red = '#CC4444'} とか)を定義（結構使う）
        main           ## title とか copyright とかを定義（あまり使わない）
        url            ## URL(site.url = {base = c.req.base} とか) を定義（あまり使わない）
      + site/          ## テンプレートの部品
        footer         ## フッタ
        header         ## ヘッダ
        html           ## layout を内包する一番外側の部品
        layout         ## footer, header を内包する二番目に外側の部品
        wrapper        ## ラッパ
    + src/             ## いわゆるテンプレート
      ttsite.css       ## TTSite::View を使用すると作成される ここで col で定義した [% site.rgb.red %] なんかを使う
      ...
      ...
    + static/          ## フロントで返すようないわゆる静的ファイル（性的なファイルは別のディレクトリ）
      + css/
        ...
        ...
      + images/
        ...
        ...
      + js/
        ...
        ...
  + script/
    ...
    ...
  + sql/               ## DB 関係のファイル置き場
    + data/            ## アプリが動くにあたって必要最低限なデータ
      ...
      ...
    + dmp/             ## dump ファイル置き場
      ...
      ...
    + schema/          ## テーブルのスキーマ（DDL って言うやつ？）
      ...
      ...
  + t/                 ## テス㌧
    ...
    ...

いつもだいたいこんな感じの構成になります。
みなさんの Catalyst のポリシーをもっと聞かせてください。

ブログのURLを変えてみた - Clouder::Blogger

突然ですがブログのURLを変えました。
今まで「http://clouder.jp/yoshiki/mt/*」だったのを「http://blog.clouder.jp/*」に変更してみました。

僕も最近 cabane.no-ip.org/hibinokoto/ から hibinokoto.jp に変えたましね。
blog.hibinokoto.jp にするか迷ったけど、ブログ以外で hibinokoto.jp ドメインを使うことってあるんだろうかと会議を行ったところ、「それはないな」ってことになったので hibinokoto.jp に満場一致で決まりました。

で、Clouder::Blogger 続き。

RewriteRule 旧URL 新URL [L,R=301]

ん？！
R=301？！

HTTPステータス・コード

301・・・Moved Permanently（恒久的移動）
302・・・Moved Temporarily（一次的移動）

と言うことで、今回のようにブログの URL を恒久的に変更した場合は 301 を返さないといけないんですね。僕はずっと 302 を返していたみたいです。
Web のエンジニアとしてちょっと恥ずかしいですね。

去年の暮れから C に興味を持ち出した。まぁ、正確には Apche モジュールなんだけど。
残念ながらパンダ本は未だに手に入ってないわけだけど、気休めに買った gcc と K&R の本をそこそこ読んだので実際に C を書いてみようかなぁと。

何よりもまず、.emacs ですよね。

;; cc-mode
(require 'cc-mode)
;; Kernighan & Ritchie style
(setq c-default-style "k&r")

(add-hook 'c-mode-common-hook
            '(lambda ()
             (progn
               (c-toggle-hungry-state 1)
               (define-key c-mode-base-map "\C-m" 'newline-and-indent)
               (setq c-basic-offset 4 indent-tabs-mode nil))))

hello_world.c

#include <stdio.h>

int main(int argc, char *argv[]) {
    printf("Hello World!\n");
    return 0;
}

gcc hello_world.c -o hello_world でコンパイル。実行。

[travail@mina]~/c% gcc hello_world.c -o hello_world
[travail@mina]~/c% ./hello_world
Hello World!

LL な Perl でしかまともなプログラムを書いたことのない僕にしては、この「コンパイル」という作業にちょっと感動します。
で、Hello World も済ませたし、次に何書こうか考えたものの特に何もないのでとりあえず DB に接続してみようかなぁと。
リモートホストの DB(saycheese) につないで、とあるテーブル(thumbnail)から10件 SELECT して、とあるカラムのデータ(small サイズのサムネイル)をファイル(ファイル名は id)に書き込んで終了。
何となく getopt_long を使いたかったので、mysql のユーザ、パスワード、ホストをオプションで取る。
というプログラム。のつもり。

#include <stdlib.h> /* for exit(), free() */
#include <stdio.h>  /* for printf(), sprintf(), fwrite() */
#include <string.h> /* for strdup() */
#include <getopt.h> /* for getopt_long() */
#include <mysql/mysql.h>

#define DB "saycheese"
#define PORT 3306
#define SOCKET "/var/lib/mysql/mysql.sock"
#define OPT 0

char *host;
char *user;
char *password;

/* prototypes */
void options_parse(int argc, char *argv[]);

int main(int argc, char *argv[]) {
    options_parse(argc, argv);

    int count = 0;
    MYSQL *mysql;
    MYSQL_RES *res;
    MYSQL_ROW row;

    mysql = mysql_init(NULL);
    if (!mysql_real_connect(mysql, host, user, password, DB, PORT, SOCKET, OPT)) {
        printf("ERROR %d: %s)\n", mysql_errno(mysql), mysql_error(mysql));
        exit(-1);
    }

    char *sql =
        "SELECT id, created_on, modified_on, url, extension, small FROM thumbnail LIMIT 10";
    mysql_query(mysql, sql);
    res = mysql_store_result(mysql);

    for (count = mysql_num_rows(res); count > 0; count--) {
        /* for fwrite() secend argument 'length' */
        row = mysql_fetch_row(res);
        unsigned int length = ((unsigned long *)mysql_fetch_lengths(res))[5];

        /* open file and write it down */
        FILE *fp;
        char filename[256];
        sprintf(filename, "%s.%s", row[0], row[4]);
        if ((fp = fopen(filename, "w+")) == NULL) {
            printf("Can't open %s\n", filename);
        } else {
            fwrite(row[5], length, 1, fp);
            fclose(fp);
        }
    }

    mysql_close(mysql);
    mysql_free_result(res);
    /* for strdup(host|user|password) in options_parse() */
    if (host) free(host);
    if (user) free(user);
    if (password) free(password);

    return 0;
}

void options_parse(int argc, char *argv[]) {
    static struct option longopts[] = {
        {"host", required_argument, NULL, 'h'},
        {"user", required_argument, NULL, 'u'},
        {"password", required_argument, NULL, 'p'},
        {0, 0, 0, 0}
    };

    int opt;
    while (1) {
        opt = getopt_long(argc, argv, "h:u:p:", longopts, NULL);
        if (opt == -1) break;

        switch (opt) {
        case 'h':
            host = strdup(optarg);
            break;
        case 'u':
            user = strdup(optarg);
            break;
        case 'p':
            password = strdup(optarg);
            break;
        }
    }
}

コンパイル、実行。

[travail@mina]~/c% gcc saycheese.c -o saycheese
/tmp/ccsfFlXE.o: In function `main':
saycheese.c:(.text+0x35): undefined reference to `mysql_init'
saycheese.c:(.text+0x80): undefined reference to `mysql_real_connect'
saycheese.c:(.text+0x8f): undefined reference to `mysql_error'
saycheese.c:(.text+0x9c): undefined reference to `mysql_errno'
saycheese.c:(.text+0xd5): undefined reference to `mysql_query'
saycheese.c:(.text+0xe0): undefined reference to `mysql_store_result'
saycheese.c:(.text+0xee): undefined reference to `mysql_num_rows'
saycheese.c:(.text+0x101): undefined reference to `mysql_fetch_row'
saycheese.c:(.text+0x10f): undefined reference to `mysql_fetch_lengths'
saycheese.c:(.text+0x1c3): undefined reference to `mysql_close'
saycheese.c:(.text+0x1ce): undefined reference to `mysql_free_result'
collect2: ld はステータス 1 で終了しました

「終了しました」とか言われてもよくわからないので「"undefined reference to" mysql_init」でグーグルさんに訊ねてみる。

4.1 向けのリファレンスだけど、「リンク時に libmysqlclient.so へのパスを教えてあげてね」とのこと。
どうもこれっぽいので、改めてコンパイル、実行。

[travail@mina]~/c% gcc saycheese.c -o saycheese -L/usr/lib/mysql -lmysqlclient
[travail@mina]~/c% ./saycheese -u travail -p ******* -h 192.168.1.1
[travail@mina]~/c% ls
10.jpg  13.jpg  16.jpg  9.jpg          libmemcached*   saycheese.c
11.jpg  14.jpg  6.jpg   hello_world*   libmemcached.c
12.jpg  15.jpg  8.jpg   hello_world.c  saycheese*
[travail@mina]~/c% ./saycheese -u travail -p *******
ERROR 1049: Unknown database 'saycheese')
[travail@mina]~/c% ./saycheese -u travail
ERROR 1045: Access denied for user 'travail'@'localhost' (using password: NO))
[travail@mina]~/c% ./saycheese
ERROR 1045: Access denied for user 'travail'@'localhost' (using password: NO))

できたっぽい。
ちゃんと mysql のエラーも取れてるみたい。
ちょっと気になるのは -u でユーザを指定しなくても travail で DB につなぎに行っているところ。
mysql_real_connect の引数で user が NULL はまたは "" であった場合は現在のユーザを想定するって。
ちなみに、host が NULL もしくは、"" だったら localhost にするって。
詳しくは Web で。

Perl で言う青本みたいなリファレンスってないんですかね？
「あぁ、こんな関数（マクロ）があるのか」なんて思って使ってみようとしてもヘッダを include してないからエラーが出たり。
それをいちいちグーグルさんに訊ねるのも煩わしいので。
今だけですかね？そのうち覚えますかね？
あと、ソースで「ここ変」とか「その書き方冗長」とかありますかね？

ノートブックで開発しているエンジニアは多いのではないかと思う。
むしろ、それが主流なんじゃないかとも思う。

でも、僕はノートブックを持っていない。家でも会社でもデスクトップで開発している。
会社で PC を支給されるときも「デスクトップがいいです」と言ったら、「デスクトップがいいの？なんかゲーマーみたいだな」なんて CTO に言われた。

「なんかゲーマーみたいだな」の部分は今でもわからないけど、「デスクトップがいいの？」の部分は最近分かってきた気がする。
だって、ノートブックは持ち運べるんだもん。ミーティングのときとか PC を持っていけるんだもん。そこがいい。開発合宿にも行けちゃうよ。

メインはデスクトップでいいとしても、サブでノートブックを持つのはありなんじゃないかと思い、先週末秋葉原へと足を伸ばしてみた。伸ばしてみたものの、どれがいいのかさっぱりわからない。
結局、特に得るものもなくたこ焼きを食べて帰った。

どうなんでしょう？
ノートブック買うなら何がいいのでしょう？Think Pad の X60 か Mac Book がいいかなぁなんて思っていますけど。
Mac Book の2.7kgはノートブックの重さじゃないよね。X60 を2つ持ってるのと変らないもん。でも、問答無用にかわいい。
うちのMacBookから異音がします - D-6 [相変わらず根無し]

とか
Intel MacBook の HDD が突然死（故障）しました :: Drk7jp

とか読んじゃうと、「アップルタイマー！？」とか思っちゃうし。
Mac Book Air はかわいくないので論外。かわいくないので「Air Mac」と命名しました。
じゃあ、X60 かと言ったら X300 なんていうものも出るとか出ないとか。
同僚やマネージャには「さわさんは Lenovo って感じじゃないなぁ」とか言われるし。
どうなんですか？ノートブック買うとしたらどれがいいんですか？

そう言えば、スキャナを買ったんだっけ

たまにそう思い出しては何かをスキャンして「日々のこと」に載せようかと思いたち、スキャナのふたを開けては今までに撮った写真を掘り返したり、引出しを開けてみたりするものの、結局スキャンしてみたいものが見当たらず引出しを閉め、写真を片付け、スキャナのふたを閉じてしまうのだ。

と言うのはこれまでの話。
今日はスキャンしなくてはならないものが見つかったのだ。

レシートじゃないです。本の検索結果です。
知ってますか？最近の本屋さんでは本の検索が出来るんですよ。しかも、検索結果はこんな風に印刷できて、その本が店内のどの本棚にあるかも記載されてるんです。

「あ、『Apacheモジュールプログラミングガイド』買ったの？」なんて思われるかもしれませんね。
これを見せた僕の隣の席のマネージャもそう言いました。

僕：「これ見てくださいよ」
マ：「おっ！買えたの？」
僕：「いや、この本棚探したんですけど見つからなかったから店員さんに聞いたんです。
　　　そしたら、何かの手違いで本当は在庫なかったんです」
マ：「じゃ、また書かなきゃ」

「Apacheモジュール プログラミングガイド」欲しい！「Apacheモジュール プログラミングガイド」ください！mod_hello_world「Apacheモジュール プログラミングガイド」欲しい！小山さん好き！「Apacheモジュール プログラミングガイド」がない！「Apacheモジュール プログラミングガイド」ちょうだい！「Apacheモジュール プログラミングガイド」欲しい！小山さん超好き！「Apacheモジュール プログラミングガイド」欲しい！何でもするから！「Apacheモジュール プログラミングガイド」欲しい！kabayamaさん、元気？「Apacheモジュール プログラミングガイド」欲しい！まだオメザってあるの？「Apacheモジュール プログラミングガイド」欲しい！小山さん好き！「Apacheモジュール プログラミングガイド」欲しい！「Apacheモジュール プログラミングガイド」欲しい！笠原さん好き！「Apacheモジュール プログラミングガイド」欲しい！「Apacheモジュール プログラミングガイド」欲しい！mod_hoyama「Apacheモジュール プログラミングガイド」欲しい！小山さん大好き！小山さんお願い！Segmentation fault?

というわけで、この記事を書いているわけで、本当はスキャナとかどうでもいいんです。

拝啓　小山さん

時が経つのは早いのもで、2008年の1月も終わってしまいました。歳をとるごとに時間の流れが早く感じるなんて話はよく聞く話ですよね。
小山さんはいかかでしょうか。やはりそのように感じているのでしょうか。
私といえば、やはりそう感じています。そうは感じてはいますが、最近では実際に早くなっているのではないか？なんて思ったりもしています。

さて、今回筆を取ったのも他ではありません。とある本についてです。
去年の年末あたりから気になりだしで近くの本屋さんで探してみたのですがどうにも見当たらないのです。
私の住んでいる街がそう大きくないので、そんな街の本屋さんだから見つからなくても当然と思っていました。数年前には見かけたのですけどね。
年も明け2008年。初詣も済ましたので新宿の紀伊国屋へ足を運びました。ちなみに、おみくじは小吉でした。
これだけ大きな本屋さんになら置いてあるだろうと高を括っていました。
ですが、ないのです。どこをどう探してもないのです。小一時間は探したでしょうか。全く見当たりません。
ちょっと目が三角になってきました。これ以上探しても埒が明かないので店員さんに聞くことにしました。

「紀伊国屋全店で在庫切れですねぇ。出版社にも置いてないようです」

紀伊国屋全店で在庫が切れているとなれば仕方がありません。その日は諦めてそう大きくない自分の街へ帰ることにしました。

日を改め池袋へ。
今回はジュンク堂です。池袋へ足を運ぶのは何年振りでしょうか。最後にここを訪れたのは浪人生のときか、大学生のときか定かではありません。
小山さんは池袋のジュンク堂を訪れたことがあるでしょうか。B1 から 9F まで本屋さんなんです。大きいですよね。B1 から 9F までですよ。本がたくさんあります。
これだけたくさん本がある本屋さんならきっと見つかるはずですよね。そんな期待で胸を躍らせ探しはじめましたが、あれあれ？おかしいです。またもや目が三角になっているではありませんか。
いやな予感がしてきました。
知ってますか？最近の本屋さんだと本の検索ができるんですよ。著者や題名、何かしらのキーワードを入力して本を検索できるんです。
検索結果は小さな紙に印刷できるんです。しかも、検索結果には本が置いてある本棚の場所が記載されているんです。21世紀ですね。
でも、私の検索結果は印刷するまでもありませんでした。

「在庫なし」

仕方ないので GCC の本と make の本を買って帰ることにしました。
仕方なしに買った GCC の本ですが意外に面白いですよ。読み終わったらお貸ししますね。

さて、紀伊国屋にもジュンク堂にもなければどこを探すか。最後の手段、Amazon さんですよね。
「まず最初に、Amazon さんじゃないの？」なんて思われるかもしれませんね。でも、できれば Amazon さんのお世話にはなりたくなかったのです。最近までクレジットカードも持っていませんでしたし。
やっぱり、自分が欲しいと思ったものは自分の足で探して自分の手に取って、そうやって手に入れたいと思うのです。
数回クリックして数回寝て起きたら手元に届く。それって何だか寂しいと思いませんか？
しかし、今回の場合は仕方ありません。背に腹はかえられない状況です。
そうやって Amazon さんで検索してみるとありました。さすが Amazon さんです。
しかし、値段をよく見ると13,900円。思わずリロードしていまいました。
再描画された値段はやっぱり13,900円。
なんということでしょうか。もともと2,919円の本が 13,900円になっているなんて。

数年前にはそう大きくもない街の本屋さんでも見かけることのあった本なのに、いつでも手が届く本であったのに、今となってはなかかなか手の届かない本になってしまったようです。数回クリックすれば手に入るのですけれど。
今いちばん近い場所と言えば、私の隣の席のマネージャの机の上に無造作に置いてあるそれです。このままではマネージャのそれをこっそり盗ってしまいそうです。それはいけないこととわかっているので今はしませんが、その自制心もいつまでもつか怪しいものです。

小山さんの席の横を通るたび「うわっ、変なキーボード」って思っていたのが悪いのでしょうか？そう思っていたのは事実ですが、小山さんが時折着て来ていた変な柄のTシャツをかわいいと思っていたのも事実です。あの生き物は何でしょうか。鳥でしょうか？

駄文になってきてしまったようです。いけませんね。
そろそろそれなりの言葉でこの手紙を終わらせないといけませんが、どうもそういったことが苦手のようです。

「Apacheモジュール プログラミングガイド」ください。

かしこ

4日の20時40分頃から /x.cgi?*** へ頻繁に POST リクエストがある。
*** の部分はすっごい長い英数字。クエリかと思ったけど key しか付いてないんだよね。=*** の部分がない。
Remote_Host はアクセスは重複してるのもあるけど、結構いろんなところから来ているみたい。どれも海外だけど。
5日の2時の時点で 12,000 以上のリクエスト。
/x.cgi なんてファイルは僕のサーバに存在しないので構わないのだけど、404 なのにリクエストを飛ばし続けられるのもいやなので 403 を返してみる。

x.cgi って何なんでしょう？

SayCheese で API を用意している。
上のサムネイルがその API を使っているわけだけど、http://saycheese.no-ip.info/medium/http://cabane.no-ip.org/hibinokoto/ を叩くと http://cabane.no-ip.org/hibinokoto/ のサムネイルが表示される。
URL の medium を large, small に変えれば 200x150, 80x60 のサムネイルが返ってくる。

とまぁ、この話はSayCheese のことに書いてあるんだけど、
その API の URL を叩かれる分だけ Catalyst の乗った mod_perl が動くのがコスト高いなぁと思ってキャッシュとかしたいなぁと思って mod_disk_cache と mod_mem_cache を使ってみようかなぁと思った。
何となく mod_mem_cache の方を使ってみたい気がするんだけど mod_mem_cache だとキャッシュし損ねるファイルが多々あるみたい。ヒット率とかいう問題ではなく。
mod_disk_cache だとキャッシュできているファイルが mod_mem_cacahe だとキャッシュできずに SayCheese にそのままリクエストが渡ってきて mod_perl が動いちゃう。
なんでなんでしょう？

<IfModule mod_cache.c>
    CacheDefaultExpire 1800
    CacheMaxExpire 1800
#    CacheIgnoreCacheControl On
#    CacheIgnoreNoLastMod On
    <IfModule mod_disk_cache.c>
        CacheEnable disk /small
        CacheRoot /var/cache/apache
        ## bytes
        CacheMaxFileSize 5120
        ## bytes
        CacheMinFileSize 1
        CacheDirLevels 2
        CacheDirLength 1
    </IfModule>
#    <IfModule mod_mem_cache.c>
#        CacheEnable mem /small
#        ## KBytes
#        MCacheSize 4096
#        MCacheMaxObjectCount 100
#        ## bytes
#        MCacheMaxObjectSize 5120
#        ## bytes
#        MCacheMinObjectSize 1
#    </IfModule>
</IfModule>

先週の木曜日に仕事のあるプロジェクトのイメージサーバを増設した。
一週間も経っていないので何ともいえないが負荷が下がったように感じられない。
じゃ、また増設。というわけにもいなかいので Image::Magick で実装されているロジックを他のライブラリで
焼き直しするのがいいのではないだろうかと思う。
何となくだけど、Image::Magick って重いような気がするしね。
とりあえず、ベンチとってみましょうか。

増設したイメージサーバでの処理
・リクエストを受ける
・実ファイルを読み込んで返す

特別なことはしてないですね。

なので、今回とってみるベンチは
・実ファイル ($input) を読み込む
・キャッシュ ($output) に書き込む

これだけ。
ただ、そのイメージサーバにはとんでもない数のリクエストが飛んでくるので
ちょっとの違いが大きな違いになります。
じゃ、ベンチとりましょうか。比較するライブラリは Image::Magick, Imager, Image::Imlib2 の3種類。

#!/usr/bin/perl

use strict;
use warnings;

use Benchmark;
use Image::Magick;
use Imager;
use Image::Imlib2;

my $input  = './images/input.jpg';
my $output = './images/output.jpg';

timethese( 100, {
    'Image::Magick' => '&image_magick',
    'Imager'        => '&imager',
    'Image::Imlib2' => '&image_imlib2'
} );

sub image_magick {
    my $img = Image::Magick->new;
    $img->Read( $input );
    $img->Write( $output );
}

sub imager {
    my $img = Imager->new;
    $img->read( file => $input );
    $img->write( file => $output );
}

sub image_imlib2 {
    my $img = Image::Imlib2->new;
    $img->load( $input );
    $img->save( $output );
}

exit;

Benchmark: timing 100 iterations of Image::Imlib2, Image::Magick, Imager...
Image::Magick:  3 wallclock secs ( 2.70 usr +  0.15 sys =  2.85 CPU) @ 35.09/s (n=100)
Imager:  2 wallclock secs ( 1.92 usr +  0.01 sys =  1.93 CPU) @ 51.81/s (n=100)
Image::Imlib2:  1 wallclock secs ( 0.41 usr +  0.01 sys =  0.42 CPU) @ 238.10/s (n=100)

で、今回とりたかったベンチはこれだけなんですけど、ちょっと気になったことがあるのでベンチを続ける。
画像の Read と Write だけの処理は、Image::Imlib2, Imager, Image::Magick の順だけど
画像を Read して Scale して Write したら順番って変るのかしらん？
と言うことで、Scale の処理を加えて再度ベンチ。再ベン。

#!/usr/bin/perl

use strict;
use warnings;

use Benchmark;
use Image::Magick;
use Imager;
use Image::Imlib2;

my $input  = './images/input.jpg';
my $output = './images/output.jpg';
my $width  = 80;
my $height = 60;

sub image_magick {
    my $img = Image::Magick->new;
    $img->Read( $input );
    $img->Resize( width => $width, height => $height );
    $img->Write( $output );
}

sub imager {
    my $img = Imager->new;
    $img->read( file => $input );
    my $scaled = $img->scale( xpixels => $width );
    $scaled->write( file => $output );
}

sub image_imlib2 {
    my $img = Image::Imlib2->new;
    $img->load( $input );
    $img->create_scaled_image( $width, $height );
    $img->save( $output );
}

timethese( 100, {
    'Image::Magick' => '&image_magick',
    'Imager'        => '&imager',
    'Image::Imlib2' => '&image_imlib2'
} );

exit;

再ベン結果。

Benchmark: timing 100 iterations of Image::Imlib2, Image::Magick, Imager...
Image::Magick:  2 wallclock secs ( 2.18 usr +  0.13 sys =  2.31 CPU) @ 43.29/s (n=100)
Imager:  4 wallclock secs ( 3.74 usr +  0.01 sys =  3.75 CPU) @ 26.67/s (n=100)
Image::Imlib2:  1 wallclock secs ( 0.44 usr +  0.01 sys =  0.45 CPU) @ 222.22/s (n=100)

一等賞は相も変わらず、Image::Imlib2。
二等賞と三等賞が入れ代わって、Image::Magick, Imager。
そして、注目するのは Imager が約2倍遅くなっていること。
Read して Scale して Write するだけの処理は Imager じゃなくて Image::Magick を使った方がコストが低い。
まぁ、どちらにせよ Image::Imlib2 使った方がよいってことですね。
Crop とかしたらどうなんでしょうね？テキスト貼り付けたり、合成したりしたときは？
そこら辺はまたの機会に。

結構前に作った SayCheese。

個人的にだいぶ使っていてアップデートもそれなりにしている。

サムネイルを返す API を一応用意していたが返せるサムネイルのサイズが一種類。

しかも、width と height が微妙。

入用なのもあって、今回修正。

width 80 height 60 の Small。
http://saycheese.travailjp/small/http://www.sallyscott.com/catalogue/

width 200 height 150 の Medium。
http://saycheese.travail.jp/medium/http://www.sallyscott.com/catalogue/

width 400 height 300 の Large。
http://saycheese.travail.jp/large/http://www.sallyscott.com/catalogue/

Small　と Medium のサイズは livedoor CLIP のサイズにあわせることに。Large は適当。

あとは、サムネイルを撮るスクリプトを Gearman の Worker として書き直して、daemontools で制御。

だらだら表示してたページャをグーグリッシュに。

サリー・スコットかわいい。

完全にメモ。で、Catalyst でのお話。

コンテンツとして JPEG の画像を返すときは

$c->res->content_type('image/jpeg');

とする。

$c->res->content_type('image/jpg');

だと、FireFox は画像を表示できても、IE、Safari だとダウンロードになる。

FireFox は JavaScript でも寛大な動作をするので気をつけたいところ。

$c->res->content_type( qw( image/jpeg image/gif image/png ) );

としておいた方が後々楽かも。

プラグインじゃなくて、ちゃんとした Catalyst のモジュールのひとつなので使ってもよいかなと思って使ってみる。

Catalyst::Plugin::DefaultEnd とか気持ち悪いからね。

で、MyApp::Controller::Root::render と MyApp::Controller::Root::end はこなる。

MyApp::Controller::Root::render

=head2 render

=cut

sub render : ActionClass('RenderView') {
    my ( $self, $c ) = @_;

    $c->log->info('*** Shiori::Controller::Root::render ***');

    return if $c->stash->{only_file};
    return if $c->stash->{only_json};
    return if $c->stash->{only_xmlrpc};

    $c->load_template unless $c->stash->{template};
}

MyApp::Controller::Root::end

=head2 end

Attempt to render a view, if needed.

=cut

sub end : Private {
    my ( $self, $c ) = @_;

    $c->log->info('*** Shiori::Controller::Root::end ***');

    $c->forward('render');
    $c->fillform( $c->stash->{fillform} ) if $c->stash->{fillform};
}

Catalyst::Action::RenderView を見てみると

my $view = $c->view()
     || die "Catalyst::Action::RenderView could not find a view to forward to.\n";
$c->forward( $view );

となっている。

$c->view で forward 先が決まるみたい。

Catalyst::view

=head2 $c->view($name)

Gets a L instance by name.

    $c->view('Foo')->do_stuff;

Any extra arguments are directly passed to ACCEPT_CONTEXT.

If the name is omitted, it will look for 
 - a view object in $c->stash{current_view_instance}, then
 - a view name in $c->stash->{current_view}, then
 - a config setting 'default_view', or
 - check if there is only one view, and return it if that's the case.

=cut

sub view {
    my ( $c, $name, @args ) = @_;
    return $c->_filter_component( $c->_comp_prefixes( $name, qw/View V/ ),
        @args )
      if $name;
    if (ref $c) {
        return $c->stash->{current_view_instance} 
          if $c->stash->{current_view_instance};
        return $c->view( $c->stash->{current_view} )
          if $c->stash->{current_view};
    }
    return $c->view( $c->config->{default_view} )
      if $c->config->{default_view};
    return $c->_filter_component( $c->_comp_singular(qw/View V/) );
}

１．引数 $name があればその View を探す。$c->view('TT'); みたいにしたときね。
２．$c->stash->{current_view_instance} に View のインスタンスがあればそれを使う。
３．$c->stash->{current_view} に View の名前があればその名前で View インスタンスを作る。
４．$c->config->{default_view} があればその名前で View のインスタンスを作る。

いろいろなとこを探してくれるけど、$c->config->{default_view} に TT とか設定しておけばいいよね。

ちなみに、MyApp::Contorller::Root::render の

return if $c->stash->{only_file};
return if $c->stash->{only_json};
return if $c->stash->{only_xmlrpc};

View::TTSite base の View で process せずに View::TT base の View で process させたいときに $c->stash->{only_file} を真にします。

Ajax.Updater で div を書き換えるときとか、画像ファイルを返すときとか。

コンテンツとして JSON のみを返すときに $c->stash->{only_json} を真にします。

View::JSON に process させるときなんかに。

XMLRPC でデータ構造を返したいときに $c->stash->{only_xmlrpc} を真にします。

SSO でしか使ってない。

ここら辺は別の機会に。

ときおり吹く涼しい夜風に枯葉の匂いがまじり、秋の訪れを感じさせる今日この頃、Catalyst で開発されているみなさんは HTTP サーバは何をお使いですか？
僕はと言えば、Catalyst の myapp_server.pl を使っています。

Catalyst リリース直後に IE の POST が動かなくて使えないなぁと思い Apache を使っていましたが初夏に新しい開発用の PC を買って何気なく myapp_server.pl を叩いたら早いこと早いこと。
それ以来、Apache ではなく myapp_server.pl を使っています。今では IE のPOST もちゃんも動きますし。
ただ、気になのはログが標準出力にだらだら流れるのがいやだなと。
僕は tail ではなく、less でログを見る人なので / で検索したいし、Ctl + P とかでログを遡りたいんです。

とまぁ、そんな不自由を感じつつも Apache の遅さには戻れないので myapp_server.pl を daemontools で動かすことにしたわけです。
daemontools のインストールはこんな感じ。

cd /tmp
mkdir /package
chmod 1755 /package
wget http://tools.qmail.jp/daemontools/daemontools-0.76.tar.gz
tar xzvfp daemontools-0.76.tar.gz
cd admin/daemontools-0.76
wget http://qmail.org/moni.csi.hu/pub/glibc-2.3.1/daemontools-0.76.errno.patch
patch -p1 < ./daemontools-0.76.errno.patch

package/install

で、daemontools に管理させるプログラムを登録？と言うんでしょうか。それをしなくていけないのですが
それには下記のようなスクリプトを作ります。例は shiori_server.sh。

#!/bin/sh

cd /service && \
for x in shiori_server

  do
  mkdir $x && chmod +t $x && \
  mkdir $x/log && \
  mkdir $x/log/main && \

  touch $x/log/status && \
  chown travail:travail $x/log/main $x/log/status
done

cd /service/shiori_server && touch run && \

 chmod 755 run && chown travail:travail run
cat <<'EOF' > /service/shiori_server/run
#!/bin/sh

PATH=/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin
export PATH

cd /home/travail/public_html/SVNHOME/Shiori/script/ && \
exec setuidgid travail /home/travail/public_html/SVNHOME/Shiori/script/shiori_server.pl -r -p 3001 2>&1
EOF

cd /service/shiori_server/log && \
touch run && \
chmod 755 run && \
chown travail:travail run

cat <<'EOF' > /service/shiori_server/log/run
#!/bin/sh
exec setuidgid travail multilog t s1000000 n100 ./main
EOF

exit;

あとは、sudo なんかして shiori_server.sh を実行すると /service/shiori_server/*** が作られるわけです。
/service/shiori_server/*** が作られると daemontools が勝手に shiori_server.pl を起動します。
ログもちゃんとファイルに保存されるし、less で見れるし、/ で検索できるし。この環境が僕は好きです。
あとは、Gearman の Worker を daemontools で動かしたりしてますね。
デプロイした後に Worker の再起動なんかも

# svc -t /service/***

で出来るので比較的楽だと思います。

会社で開発部の人が持ちまわりでブログを書いています。

明日は僕が記事を投稿する番なのでそれを書いていたら、「日々のこと」も更新しようかなぁなんて気分になったわけです。

でも、会社の記事で疲れちゃったので「日々のこと」はこれだけで。

明日、健康診断があります。

山王なんちゃらとかいうところに行きます。

僕は比較的方向音痴なのですが、今回の道順は簡単。

赤坂通りを日枝神社の方へ歩いて行って外堀通りを右折。みたいな感じです。

ただ、赤坂通りのあのカレー屋さんをスルーする自信がこの僕にはありません。

診断の受付は14時00分から15時30分です。

お昼ごはんを食べ終わって「じゃ、そろそろ診断行くね」と言うにはもってこいの時間帯なんじゃないかと思います。

例えて言うなら、こういうことです。

Niiki
自分用のブログ。
ちょこちょこ開発進んでますん。

仕事でそんなのを実装しなくちゃいけないことになった。

普通に JOIN 先のカラムで ORDER BY なら簡単なんですけど SUM や COUNT なんかをしたカラムで ORDER BY だと少しやっかいです。
会社のソースをペコッとするわけにもいかないので、例としてブログの管理画面を考えてみます。
記事 (Nikki::Schema::Article) の一覧です。
記事の一覧は通常であれば投稿日順でソートしますが、強引にコメント(Nikki::Schema::Comment)数順でソートしてみます。あ、DB は MySQL(5.0) として話を進めます。
見ずらい場合はこっちで読んでねねね。

Nikki::Schema::Article

package Nikki::Schema::Article;

use strict;
use warnings;
use base qw/ DBIx::Class /;

__PACKAGE__->load_components( qw/ PK::Auto ResultSetManager +Nikki::DBIC Core / );
__PACKAGE__->table('article');
__PACKAGE__->add_columns( qw/
    id
    created_on
    modified_on
    title
    text
    posted_on
/ );
__PACKAGE__->set_primary_key('id');
__PACKAGE__->datetime_column( qw/ created_on modified_on posted_on / );
__PACKAGE__->has_many(
    comments => 'Nikki::Schema::Comment',
    'article_id',
    { join_type => 'LEFT', cascade_delete => 1 },
);

1;

Blog::Schema::Comment

package Nikki::Schema::Comment;

use strict;
use warnings;
use base qw/ DBIx::Class /;

__PACKAGE__->load_components( qw/ PK::Auto +Nikki::DBIC Core / );
__PACKAGE__->table('comment');
__PACKAGE__->add_columns( qw/
    id
    created_on
    modified_on
    article_id
    author_name
    email
    url
    text
    status
    posted_on
/);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->datetime_column( qw/ created_on modified_on posted_on / );
__PACKAGE__->belongs_to(
    article => 'Nikki::Schema::Article',
    'article_id',
);

1;

記事 (Nikki::Schema::Article) とコメント (Nikki::Schema::Comment) は1対多です。
コメント順にソートして記事の一覧を取得するには下記のようなメソッドを Nikki::Schema::Article に実装します。

sub artciles_order_by_commets : ResultSet {
    my $self = shift;

    return $self->search(
        {},
        {
            join => [ qw/ comments / ],
            select   => [ 'me.id', 'me.title', 'me.midified_on', 'COUNT( comments.id ) AS count_comments' ],
            as       => [ qw/ id title modified_on count_comments / ],
            group_by => 'me.id',
            order_by => 'count_comments DESC',
        },
    );
}

ここで肝心なのが、コメント数を { count => 'comments.id' } ではなく、COUNT( comments.id ) AS count_commets とすることろです。
そうしないと、order_by => 'count_comments' を指定したところで、「count_comments なんてカラムないよ」って怒られます。

as DBIx::Class::ResultSet

Indicates column names for object inflation.
That is, c< as > indicates the name that the column can be accessed as via the get_column method (or via the object accessor, if one already exists).
It has nothing to do with the SQL code  SELECT foo AS bar .

as を指定しても、実際に発行される SQL には AS が展開されません。
もし、COUNT( comments.id ) AS count_comments ではなく、{ count => 'comments.id' } と指定すると発行される SQL はこんな感じになります。

SELECT me.id, me.title, me.modified_on, COUNT( comments.id ) FROM article me LEFT JOIN comment comments ON ( co
mments.article_id = me.id ) GROUP BY me.id ORDER BY count_comments DESC

発行された SQL には AS が展開されていません。
この SQL を見れば当たり前ですね。count_commets なんてカラムないので、そりゃ怒られます。
逆に、COUNT(comments.id) AS count_comments を指定して発行される SQL はと言うと。

SELECT me.id, me.title, me.modified_on, COUNT( comments.id ) AS count_comments FROM article me LEFT JOIN comment 
comments ON ( comments.article_id = me.id ) GROUP BY me.id ORDER BY count_comments DESC

ばっちりですね。Yes!プリキュア５
それにしても、これにはだいぶはまりました。ログの SQL を見ればすぐわかる話なんですけどね。
でも、as を指定していれば SQL に AS として展開されると思いますよね。
group_by と一緒に count を使うときも注意が必要みたいです。
count DBIx::Class::ResultSet

Note: When using count with group_by, DBIX::Class emulates GROUP BY using COUNT( DISTINCT( columns ) ).
Some databases (notably SQLite) do not support DISTINCT with multiple columns.
If you are using such a database, you should only use columns from the main table in your group_by clause.

ほとんどの人には関係ないかな。

別解として。
MySQL 5.0 なら、{ count => 'commets.id' } でもうまくいくやり方があります。（もしかしたら、4.1でも大丈夫かも）
order_by => 'COUNT( comments.id ) DESC' としてやれば大丈夫。

sub artciles_order_by_commets : ResultSet {
    my $self = shift;

    return $self->search(
        {},
        {
            join => [ qw/ comments / ],
            select   => [ 'me.id', 'me.title', 'me.midified_on', { count => 'comments.id' } ],
            as       => [ qw/ id title modified_on count_comments / ],
            group_by => 'me.id',
            order_by => 'COUNT( comments.id ) DESC',
        },
    );
}

残念ながら僕が今会社で開発しているサーバの MySQL が 4.0 なので上記の書き方だと怒られます。
4.0 では ORDER 句で集約関数を使うのは反則みたい・・・。

前の前の会社の社長から携帯にメールが来る。

全部で3往復くらいのやり取りだった。
仕事の話が中心だったが、最後のメールには、

最近プリキュアのネタが多いけど、あまり詳しくありませんので、それを聞かせてください。

といった件が。
とりあえず、

プリキュアは毎週日曜日麻8時30分からテレビ朝日で放送されています。
取り急ぎ、ご報告まで。

と返信する。

もぅ〜。
プリキュアの話が聞きたいならはじめからそう言えばいいのにぃ〜。
と言うことで、今週末は赤坂でおいしい料理に舌鼓を打ちながら仕事とプリキュアの話をします。

blog.hide-k.net TTでDBICのhas_manyなメソッドを使う

何を言いたいかというと、TTでhas_manyで定義した子オブジェクトの結果一覧を
取得するメソッド(ここではcomments)にアクセスするとイテレーターではなく配列のリファレンスとして
扱われるので大変面倒。

で、こうするといい感じ。

そうそう、これこれ！
前にこんな記事を書きました。
それ以来、この問題はなかったことにして開発を進めていましたが今日解決しました。
いや〜、ありがたい。

hide さんってもしかしたら、Precure ?
だどしたら、キュア何？

と、思っていたら、多対多のときには _rs ではできないね。
例えば、MT のデータソースを使って Catalyst でちょこっと組み直した MT でのお話。
MT::Schema::Category(mt_category) と MT::Schema::Placement(mt_placement) が1対多。
MT::Schema::Entry(mt_entry) と MT::Schema::Placement(mt_placement) が1対多。

要は、mt_placement が mt_category と mt_entry の交差テーブルになっていて、
MT::Schema::Category と MT::Schema::Entry が多対多になっている場合。
ある mt_category にぶら下がる mt_entry 数を取ろうとして、テンプレートに

[% category.entries_rs.count %]

なんて書いても取れない。

$c->model('DBIC::MT::Category')->single( {}, {} )->entries_rs

なんてやろうものなら、「entries_rs なんてメソッドないお」って怒られる。
よく考えたら当たり前なんだけどねねね。
なので、 MT::Schema::Category には count_entries という腹立たしいメソッドを実装したまま。

でも、1対多の場合が解決できただけでも嬉しいですね。
サンキュー、キュアヒデ。

MT::Schema::Category

package MT::Schema::Category;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components( qw/ PK::Auto ResultSetManager +MT::DBIC Core / );
__PACKAGE__->table('mt_category');
__PACKAGE__->add_columns( qw/
    category_id
    category_blog_id
    category_allow_pings
    category_label
    category_description
    category_author_id
    category_ping_urls
    category_parent
    category_basename
/);
__PACKAGE__->set_primary_key('category_id');
#__PACKAGE__->belongs_to(
#    blog => 'MT::Schema::Blog',
#    'category_blog_id',
#);
__PACKAGE__->has_many(
    placement => 'MT::Schema::Placement',
    'placement_category_id',
);
__PACKAGE__->many_to_many(
    entries => 'placement',
    'entry',
);


sub count_entries { shift->entries->count }

1;

MT::Schema::Entry

package MT::Schema::Entry;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components( qw/ PK::Auto +MT::DBIC Core / );
__PACKAGE__->table('mt_entry');
__PACKAGE__->add_columns( qw/
    entry_id
    entry_blog_id
    entry_status
    entry_author_id
    entry_allow_comments
    entry_allow_pings
    entry_convert_breaks
    entry_category_id
    entry_title
    entry_excerpt
    entry_text
    entry_text_more
    entry_to_ping_urls
    entry_pinged_urls
    entry_keywords
    entry_tangent_cache
    entry_created_on
    entry_modified_on
    entry_created_by
    entry_modified_by
    entry_basename
    entry_atom_id
    entry_week_number
/);
__PACKAGE__->datetime_column( qw/ entry_created_on / );
__PACKAGE__->set_primary_key('entry_id');
__PACKAGE__->belongs_to(
    author => 'MT::Schema::Author',
    'entry_author_id',
);
__PACKAGE__->belongs_to(
    blog => 'MT::Schema::Blog',
    'entry_blog_id',
);
__PACKAGE__->has_many(
    comments => 'MT::Schema::Comment',
    'comment_entry_id',
);
__PACKAGE__->has_many(
    placement => 'MT::Schema::Placement',
    'placement_entry_id',
);
__PACKAGE__->many_to_many(
    categories => 'placement',
    'category',
);

sub has_comments_entries {
    my $self = shift;

    return $self->search( {},
        {
            prefetch => [ qw/ comments / ],
            order_by => 'comments.comment_created_on DESC',
        },
    );
}

1;

MT::Schema::Placement

package MT::Schema::Placement;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components( qw/ PK::Auto +MT::DBIC Core / );
__PACKAGE__->table('mt_placement');
__PACKAGE__->add_columns( qw/
    placement_id
    placement_entry_id
    placement_blog_id
    placement_category_id
    placement_is_primary
/);
__PACKAGE__->set_primary_key( qw/ placement_id placement_category_id placement_entry_id / );
__PACKAGE__->belongs_to(
    entry => 'MT::Schema::Entry',
    { 'foreign.entry_id' => 'self.placement_entry_id' },
);
#__PACKAGE__->belongs_to(
#    blog => 'MT::Schema::Blog',
#    'placement_blog_id',
#);
__PACKAGE__->belongs_to(
    category => 'MT::Schema::Category',
    { 'foreign.category_id' => 'self.placement_category_id' },
);

1;

自分用のブログを Catalyst で実装中。

えいやっ！で CMS 側の超基本機能を実装して、Blog 側のデザインをえいやっ！ではめ込む。
Blog 側のデザインは MT と一緒。
って言うか、今はいじる余裕なひ。CMS 側はだいぶひどい。テンション下がる。

find -type f -name '*.pm' | sort
./Nikki.pm
./Nikki/Controller/Blog/Root.pm
./Nikki/Controller/CMS/Article.pm
./Nikki/Controller/CMS/Author.pm
./Nikki/Controller/CMS/Blog.pm
./Nikki/Controller/CMS/Category.pm
./Nikki/Controller/CMS/Login.pm
./Nikki/Controller/CMS/Logout.pm
./Nikki/Controller/CMS/Root.pm
./Nikki/DBIC.pm
./Nikki/Model/DBIC/Nikki.pm
./Nikki/Schema.pm
./Nikki/Schema/Article.pm
./Nikki/Schema/Author.pm
./Nikki/Schema/Author/Profile.pm
./Nikki/Schema/Blog.pm
./Nikki/Schema/Category.pm
./Nikki/Schema/Country.pm
./Nikki/Schema/Language.pm
./Nikki/Schema/Session.pm
./Nikki/Schema/Sex.pm
./Nikki/Schema/TimeZone.pm
./Nikki/View/Blog/TT.pm
./Nikki/View/CMS/TT.pm
./Nikki/View/HTML.pm
./Nikki/View/JSON.pm

１、２、３、４　プリキュア（５！）

ということで、今日は Perl のエンジニアについて書いてみようかと思います。
Perl というのはプログラミング言語の名前で、シャノンやミクシィ、livedoor、はてななどで主に使用されている言語です。
その「Perl」という語源は、

Practical Extraction and Report Language
実用的なデータ取得レポート作成言語

とか、

Pathologically Eclectic Rubbish Lister
病的折衷主義のガラクタ出力装置

とかいう俗説があります。
実際は、

Precure Extraction and Report Language
プリキュア的なデータ取得レポート作成言語

もしくは、

Precure Eclectic Rubbish Lister
プリキュア的折衷主義のガラクタ出力装置

とするのが無難です。
最近の Perl のエンジニアは会話の中で precure をよく使用します。

・それ Precure でやればいいんじゃね？
・それ Precure でできるよ。
・それ Precure(ry
・それ Pre(ry

めんどくさいので、今では「それ Pre(ry」と言っています。
ほら、長いより短い方が断然いいって言うでしょ？それに略してた方がそれっぽいし。

とまぁ、Perl のエンジニアにしたら馴染みある Precure ですが、「そもそも Precure って何？」なんて思う人もいるかもしれませんね。
そもそも Precure とは Perl のすごいエンジニアのことを言います。
僕が把握している限りでは日本に5人います。
とあるカンファレンスの発表資料の中でその5人が登場するのでみなさんも見てみてください。
ちょっと遠いけど、資料の 32P です。

デブサミ2007 - まるごとPlaggerインスパイア Yappo さん。

だいたいわかりました？雰囲気つかめました？
真ん中にいる紫色の何かをくわえている人はすごく有名な人で宮川達彦さんといいます。
まぁ、Precure のリーダー的存在ですね。今はアメリカの会社で働いているそうです。
Movable Type って知ってますか？ブログを作るシステムなんですけど。それを作っている会社の役員さん。
もちろん、現役のエンジニアでもあります。現役の Precure。
すごいですよね。僕もそんな Precure になりたいものです。

Perl のエンジニアならみんな憧れる Precure に宮川さんはどうやってなったのか。
そんなエピソードをアニメにしたものが YouTube にあがっています。
Perl のエンジニアの人なら知っていますよね？
ちょっと脚色が入っていますが、よくできているので是非みなさんも一度見てみてください。

Yes! Precure 5: First Episode Part 1

Yes! Precure 5: First Episode Part 2

Yes! Precure 5: First Episode Part 3 Subbed

追記的な：
あと4人の Precure って誰なんでしょう？知ってます？

ちょっと思い出したので。

Catalyst::AttrContainer が Catalyst に実装されてからめっきり使わなくなった。
今でもたま〜に Apache::Reload の話を聞く。

「なんか変更が反映されるまで時間かかるよね」

そんなときは httpd.conf の MaxRequestsPerChild ディレクティブを確認してみほ。

MaxRequestsPerChild 1

とかにするとよいよ。

インデント崩れて読みづらい場合は、こっちで読んでね。

前にこんな日々のことを書いています。

Catalyst::View::TT のこと

僕は Controller::Root::begin で Authentication （ログインのチェック）を行います。
Authorization （権限のチェック）は Controller::Root::auto で行います。
auto アクションはオーバーライドされることなく必ず全ての auto アクションが実行されるから。
逆に、begin アクションはオーバーライドされます。
なので、ログインとかユーザー登録とかは Authentication が行われないように
begin をオーバーライドします。
オーバーライドしてやらないと、ログインしようとしているのに、
「ログインしてください」的なことになるからね。

そうそう、その通り。でも、正確にはオーバーライドではなくて、オーバーライド的な挙動をするってことですね。

で、今作っている Nikki にログインを実装。こんな感じ。

Nikki::Controller::CMS::Login

package Nikki::Controller::CMS::Login;

use strict;
use warnings;
use base 'Catalyst::Controller';

=head1 NAME

Nikki::Controller::CMS::Login - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut

=head2 default

=cut

sub default : Private {
    my ( $self, $c ) = @_;

    if ( $c->req->param('author_name') && $c->req->param('password') ) {
        $c->login(
            $c->req->param('author_name'),
            $c->req->param('password'),
        );
        $c->res->redirect('/cms/') if $c->user_exists;
        $c->detach( qw/ CMS::Root default / );
    } else {
        $c->detach( qw/ CMS::Root default / );
    }
}


=head1 AUTHOR

A clever guy

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

ログインできないんだよなぁ〜。いくらクリックしてもログインできやしない。
アカウントもちゃんと DB に入れたのにいくらやってもログイン画面が出てきちゃう。って言うか Nikki::Controller::CMS::Login::default を通ってない。
それもそのはず、Nikki::Controller::CMS::Login::begin を実装していないから。
Nikki::Controller::CMS::Root::begin のログインチェックに引っ掛かって Nikki::Controller::CMS::Root::default へ forward されちゃう。
これに気付くのに1時間。
そんなんだから、「さわ」って言われるんだよ！！

ちなみに、Nikki::Controller::CMS::Root はこんな感じ。

Nikki::Controller::CMS::Root

package Nikki::Controller::CMS::Root;

use strict;
use warnings;
use base 'Catalyst::Controller';

=head1 NAME

Nikki::Controller::CMS - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut

__PACKAGE__->config->{namespace} = 'cms';

=head2 begin

=cut

sub begin : Private {
    my ( $self, $c ) = @_;

    if ( ! $c->user_exists ) {
        $c->action( undef );
        $c->forward('default');
    }
}

=head2 auto

=cut

sub auto : Private {
    my ( $self, $c ) = @_;

    if ( $c->user_exists ) {
        if ( $c->has_permission ) {
            ##
        } else {
            $c->permission_error;
        }
    }
}

=head2 default

=cut

sub default : Private {
    my ( $self, $c ) = @_;

    if ( $c->user_exists ) {
        $c->log->info('*** Yes, user logged in. ***');
    } else {
        $c->log->info('*** No, user ain\'t logged in. ***');
        $c->stash->{template} = 'cms/login.tt';
    }
}

=head2 end

Attempt to render a view, if needed.

=cut 

sub end : ActionClass('RenderView') {
    my ( $self, $c ) = @_;

    return if $c->stash->{only_json};
    return if $c->stash->{only_html};
    return if $c->res->status =~ /^3\d\d$/;

    $c->stash->{template} = $c->action->reverse . '.tt' unless $c->stash->{template};
    $c->forward('CMS::TT');
}

=head1 AUTHOR

A clever guy

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

以前作った Nikki のネームスペースは MT に変更。
新しく Nikki を立ち上げる。MT には飽きたので自分で自分用のブログを開発しはじめる。
これは、以前の Nikki。現 MT。

そして、ハマる。

Authentication::Store::DBIC なんかを使うときは、これより先に ConfigLoader をロードしないと

[Tue May 01 02:15:11 2007] [error] [client 192.168.1.150] failed to resolve handler `Nikki': You must provide a
 user_class at /usr/lib/perl5/5.8.8/NEXT.pm line 75\nCompilation failed in require at (eval 798) line 3.\n

とか言われるのは初歩中の初歩で、小さい頃に母親によく言われた。
他のプロジェクトを見てみると確かに最初にロードしてある。
これに30分。く〜。
もう寝る！！

地味に更新中。

今日はページャとインクリメンタルサーチを実装。
インクリメンタルサーチは実装中。検索結果をレイヤーで表示しないとね。
出来上がって自己満足したらはずします。
インクリメンタルサーチってコストがバカにならないからね。

SayCheese デプロイした。

SayCheeeeeeeeeeeeeeeese!

API の応答が速くなったよ。

[info] Request took 0.029858s (33.492/s)

サムネイルの削除が速くなったよ。

[info] Request took 0.107708s (9.284/s)

サムネイル撮るのはほとんど変ってないよ。

[info] Request took 8.358729s (0.120/s)

「SimpleAPI いいなぁ」なんて思って作り始めた SayCheese。
SimpleAPI のいいところは API があるところ。
「http://img.simpleapi.net/small/http://hibinokoto.jp/」を叩くと、http://hibinokoto.jp/ のスクリーンショットが返ってくる。
これが SimpleAPI の素敵なところですよね。

これは真似しなくてはということで、SayCheese でも API を一応用意しました。
と言っても、一度 URL を入力してサムネイルを生成してからでないと使えない・・・。
仕様は SimpleAPI と同じで、
「http://saycheese.travail.jp/medium/http://hibinokoto.jp/」を叩く感じ。
SimpleAPI みたいにそのうち、http://hibinokoto.jp/small/*** とか http://hibinokoto.jp/large/*** とかできるかもねねね。

で、この API は Catalyst で実装されているわけですが、出ました。Chained アクションです。
こんな感じです。

SayCheese::Controller::AjaxRequest::Thumbnail::api

sub api : PathPart('api') Chained('') Args('') {
    my ( $self, $c ) = @_;

    my $url = $c->req->path;
    $url =~ s/^api\///;

    my $obj = $c->thumbnail->find_by_url( $url );
    if ( $obj ) {
        $c->res->content_type('image/png');
        $c->stash->{template}  = 'include/thumbnail.tt';
        $c->stash->{thumbnail} = $obj;
        $c->output_html;
    } else {
        die;
    }
}

Chained 使っておいて、$url =~ s/^api\///; ってずるくない？
だって、Chained の引数のセパレータが / なんだもん。
そりゃ、URL 形式の引数がうまく取れないのは仕方ないさ。
適当に Args(100) とかにしておいて引数を @url で受け取って join っていうよりは、$c->req->path の方がスマートでしょ？
都会的でしょ？ソフィスケイトされているでしょ？

stash に $obj を詰めているだけですが、テンプレートはどうなってるの？

/root/src/include/thumbnail.tt

[% thumbnail.filedata %]

だけです。ほんと、これだけ。
SayCheese では DB にサムネイルのデータを BLOB として突っ込んであるので、 $obj->filedata でサムネイルのデータがとれるんですね。
なので、テンプレートで、[% thumbnail.filedata %] とすると、/root/src/include/thumbnail.tt が画像ファイルになります。
ここで肝になってくるのが、api メソッドの $c->content_type('image/png');。
これに気付くのに30分くらいかかった。
Catalyst::Plugin::Charsets::Japanese を使っていたからなおさら悩んだ。「画像なのに UTF-8 っぽいんですけど〜」って。
今回は釈然としない Chained の使い方ですが、やっぱり Chained 便利です。

ちなみに、僕は SayCheese.pm とかプロジェクトのクラスに SayCheese::thumbnail とかを定義します。
SayCheese.pm

sub thumbnail : Private { shift->model('DBIC::SayCheese::Thumbnail') }

コントローラで、$c->model('DBIC::SayCheese::Thumbnail') を書くのが面倒なので。
こうやっておくと、$c->thumbnail で呼べて僕は好き。

SimpleAPI って知ってます？
「ウェブサイトサムネイル作成API β版」が有名だと思うんですけど。
なかなか素敵なサービスですよね。
作りたいなぁ、なんて思ってたら作れました。

SayCheeeeeese!

UI は Catalyst。実際にスクリーンショットを撮るところは POE。
いじってみてほしいですけど、スケールのこと考えてないから何かしら不具合があるかもね。
撮ったスクリーンショットがまだサイトのローディング中の画面だったりとか。404 を平気で撮ったりとか。
ページャを実装していないので撮ったら撮った分だけ表示されちゃう。
溜まってたら適当に DELET してください。

実際に撮ったスクリーンショットってどのサイズで保存すればいいのかなぁ、なんて考えてます。
いくつかサイトを撮ってもらうとわかるんですけど、Shanon とか ミクシィとか左寄せのサイトと、 livedoor みたいなセンタリングされたサイト。
Nikki みたいにリキッドレイアウトのサイト。
こいつらのスクリーンショットをどうクロップするかがちょっとした課題。

API も一応作ってはみたものの本気で使ったりしないで下さいね。
SimpleAPI の方が良くできてるし。

※読みづらい場合は Nikki で読んでね。

最近ではモブログを提供しているブログサービスは珍しくはありませんね。
ブログサービスに限らず、SNS の日記などをモブログのように投稿できたり、メールに写真を添付してアップロードしたりと便利らしいです。
その便利らしいサービスにバグがあります。
もうちょっと限定的に言うとモブログ的なサービスを Perl で実装しているところ。
もしかしたら、PHP や Ruby なんかで実装しているところも同じバグがあるかもしれないです。
でも、僕が調べただけでもかなりのサービスに同様のバグがあります。
バグの内容はと言うと、

件名を「全角文字HANKAKUMOJI全角文字」などとして記事を投稿すると、記事の題名が「全角文字 HANKAKUMOJI全角文字」となる。
「全角文字」と「HANKAKUMOJI」の間に半角スペースが入る。
例えば、件名を「サークルKサンクス」として記事を投稿すると、記事の題名は「サークルK サンクス」となる。

AU、SoftBank の端末では起こらない。つまり、DoCoMo 茸

こんな感じ。

なぜこのバグが起こるかを説明する前に欧米人が定めたRFC2822(822) のセクション2を紹介します。
このセクション2は全部読んだ方がいいけれど、重要な部分をちょっと引用します。

2.1.1. Line Length Limits

   There are two limits that this standard places on the number of
   characters in a line. Each line of characters MUST be no more than
   998 characters, and SHOULD be no more than 78 characters, excluding
   the CRLF.

行の長さの制限

この標準では１行中の文字数に２つの制限がある。
それぞれの行の文字はCRLFを除いて、決して998文字以下でなければならず(MUST)、
78文字以下であるべきである(SHOULD)。

これは、そのまんまの意味。
CRLF を除いて、ヘッダの1行は 998文字以内じゃないとダメよ。
もしくは、（改行なんかして）78文字以内にするとなおいいね。

2.2.2. Structured Header Field Bodies

   Some field bodies in this standard have specific syntactical
   structure more restrictive than the unstructured field bodies
   described above. These are referred to as "structured" field bodies.
   Structured field bodies are sequences of specific lexical tokens as
   described in sections 3 and 4 of this standard.  Many of these tokens
   are allowed (according to their syntax) to be introduced or end with
   comments (as described in section 3.2.3) as well as the space (SP,
   ASCII value 32) and horizontal tab (HTAB, ASCII value 9) characters
   (together known as the white space characters, WSP), and those WSP
   characters are subject to header "folding" and "unfolding" as
   described in section 2.2.3.  Semantic analysis of structured field
   bodies is given along with their syntax.

構造化されたヘッダフィールドボディ

この標準において、いくつかのフィールドボディは上記の構造化されないフィー
ルドボディよりも拘束された特殊な構文の構造を持つ。これらは構造化された
フィールドボディとして参照される。構造化されたフィールドボディはこの標
準のセクション３，４に述べる特殊な語彙のトークンの並びである。これらの
トークンの多くがスペース(SP, アスキーコード32)、水平タブ(HTAB, アスキー
コード9)、セクション2.2.3に記したfoldingやunfoldingのヘッダを仮定する
WSPキャラクターと同様、（その構文によって）始まり、コメントとともに終
わることが許される。構造化されたフィールドボディの構文解析はその構文に
そって得られる。

「行の長さの制限」で言った、「（改行なんかして）78文字以内だとなおいいね」の、「改行」が入っているヘッダを「構造化されたヘッダフィールドボディ」と呼んでいます。

2.2.3. Long Header Fields

   Each header field is logically a single line of characters comprising
   the field name, the colon, and the field body.  For convenience
   however, and to deal with the 998/78 character limitations per line,
   the field body portion of a header field can be split into a multiple
   line representation; this is called "folding".  The general rule is
   that wherever this standard allows for folding white space (not
   simply WSP characters), a CRLF may be inserted before any WSP.  For
   example, the header field:

それぞれのヘッダフィールドはフィールド名、コロン、フィールドボディから
成る単一論理行である。しかしながら便宜のため、また１行あたり998ないし
78文字の制限を扱うために、ヘッダフィールドの一部であるフィールドボディ
は複数行に分割して表現でき、これをfoldingと呼ぶ。一般的なルールは、ど
こであれこの標準がfoldingのホワイトスペース（WSPではない）を見込むとき、
WSPの前にCRLFを挿入してよい、というものである。例えば、ヘッダフィール
ド：

(p8)
           Subject: This is a test

   can be represented as:

は以下のように表現できる。

           Subject: This
            is a test

「構造化されたヘッダフィールドボディ」の「構造化」のルール。
改行した次の行はホワイトスペース入れようぜ！と言っています。
今回、バグとしてとりあげた「半角スペースが入っちゃう」の半角スペースはこのルールの半角スペースです。
このルールもおかしな話なんです。
例えば、Subject: を改行しよう思ったら単語の終わりで改行しますよね？
RFC2822(822) の例文がそうなんですけど英語でしょ？
英語って単語と単語の間に半角スペース入れるから「改行した次の行はホワイトスペース入れようぜ！」とか言ってるんでしょうね。
戻すときは改行を取ればいいだけの話だから。
単語と単語の間にスペースなんて入れない日本語のような言語のことを考えていない仕様だと思いませんか？

それでは、DoCoMo、AU、SoftBank のそれぞれの端末でメールを送ってみて Subject: がどうなっているか見てみましょう。
まずは、DoCoMo。

Subject: 鳳たんってとってもcute
 だよね

1行目の「Subject: 鳳たんってとってもcute」で 64文字。78文字の制限まで多少余裕はあるけれど、
次の「?iso-2022-jp?B?GyRCJEAkaCRNGyhC?=」を続けられるほど余裕はないので改行します。
2行目は半角スペースを1つ入れて「?iso-2022-jp?B?GyRCJEAkaCRNGyhC?=」。
RFC2822(822) の推奨通りですね。行儀が良いです。

続いて、AU。

Subject: 鳳たんってとってもcuteだよね

AU は改行することなく1行。ちなみに、84文字。行儀よくないです。

最後に、SoftBank。

Subject: 
        鳳たんってとってもcute
 だよね

SoftBankも改行しています。これは僕の私物で 702NKⅡ。
モバイル業界では嫌われている SoftBank の端末。しかも、NOKIA 製という最悪の組み合わせです。
なので、サンプルとしては適していません。SoftBank の日本製の端末では AU のように改行することなく1行になります。
おそらく、日本製の端末はすべて1行になるんじゃないかなぁと思います。確認が必要ですね。

おまけとして、Thunderbird。

Subject: 鳳たんってとってもcuteだ
 よね

きれいですね。

さて、3キャリアから送信したメールのヘッダが揃いましたが、これらをデコードしてみましょう。
Perl でモブログや SNS への日記の投稿を提供しているところではおそらく、MIME::Parser を使用しているのではないでしょうか。
そして、肝心な Subject: のデコードは、MIME::Words::decode_mimewords で実装されていると思います。
ということで、今回は MIME::Wrods::decode_mimewords でデコードした結果を掲載します。
DoCoMo の場合。

鳳たんってとってもcute（改行）
 だよね（改行）

AU の場合。

鳳たんってとってもcuteだよね（改行）

SoftBank の場合。

鳳たんってとってもcuteだよね（改行）

ヘッダの最後には必ず改行が含まれます。デコードしてもその改行が取れることはありません。
なのでアプリ側で行末の改行を取り除いたりしていると思います。改行を取り除いてみましょう。
このとき、DoCoMo の途中にある変な改行も一緒に取れてしまいます。
DoCoMo の場合。

鳳たんってとってもcute だよね

AU の場合。

鳳たんってとってもcuteだよね

SoftBank の場合。

鳳たんってとってもcuteだよね

やっぱり、DoCoMo 茸「cute」の後に半角スーペースが入っています。
AU はそもそも改行していないので半角スペースが入るわけもありませんが、SoftBank は改行して半角スペース（1行目は TAB）を入れているにも関わらず、
デコードしても半角スーペースが入っていることはありません。なぜでしょうか？
それは、DoCoMo のエンコードの仕方に問題があるからです。
メールのヘッダは ASCII を使うようにしなくてはならないので、日本語は Base64 にエンコードしますね。
3キャリアすべて Base64 にエンコードされてはいますが、DoCoMo 茸もともと ASCII である「cute」をエンコードしていないのです。
（おまけとして挙げた Thunderbird は AU、SoftBank 同様すべてを Base64 でエンコードしています。）
この状態で MIME::Words::decode_mimewords を通ると、2行目以降の行頭の半角スペースが取れません。
それはなぜか？
MIME::Words::decode_mimewords をちょっと覗いてみましょう。手元のバージョンは 5．420 です。

sub decode_mimewords {
    my $encstr = shift;
    my %params = @_;
    my @tokens;
    $@ = '';           ### error-return

    ### Collapse boundaries between adjacent encoded words:
    $encstr =~ s{(\?\=)\s*(\=\?)}{$1$2}gs;
    pos($encstr) = 0;
    ### print STDOUT "ENC = [", $encstr, "]\n";

    ### Decode:
    my ($charset, $encoding, $enc, $dec);
    ## 以下デコード処理

鍵は真ん中あたりの「$encstr =~ s{(\?\=)\s*(\=\?)}{$1$2}gs;」。
「?=」はエンコードの終了マーク、「=?」はエンコードの開始マークになります。
なので、この行で行っている処理は、

エンコードの終了とエンコードの開始マークの間にあるホワイトスペースを取り除く

ということになります。s オプションがついているので改行は無視されて単一行として扱われていますね。
前述したように、DoCoMo はそもそも ASCII である「cute」をエンコードしていません。
「?=」と「=?」の間にホワイトスペース以外の「cute」があるので上記の正規表現に引っ掛からないんですね。
だから、改行後の行頭の半角スペースがとれないんです。

最初に、「僕が調べただけでもかなりのサービスに同様のバグがあります。」と書きましたが、
これがアプリのバグなのか、もともと ASCII である「cute」をエンコードしない DoCoMo の端末がおかしいのか、
はたまた、欧米人がつくった RFC2822(822) がおかしいのかはわかりませんが、とにかく提供しているサービスにバグがあることは確かです。
担当者のみなさん、頑張って直してくださいね。
ちなにみ、Subject: のデコードをEncode::decode で行えばすぐ直ります。
例えば、

my $parser = MIME::Parser->new;
my $entity = $parser->parse_open( $fh );
## $fh はメールファイルのファイルハンドル
my $header = $entity->head;
## ヘッダを MIME::Words::decode_mimewords でデコード
my $subject = decode_mimewords( $header->get( 'subject', 0 );

とかしていたら、

my $parser = MIME::Parser->new;
my $entity = $parser->parse_open( $fh );
## $fh はメールファイルのファイルハンドル
my $header = $entity->head;
## ヘッダを Encode::decode でデコード
my $subject = decode( 'MIME-Header', $header->get( 'subject', 0 ) );

とするだけです。
ただ、Encode::decode は問答無用で改行後のホワイトスペースを取り除きます。
Encode::Header::decode での処理。

sub decode($$;$) {
    use utf8;
    my ( $obj, $str, $chk ) = @_;

    # zap spaces between encoded words
    $str =~ s/\?=\s+=\?/\?==\?/gos;

    # multi-line header to single line
    $str =~ s/(:?\r|\n|\r\n)[ \t]//gos;
    ## 以下デコード処理

「$str =~ s/\?=\s+=\?/\?==\?/gos;」は MIME::Words::decode_mimewords と一緒で、エンコード終了マークとエンコード開始マークの間のホワイトスペースを削除。
その後の「$str =~ s/(:?\r|\n|\r\n)[ \t]//gos;」で改行後のホワイトスペースを問答無用で削除してます。
なので、エンコードされていなくて改行はされているような Subject: はおかしくなります。
例えば、RFC2822(822) のセクション2.2.3. Long Header Fields の例文で使われているような Subject: 、

Subject: This
 is a test

をデコードすると、

Thisis a test

になります。「This」と「is」の間の半角スペースが削除されてますね。
RFC2822(822) を無視した実装になっていますが、国内のモブログサービスであれば Encode::decode でも大丈夫だと思います。
この点はまだあまり調べていないので自信はないですけれどね。

i-revo - YAPC::Asia 2007動画配信 Perl 6 Today

Perl 6 Today の動画ができあがったみたいだよ。
マンモスきゃわPなぁ・・・。
まだ観てないけどね。

最近ちょこちょこ作っている Nikki 。
MT のデータソースをそのままつかって Catalyst で MT を作り直しているものです。
まだ、コンテンツ側の参照部分しかできていないけどね。CMS 側はまだまだ未着手。
で、コンテンツ側を作っていてちょっと悩んだのが、ブログには必ずある「パーマリンク」。
MT を再構築して静的に HTML を吐いていればまったく問題ないのですが、その「静的」が気に入らないのが Nikki を作りはじめたそもそもの理由。
パーマリンクが「http://hibinokoto.orz.hm/archive/year=2007&month=04」とかだったかっこ悪いじゃん？
クエリが付いている時点でパーマリンクとしてどうなの？って感じでもあるし。
でも、mod_rewrite とかもかっこ悪いじゃん。めんどくさいし。
で、どうしようかなぁって考えてたら、それらしいものを昔にみたなぁって思い出したんです。

Catalyst::DispatchType::Chained

もう、やりたいことそのまんま。しかも、Catalyst のコアだし。
ということで、Catalyst::DispatchType::Chained についての備忘録。

やりたいこと
エントリのパーマリンクは「/archives/エントリの ID」
月別アーカイブは「/archives/2007/4」（ほんとは 4 じゃなくて、04 とかがいい）
カテゴリ別アーカイブは「/archives/カテゴリ名」

Nikki::Controller::Archives

package Nikki::Controller::Archives;

use strict;
use warnings;
use base 'Catalyst::Controller';

sub root : PathPart('archives') Chained CaptureArgs {}

sub entry : PathPart('') Chained('root') Args(1) {
    my ( $self, $c, $id ) = @_;

    my $entry = $c->model('DBIC::MT::Entry')->find( $id );
    $c->stash->{entry}    = $entry;
    $c->stash->{comments} = $entry->comments;
}

sub monthly : PathPart('') Chained('root') Args(2) {
    my ( $self, $c, $year, $month ) = @_;

    my $entries = $c->blog->entries->search(
        {
            entry_created_on => { LIKE => sprintf q{%4d-%02d%%}, $year, $month },
        },
        {
            order_by => 'entry_created_on DESC',
        },
    );
    $c->stash->{itr_entry} = $entries;
}

sub category : PathPart('category') Chained('root') Args(1) {
    my ( $self, $c, $category ) = @_;

    my $req = $c->req;
    my $entries = $c->model('DBIC::MT::Entry')->search(
        {
            'category.category_description' => $category,
        },
        {
            prefetch => {
                placement => [ 'category', { entry => [ qw/ author / ] } ],

            },
            order_by => 'entry.entry_created_on DESC',
            rows     => $req->param('rows') || 5,
            page     => $req->param('page') || 1,
        },
    );
    $c->stash->{itr_entry} = $entries;
}

1;

順に説明。

sub root : PathPart('archives') Chained('') CaptureArgs(0) {}

まずは、 root （名前は何でもいい）を定義。
PathPart('archives') を指定すると、/archives/ という URL に対するアクションを用意する。
CaptureArgs(0) について。
CaptureArgs を指定することで、/arhives/ がURL の終端ではないことを指示できる。
CaptureArgs(0) は /archives/ のあとに続くものを引数としては受け取らないということ。
/archives/ を叩いても、この root が動くことはない。Nikki::Controller::Root::default が動く。

パーマリンク

sub entry : PathPart('') Chained('root') Args(1) {
    my ( $self, $c, $id ) = @_;

    my $entry = $c->blog->entries->find( $id ); 
    if ( $entry ) {
        $c->stash->{entry}    = $entry;
        $c->stash->{comments} = $entry->comments;
    }
}

PathPart(''), Chained('root') と定義しているので、etnry は /archives/ のアクションになる。
ここで、もし、PathPart('sawa'), Chained('root') と定義すると、 entry は /archives/sawa/ のアクションになる。
Args を定義しているので、/archives/ が URL の終端であることが指示できる。
Args(1) があるから、/archives/ に続くものを1つ引数として受け取ることができる。
例えば、/archives/sawa なら etnry には $self, $c ともうひとつ $str として sawa が引数で渡ってくる。
今回の場合では、エントリの ID、$id として受け取る。
あとは $id からエントリを find して stash につめるだけ。
Args(1) としているので、/archives/1/2 を叩いたとしても 2 は無視される。

月別アーカイブ

sub monthly : PathPart('') Chained('root') Args(2) {
    my ( $self, $c, $year, $month ) = @_;

    my $entries = $c->blog->entries->search(
        {
            entry_created_on => { LIKE => sprintf q{%4d-%02d%%}, $year, $month },
        },
        {
            order_by => 'entry_created_on DESC',
        },
    );
    $c->stash->{itr_entry} = $entries;
}

PathPart(''), Chained('root') と定義しているので、monthly は /archives/ のアクションになる。
Args(2) を指定しているので、/archives/ がアクションを指定する URL の終端で、後に続くものを2つ引数で受け取る。
monthly ではそれを $year, $month で受け取る。あとは search するだけ。
monthly を動かそうとして、/archives/2007/ とかを叩くと、さっきの entry が動いてエントリID が 2007 のを find しにいっちゃうよ。
monthly が動くのは、Args(2) を指定したように、/archives/2007/4/、もしくは、/archives/2007/4 のように、/archives/ の後に2つ引数があるときのみ。

カテゴリ別アーカイブ

sub category : PathPart('category') Chained('root') Args(1) {
    my ( $self, $c, $category ) = @_;

    my $req = $c->req;
    my $entries = $c->model('DBIC::MT::Entry')->search(
        {
            'category.category_description' => $category,
        },
        {
            prefetch => {
                placement => [ 'category', { entry => [ qw/ author / ] } ],
            },
            order_by => 'entry.entry_created_on DESC',
            rows     => $req->param('rows') || 5,
            page     => $req->param('page') || 1,
        },
    );
    $c->stash->{itr_entry} = $entries;
}

PathPart('category'), Chained('root') と定義しているので、category は /archives/category/ のアクションになる。
Args(1) を指定しているので、/archives/category/ がアクションを指定する URL の終端で、後に続くものを1つ引数で受け取る。
あとは、search。

みたいな感じかな。
今回は find や search をコントローラに書きました。何しているかわかりやすいかなと思って。
あと、$c->stash->{template} は？とか思うかもしれませんが、それは、Nikki::Controller::Root::end で

$c->stash->{template} = $c->action->reverse . '.tt' unless $c->stash->{template};

みたいなことをしています。テンプレートのディレクトリ構造、ファイル名は決め打ちです。
アクション毎に $c->stash->{template} = '*****.tt' とかするの面倒なので。
なんかおかしなところがあったら教えてくれろ。

作りかけの Nikki。
MT のデータソースから Schema を起こしてます。
まだ参照しかできないけど、よかったら。

[% category %] はイテレータとして扱えるけど、[% category.entries %] はイテレータとして扱えないですよというお話。

MT のデータソースを使っています。
MT の仕様として、エントリー (mt_entry) は複数のカテゴリー (mt_category) を持つことができます。
逆も同様。
要するに、エントリーとカテゴリーは交差テーブルの mt_placement を介して多対多ということです。
なので、DBIC::Schema ではちょっとめんどうな many_to_many を設定してやります。
インフレーションなんかはプロジェクトのコンポーネント (DBIC.pm) に datetime_column() とかを定義。
インデントが崩れちゃって見づらいですけど、だいだいこんな感じです。

Entry.pm

package Schema::MT::Entry;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components( qw/ PK::Auto +Nikki::DBIC Core / );
__PACKAGE__->table('mt_entry');
__PACKAGE__->add_columns( qw/
    entry_id
    entry_blog_id
    entry_status
    entry_author_id
    entry_allow_comments
    entry_allow_pings
    entry_convert_breaks
    entry_category_id
    entry_title
    entry_excerpt
    entry_text
    entry_text_more
    entry_to_ping_urls
    entry_pinged_urls
    entry_keywords
    entry_tangent_cache
    entry_created_on
    entry_modified_on
    entry_created_by
    entry_modified_by
    entry_basename
    entry_atom_id
    entry_week_number
/);
__PACKAGE__->datetime_column( qw/ entry_created_on / );
__PACKAGE__->set_primary_key('entry_id');
__PACKAGE__->belongs_to(
    author => 'Schema::MT::Author',
    'entry_author_id',
);
__PACKAGE__->belongs_to(
    blog => 'Schema::MT::Blog',
    'entry_blog_id',
);
__PACKAGE__->has_many(
    comments => 'Schema::MT::Comment',
    'comment_entry_id',
);
__PACKAGE__->has_many(
    placement => 'Schema::MT::Placement',
    'placement_entry_id',
);
__PACKAGE__->many_to_many(
    categories => 'placement',
    'category',
);

1;

Category.pm

package Schema::MT::Category;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components( qw/ PK::Auto ResultSetManager +Nikki::DBIC Core / );
__PACKAGE__->table('mt_category');
__PACKAGE__->add_columns( qw/
    category_id
    category_blog_id
    category_allow_pings
    category_label
    category_description
    category_author_id
    category_ping_urls
    category_parent
    category_basename
/);
__PACKAGE__->set_primary_key('category_id');
__PACKAGE__->has_many(
    placement => 'Schema::MT::Placement',
    'placement_category_id',
);
__PACKAGE__->many_to_many(
    entries => 'placement',
    'entry',
);

sub count_entries { shift->entries->count }

1;

Placement.pm

package Schema::MT::Placement;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components( qw/ PK::Auto +Nikki::DBIC Core / );
__PACKAGE__->table('mt_placement');
__PACKAGE__->add_columns( qw/
    placement_id
    placement_entry_id
    placement_blog_id
    placement_category_id
    placement_is_primary
/);
__PACKAGE__->set_primary_key( qw/ placement_id placement_category_id placement_entry_id / );
__PACKAGE__->belongs_to(
    entry => 'Schema::MT::Entry',
    'placement_entry_id',
);
__PACKAGE__->belongs_to(
    category => 'Schema::MT::Category',
    'placement_category_id',
);

1;

Schema にこう定義してやって、コントローラで

my $itr_category = $c->model('DBIC::MT::Category')->search;
$c->stash->{itr_category} = $itr_category;

一方、テンプレートではこうすると、

[% WHILE (category = itr_category.next) %]
[% categroy.category_label %]<br />
[% END %]

こうなります。

*** 出力 ***
思うこと
音楽のこと
映画のこと
本のこと
仕事のこと
なんてことないこと
彼と僕のこと

オーケー、オーケー。
ただ、カテゴリーとエントリーは many_to_many なので、各カテゴリーに属するエントリー数も表示させちゃおう。
なんて考えますよね。「鳳たんとのこと(94)」みたいに。
で、こうするわけですよ。

[% WHILE (category = itr_category.next) %]
[% categroy.category_label %]([% category.entries.count %])<br />
[% END %]

*** 出力 ***
思うこと()
音楽のこと()
映画のこと()
本のこと()
仕事のこと()
なんてことないこと()
彼と僕のこと()

[% category.entries.count %] 動いてないじゃーん・・・。
コントローラではちゃんととれるんですよ。$itr_category を next してやって、$category->entries->count で。
でも、テンプレートに渡ると取れなくなっちゃうんですよねぇ。
「え〜、どうしよう、どうしよう」ってなるわけですよ。鳳たんに聞こうにも、僕、鳳たんの電話番号知らないし。
[% USE Dump %] する前に、とりあえず、こういうことをしてみます。

[% WHILE (category = itr_category.next) %]
[% category.entries %]
[% END %]

結果がこうね。

*** 出力 ***
ARRAY(0x83176e00) ARRAY(0x831707f8) ARRAY(0x83171260) ARRAY(0x831703cc) ARRAY(0x83170a38) ARRAY(0x831816b0) ARRAY(0x831705d0)

あぁ・・・。ARRAYREF じゃん・・・。そりゃ、count 呼べないよね・・・。
って言うか、何で HASHREF （イテレータ） じゃなくてただの ARRAYREF なの？何で？何で？
[% category %] は HASHREF （イテレータ）なのにね。鳳たん、何で？
と言うことで、Catagory.pm に count_entries() なるものを実装。

Category.pm

package Schema::MT::Category;

use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components( qw/ PK::Auto ResultSetManager +Nikki::DBIC Core / );
__PACKAGE__->table('mt_category');
__PACKAGE__->add_columns( qw/
    category_id
    category_blog_id
    category_allow_pings
    category_label
    category_description
    category_author_id
    category_ping_urls
    category_parent
    category_basename
/);
__PACKAGE__->set_primary_key('category_id');
__PACKAGE__->has_many(
    placement => 'Schema::MT::Placement',
    'placement_category_id',
);
__PACKAGE__->many_to_many(
    entries => 'placement',
    'entry',
);

## ここね
sub count_entries { shift->entries->count }

1;

ちょっと泣きたくなるお・・・。
これは TT の仕様？僕のやり方がダメ？鳳たんかわいい？うん、かわいい。って言うか、キュート。
近いうちに、この MT をゴニョゴニョしてるのを公開しますね。ゴニョゴニョ中だけど。

YAPC::Asia 2007 の Six Apart のセッションの TT についての話。
1リクエストの約6割が end アクションの TT の処理。
以前から end アクションにかかる時間は気になっていたけれど、いざ数字で6割と言われるとちょっとびつくり。
なので、僕も自分のアプリのプロファイルを眺めてみることに。

・MyApp
　Catalyst リリース当時に作り出した How to Catalyst 的なアプリ。
　1年位前に CDBI から DBIC::Schema に乗り換えたアプリ。
　Schema をアプリケーションの外に出したり。
　この頃はリレーションとかトランザクションには手をつけていない。

このアプリではなぜかしら Controller::Root の end アクションでなく、各アクションの最後で process してる。
まぁ、2年くらい前に作った How to Catalyst だからね。

・FatGalJam
　1．0 的な基幹系のアプリ。
　モデルはビデオ屋さん。大きくなったらレンタルビデオ屋をやるのが夢なので。
　Catalyst::Plugin::Authorization::Roles がウンコちゃんなので User, Group, Role, Function でまともな Authorization を実装したもの。
　あと、DBIC::Schame の トランザクション、リレーション、インフレーションなんかを実装したもの。

FatGalJam では end アクション以上に auto アクションで結構時間かかってる。
と言うのも、Controller::Root の auto アクションで Authorization をしているから。
でも、やっぱり end アクションもそれなりに時間かかってるねぇ。

・Poto
　画像をアップロードして加工するアプリ。
　2．0 的なものが作りたいなぁと思って、prototype, dojo, prototype window に手を出したもの。
　自分のアップロードした画像を検索して、prototype window 内の div タグを Ajax.Updter でゴニョゴニョしたり。
　JavaScript に手を出したおかげで、CSS の勉強もしないといけなくなって結局画像の加工までは実装せずじまい。微妙に拡大・縮小はできる。
　あと、ここから TTSite をちゃんと使いはじめた。結構便利よ。

Poto でもずばぬけて end アクションに時間がかかっている。

・Nikki
　MT のデータソースを使って今作っているアプリ。
　アプリのイメージはなし。プロファイルだけ。

Nikki も end アクションに時間かかりすぎ。と言うか、ほぼ end アクション。
[% WHILE %] 毎に COUNT 文が走っているのがログからバレバレですね。ちょっと恥ずかしい。
ちゃんと many_to_many してるし、 prefetch もしてるんですけど、 View からだとうまく呼べないんですよね。
ちゃんと調べます。

View でこんだけ時間取られると釈然としませんね。
昔取ったベンチだと HTML::Template::Pro は TT の3倍くらい早かったと思うけど、TT 使っちゃうと HTML::Template には戻れませんよね。
あ、そうそう、今回挙げたアプリはすべて開発サーバで動かしているので TT のキャッシュは切っています。

ついでに。
僕は Controller::Root::begin で Authentication （ログインのチェック）を行います。
Authorization （権限のチェック）は Controller::Root::auto で行います。
auto アクションはオーバーライドされることなく必ず全ての auto アクションが実行されるから。
逆に、begin アクションはオーバーライドされます。
なので、ログインとかユーザー登録とかは Authentication が行われないように begin をオーバーライドします。
オーバーライドしてやらないと、ログインしようとしているのに、「ログインしてください」的なことになるからね。

YAPC::Asia 2007 の 最高の LT。

Dan the suspenders in YAPC::Asia 2007

この LT だけで 1,500円 の価値があると思う。
それにしても、「use Shanon::Catalyst;」って・・・。

「止まってくれるだろう」
そう思って横断歩道へ進んだ僕が間違いだった。
その車のバンパーは見事に僕の左膝をえぐって通り過ぎた。
通りすがりに車内を覗いて見ると頭の悪そうな男女がいた。上下トレーナーの。
普段の僕なら運転している男を車から引きずり出してぶっ飛ばしてます。
女の方は犯して殺して、その死体をもう一回犯してます。
でも、今日は待ちに待った YAPC::ASIA があるので見逃してあげます。
宮川達彦に感謝しろ、トレーナー！

そんなこんなではじまった YAPC::ASIA 2007 のレポートでも書いてみようかなと思ったけど
すでに各所でレポートはあがっているし、Perl とかよくわからないので書きません。
印象に残ったのは鳳たんこと、Audrey Tang。

彼と言うか、彼女は台湾人のフリーで働いているエンジニア。
そんな彼女のセッションは「Perl 6 Today」。
内容はもちろん英語なので何を言っているのかはわかりません。
ただ、彼女の Enter キーの叩き方が非常にキュートなのだけは覚えています。
スクリーンそっちのけで彼女の手元ばかりを見てました。
彼女が使っていた PC は白の Mac Book だった。僕も欲しい・・・。
公演の途中で彼女が上着を脱いだのですが、その仕草もキュートだった。
そして、何よりキュートだったのが、下がった眼鏡を直す仕草。
近年まれに見るキュートさ。ほぼ完璧！
もうね、眼鏡かけてる女の子は見習って欲しい。
眼鏡かけりゃかわいいと思ったら大間違い！
そもそも普段眼鏡かけない人の眼鏡顔ってわかるしね。「あ、こいつ普段コンタクトだな」って。
それに、眼鏡の扱いでもわかる。眼鏡の扱いが雑なんですよね。
それに比べて鳳たんったらキュートだった。
ほんと見習って！
明日か明後日くらいに公演のエンコードが終わって動画が出回るらしいから、それ見て研究してください。
Enter キーの押し方、眼鏡の直し方、上着の脱ぎ方、ペットボトルのふたの開け方。
すべての仕草がキュートなんだから。

センシティブな内容だろうから詳しく言及できないけど、きっと、『彼と言うか、彼女』なだけにキュートなんでしょうね。
普通に女の子として生まれた女の子にとっては自分が女の子だということは当たり前だから
鳳たんのようなキュートさを兼ね備えている女の子はそうそういないんだろうなぁ。
そんな、YAPC::ASIA 2007 の感想でした。

信頼のおけるブロガー yappoさんのエントリーから。

YappoLogs あなたがRuby on Railsを使わない10の理由

Shanon::Catalystでアプリ構築するときにmod_perl起動に40分かかるというトラブルがよく報告されてるwけど、そのへんも心配ないよ。

元ネタはこっち。
yappoさんってこういうのうまいね。

Shanon::Catalyst と言うよりも、SS って今は mod_perl じゃないよね？
サーバの起動も 30秒くらい。だっけ？
メンテお疲れ様でした。

「traveling」でも聴いて仕事にでも精を出しましょうか。

チョコとくるみのロール。
帰りがけのローソンで買っちゃった。
いいでしょ。
こんな時間にこんなものを食べると女の子は太っちゃうから食べちゃだめよよよ。

前に「机の上のこと」で書いたように僕は白地が好きです。
僕らエンジニアが使うターミナルの背景色は普通黒とか暗い色を使います。
で、フォント色を明るめにするのかな。
僕はターミナルの背景色も白です。
明るいから。
フォントはピンク。
そろそろ春だから。って年中言ってる。
でも、背景色を白にすると emacs が使いづらい。
ほら。

$self とか $c とかスカラーがデフォルトの emacs の設定だと黄色になっちゃうんですね。
非常に見づらい。
と、ここ数年「見えないよ〜」と言いながらぱちぱちしてたんですけど、最近見つけました。

.emacs にこう書くとこうなります。

ね、スカラーが青になったでしょ。
これでスムーズにぱちぱちできるわけです。

久しぶりの「仕事のこと」。

CodeZine というサイトがあります。
「開発者のための実践系Webマガジン」なんていう副題がついているくらいなので
内容はTIPS的なものが多いです。
今回は仕事の一環としてその CodeZine に寄稿させていただきました。

「Perlで作るモバイルサイトのコツ：第6回」

内容はセッション管理。
クッキーを使えないモバイル端末ではどうやってセッションを保持するの？
それはね・・・、というお話。
「セッション管理」と言うと大袈裟な話で、要は「どうやってセッションIDを引き継ぐか」ということ。
セッションIDさえ取得できればセッションの管理自体はPCとモバイルで違いはありません。

寄稿するにあたってサンプルのプログラムを書いたのですが
久しぶりに Sledge とか Catalyst とかを使わずに、入力・確認・完了の遷移を書きました。
以前の職場ではフレームワークを使わずにアプリケーションを作っていたのですが、
その面影が漂っているのが感じられます。

「モバイルではどうやってセッション引き継ぐの？」とか
「さわのプログラムってどんなスタイルなの？」って思った人は
是非、足を運んでみてください。

サンプルは「はじめに」のすぐ上にリンクがあるよよよ。

大変今更なことで申し訳ないのですが、
僕はqw()派ではなくてqw//派です。
ごめんなさい。

何か新しいことをはじめるとき、僕は基本をないがしろにしがち。
楽器であればとりあえず音を出す。プログラムであればとりあえず書いて動かす。
ある程度かたちができたところで楽典を読んだりラクダ本を読んだりする。
そういったドキュメント的なもの目を通す頃には変なくせがついている。
そんなことはざらだ。

なぁんて変なことを書こうと思ったのもこれ。
今Catalystでアプリを作っています。How to Catalyst的な簡単なアプリ。
例外なく今回もドキュメント的なものにろくに目を通さずごりごり書いてます。
ある程度動くものが出来上がってきたろころでドキュメントに目を通したわけです。
このドキュメント
'RUN THE APPLICATION'に注目です。
以前からDBIx::Classが吐くSQLのログが欲しいなぁなんて思っていたところです。
早速PerlSetEnv。
おぞましい数のSQLが発行されてます。
DBIX_CLASS_STORAGE_DBI_DEBUGって常識ですか？

追記的な
ちなみに、

DBIC_TRACE "1"

としても同じです。
そして、

DBIC_TRACE "=/tmp/query_log"
もしくは
DBIX_CLASS_STORAGE_DBI_DEBUG "=/tmp/query_log"

とすると/tmp/query_logにログが吐かれます。

今の勤務地は渋谷。
プログラマといこともあってお昼休みは好きな時間にとれる。
だいたい午後2時から3時にかけてお昼休みに入る。
だいたいマックに行く。
だいたいチキン・フィレオ。
だいたいコーラは飲みきれない。
会社の人はこんな僕のマックライフを聞くと決まって「体に悪い」。そう言う。
だいたい「スーパーサイズ・ミー」の話をする。
ほぼ決り文句だ。
なので、僕も決り文句を用意している。
「マックをたくさん食べて田さんに会いに行く」
「田さん、もう死んでるよ」
「会いに逝く。マックの食べすぎで死ぬなら本望だ」
まぁ、軽い冗談ですけど。

普段、僕は一人で昼食を摂っていますが7月は4人でランチに行く予定があります。
前の席のデザイナー、仮に彼をまっちゃんと呼ぶことにしよう。仮にね。
僕、まっちゃん(仮にね)、社長、技術部長。この4人でランチに行きます。
これは何も僕とまっちゃんが特別なわけではなく、社長が提案したものだ。

「このクォーターをかけてみなさんと各部長とランチに行こうと思います」

こんなメールが社員に送信されたのだ。
僕とまっちゃんの予定は6月中だったのだけれど
ちょうどその日に開発部へ新しい人が入ってきた。
今回入ってきた人もCPANのAUTHOR。有名な人。
そんなわけで、開発部恒例の歓迎ランチが執り行われ社長ランチはお流れに。
1ヶ月以上も先延ばしになり7月25日にリスケされました。
既に社長ランチを済ませた人にちょこっと聞いたところ
行き先はいくつか用意されているみたいです。
「寿司、肉、パスタ、なんちゃら、なんちゃら・・・。どれがいい？」
そんな感じらしいです。
マック！マック！もちろんマックです。
話によると社長は体に悪いもの、悪そうなものはあまり口にしないそうです。
マックは食べそうにないらしいです。
マック！マック！。なおさらマックです。
ほら、最近ではサラダマックなんてものもありますし。
僕はチキン・フィレオですけどね。
社長が渋谷のマックで食事をしていたらちょっとウケます。
何なら奢ってあげても構わないと思っています。

そんな僕の思案を聞いたまっちゃんは
「マックなんて行きたくないですよ。ひとりで行ってくださいよ」って。
まぁそんなこと言うなよ、まっちゃん。
プロジェクトのリーダーからマックのクーポンもらってるんだよ。
「ビックマックが150円だって。社長ランチで是非提示してください」って。
これ、まっちゃん使っていいからさ。僕のコーラもあげるよ。
だからさ、マック行こう、マック！

僕が今働いている会社は毎週のように新しい人が入ってきます。
開発部では新しい人が入ってくるとみんなでランチを食べに行くことが
恒例となっています。
今日も開発部に新しい人が入ってきました。
例外なくみんなでランチ。
事前に何を食べるか決めるのですが僕は鰻のひつまぶしに決定。
ひつまぶしムード満点で12時までちょこっとコーディング。
時間になったのでそそくさエレベーターへ向かうとそこには見たことのある顔が。
そう、今日入ってきた新しい人とはこの人。
びっくりした。あ〜、びつくりした。
もう、ひつまぶしどころじゃないです。
ちょっと休憩のふりをしてその人の席へ立ち寄って「研修ですか？」なんて聞いたら、
「研修というか、ほぼ開発ですね」って。
表した頭角は既にトップランクです。
こんな人と一緒に仕事ができるなんて恵まれていますね。

僕が働く開発部には他にもこの本の著者がいます。
変なキーボードと言ったら失礼ですけど、変なキーボードを使っています。
今日はすっごくかわいいTシャツを着ていました。すっごく気になりました。

ちなみに、ランチに食べる予定のひつまぶしはおっちょこチャイナのちょっとした
手違いで食べることができませんでした。
渋谷店ではなくて赤坂店を予約してしまったそうです。
代わりのお店で代わりに食べた豚トロなんちゃらがおいしかったので
おっちょこチャイナの手違いはチャラにしても構わないと思っています。

最近めっきり「仕事のこと」を書いていないので
久しぶりに書いてみます。
とは言っても直接仕事のことではないです。
そして、普段僕の日記を読んでもらっているほとんどの人にはチンプカンプンな
内容だと思います。

僕はプログラマです。
Perlという言語でシステム開発をしています。
今はとある求人サイトを開発しています。リクナビみたいなやつです。
Perlという言語はCPANというものがあって世界中のプログラマが作ったライブラリを
好き勝手にダウンロードして使いまわせるんですね。
そのCPANにライブラリを登録している人をAUTHORといいます。
意味はそのまんま「作者・著者」ですね。
PerlのプログラマならCPANのAUTHORにはちょっと憧れます。
なので、僕もなりました。そのAUTHORというやつに。
作ったモジュールはTemplate::Plugin::MP3::Tag。
MP3ファイルのタグ情報を読んだり書いたりするTemplate-Toolkitのプラグイン。
どうやらTrickster 2.0でMP3::Tagが使われてるらしいので
見切り発車感はありますが登録しちゃいました。

プラグインなのでモジュール自体はすぐ出来上がったけどドキュメントの作成や
登録の手続きが面倒。英語でいろいろと書かないといけない。
日本語なら気の利いたジョークを交えつつドキュメントを作成できるんですけど
英語となるとねぇ・・・。
伝えたいことはたくさんなるのにそれを言葉にできない悔しさ。
やれやれ。
そんな悔しさを味わいつつもCPANのAUTHORになるのはやっぱり気持ちいいです。
次は何を作りましょうかね。

追記的な・・・
TTのプラグインって大抵の場合、メソッドをコールするとAUTOLOADを使って
useしているクラス、僕の場合はMP3::Tagにメソッドを検索しに行きます。
AUTOLOADってコスト高いですね。
既にコールしたことあるメソッドでも単純にAUTOLOADを使うと毎回MP3::Tagに
探しに行っちゃうんですね。

・Template::Plugin::MP3::Tagからメソッドを検索
・ないのでMP3::Tagからメソッドを検索

メソッドがコールされる度にこれを繰り返します。

クロージャ？
もしくは、MP3::Tagのメソッドを全部コピー＆ペー・・・。
やれやれ。

日曜の午後9時頃会社に来てバグフィックス。
これを書き終わったらマックに行ってフィレ・オ・フィッシュのセットを買って食べて寝る。
いわゆる、朝マックです。
全然素敵じゃない朝マック。
朝マックってもっと素敵なはずなんだけどなぁ。

そうそう、マックで思い出したけれど、えびフィレオのCM。
すっごくかわいいです。
エビちゃんじゃなくて。後で流れてる「パラッ、パッパッパ〜」が。
それもそのはず、土岐麻子が歌ってるんですよね、あれ。
エビちゃんの100倍くらいかわいい。できればエビちゃんには黙っていてほしい。
声だけじゃなくて映像としても麻子ちゃんを使った方が売れるんじゃないかな？
いや、ほんとに。

そんな麻子ちゃんの声を聴きながらの朝マックは少しだけ素敵です。

今日は会社にお泊り。今週2回目の。
それというのも今日は午後3時40分くらいに出社したからだ。
それでなくても今週の出社時間は平均して12時くらいになるだろう。
規定の出社時間は10時なのに。
遅刻してしまう理由はただただ調子が悪いだけ。
気合がないだけ。
体調は問題ない。それなりに悪いだけだ。そう、それなりに。

昨日、お昼を買いに出たらminiの7月号が出ていたので買った。
僕はもうminiなんて読むような年ではないが2月号と7月号は買うようにしている。
全員集合する号だから。
それに、今月はおまけとしてビーチサンダルが付いている。確かx-girlの。
僕は会社では靴をすぐ脱いでビーチサンダルに履き替える。
そのビーチサンダルも大分くたびれてきているのでおまけのビーチサンダルはいい機会。

僕の下半身はx-girlのビーチサンダルにローリーズファームのデニム。
来世の準備はばっちりだ。

これとさらさらパウダーシートは必需品です。

何度も言いますがマイケル・ウィンターボトムは関係なく現実の話で徹夜しているということです。

５がつ５か　もくようび　はれ

きょうは５がつ５か。こどものひ。
おやすみだけどぼくは２６さいのしゃかいじんなのでかいしゃにいった。
かいしゃにはぼくのほかに５にんいた。みんなしごとがすきなんだな〜。
ゆうがたの５じまえにいったのでそんなにしごとはしていないけれど、もじゅーるを２つつくることができた。
かいはつすけじゅーるも１にちちょきんがある。
１０じにはみんなかえっちゃったけどぼくは１１じくらいまでのこってた。
あしたはふつうにかいしゃがあるのできょうはこれくらいでおわりにしようかな。
ぼくがねているあいだにこびとさんがい〜っぱいもじゅーるをくんでくれるはずだ。
あしたがたのしみだな〜。

25:30帰宅。
確実に遅くなっている。月曜日から電車1本ずつ。
月曜日は終電の3本前。
火曜日は終電の2本前。
そして今日は終電の1本前だ。
単純に計算すると明日は終電で帰ることになる。
うん、間違いない。
とすると、金曜日は電車に乗れないことになる。
うん、これも間違いない。
まずい、これはまずい。今風に言うならば「ヤバイ」だ。
金曜日に電車がなくなっていることはまぁよしとしよう。ほら、花の金曜日とか言うし帰らない人も多いんでしょ。
そんなことよりも仕事が終わらない。
画面設計がひと段落ついて仕様書を書き始めたら設計ミスと仕様変更の嵐だ。
ひと段落つけた画面設計も意味がない。
・・・ちょっと言い過ぎた。嵐ほどではないが確実に雨は降っている、今日くらいの。
「ヒーロー見参、ヒーロー見参、ヒーロー見参」と唱えたところで僕のヒーローはまだ現れない。
頭をいくらぐるぐる回しても素敵なＥＲ図は思い浮かばない。ハムスターが回すあれよりも回しているはずなのに。
最近では考えることに疲れた感があってルーチンワークに従事したいと思うこともある。
TSUTAYAなんかで「一週間でよろしいですか？」とか言って8時間ぶっとおしでビデオのバーコードを打ち続けたい。そんな気分。

かと言ってリクナビNEXTをお気に入りに追加するのはまだまだまだまだ早い。

仕事のことについて書いていこうかと。
最近している仕事、したい仕事、過去にした仕事とか。