« 2005年08月 | メイン | 2005年10月 »

2005年09月29日

はてなの新ロゴはランドストーカーだ。

h1.gif

?マークの下から2つめの青いブロックは実は空中に浮いているとか。
ランドストーカーやりてぇ。祖父の家に僕のMega Driveがあったんだけど動くなぁ。。

と、思ったらPSPで出るみたいだぞ。
http://www.famitsu.com/game/coming/2005/09/06/104,1126008125,43019,0,0.html
よし、PSP買うぞ。

2005年09月27日

どうしてWの横がQなのだ。

間違えて押して書いてたエントリー消しちゃったよ。

CD二枚購入。

ACALANTO
ACALANTO
posted with amazlet on 05.09.27
Saigenji
東芝EMI (2005/09/14)
売り上げランキング: 175

saigenjiの4thアルバムと

Laughin’
Laughin’
posted with amazlet on 05.09.27
中塚武
ビクターエンタテインメント (2005/08/24)
売り上げランキング: 1,174

中塚武の2ndアルバム。
この中塚武のアルバムは、リ・マイブラさんにトラックバックをいただいて知りました。どうもありがとうございましたです!人生ではじめてトラックバックが役に立った感じがしました!!

Amazonのレコメンド機能は新しいCDには弱いと思うのですがどうでしょう。
メールに書いてあるのかなぁ。今度からチェックをもうすこししよう。

おすすめページでQYPTHONEの新しいCD見っけ。

キップソーン エピソード1~キップソーン アーリーコンプリート~
QYPTHONE
ハピネスレコード (2005/10/12)
売り上げランキング: 28,284

要チェック。

サマータイムマシンブルース

本広監督の「サマータイムマシンブルース」みてきた。結構面白かったです。
踊る大捜査線」シリーズがあまりに大きすぎて監督の名前がその陰に隠れてしまいがちな本広克行監督ですが、やはりドタバタを撮らせるとうまい。ちょっと前のスペーストラベラーズも面白かったし、「踊る」の真下も実はツボ。ドタバタをきちんとまとめきってしまうところがさすがです。

この前の週に「容疑者 室井慎次」もみてきたのですが、比較するのはちょっと違うような気もするけど、こっち(本広監督)の方が好みだなぁ。

2005年09月23日

CGI::AppのPATH_INFOの補正を自動化プラグイン

PATH_INFOと相対パス(リンク)のエントリーで書いた。PATH_INFOの補正を自動的に行うPluginを書いてみた。1つ前のエントリーのCGI::Application::Plugin::DevPopupでCGI::Appの実行情報を出力で既に使用中。

なぜPATH_INFOの補正をしたいのかは上のエントリーを参照なのですが、まとめると画像やCSSなどの素材へのリンクを相対リンクにしておきたいときがあるからです。前回のPATH_INFOの補正では、

sub setup{
        my $self = shift;
        $self->start_mode('index');
}

#本当のstart_modeへリダイレクト
sub dispatch_index{
        return shift->redirect_dispatch('start');
}

sub dispatch_start{
        #本当のstart_mode
}

として、indexという名前のモードを手で書いて、本来start_modeにしたいところへredirectしました。これを自動的に行うプラグイン書きました。ソースはこちら

prerunの中でもredirectできるCGI::Application::Plugin::Redirectのアイディアを借りてます。テストがまだですがCGI::Application::Dispatchにも対応してます。
このプライグンですが、あまりエレガントでないところがあります。CGI::Appの実行順序として通常

↓new
↓ cgiapp_init
↓ setup
↓run
↓ cgiapp_prerun
↓ 今回のモジュールのhook

となっていると思います。setupやcgiapp_prerunでもし、DBへの接続などを行っている場合、redirectしてしまうとちょっと無駄になってしまいます。mod_perlならまだしも普通のCGIの場合ちょっとコストが高いです。良い手ありませんかねぇ。


以下ソース

package CGI::Application::Plugin::PathInfoFixer;

use strict;
use Carp;
our $VERSION = '0.01';
use base qw(Exporter);

sub import{
	my $caller = scalar(caller);
    $caller->add_callback('prerun',?&_pathinfofixer_prerun);
	goto &Exporter::import;
}

sub _pathinfofixer{
	my $self = shift;
	my $q = $self->query;
	
	#make new path_info
	my $path_info='/'.$self->start_mode;
	if($self->param('CGIAPP_DISPATCH_PATH')){
		$path_info = '/'.lc $self->param('CGIAPP_DISPATCH_PATH') . $path_info;
	}

	my $location = $q->url();
	$location .= $path_info;
	$location .= '?' . $q->query_string if $q->query_string;

	$self->header_type('redirect');
	$self->header_props(-url=>$location);
	
	return 1;
}

sub _pathinfofixer_prerun{
	my $self = shift;
	my $q = $self->query;
	
	# do not redirect in POST
	return unless(lc $q->request_method eq "get");
	
	# check path_info
	my $path_info = $q->path_info;
	my $dispath_path = lc $self->param('CGIAPP_DISPATCH_PATH');
	$path_info =~ s!^/($dispath_path)*/*!!ie;
	return if(length($path_info) > 0);
	
	# The eval may fail, but we don't care
	eval {
		$self->run_modes('_pathinfofixer'=>?&_pathinfofixer);
		$self->prerun_mode('_pathinfofixer');
	};
	
	return 1;
}

1;

CGI::Application::Plugin::DevPopupでCGI::Appの実行情報を出力

CGI::Application::Plugin::DevPopupを使ってみました。
PopupウィンドウにてCGI::Appの実行情報を出力してくれます。
↓こんな感じ。
devpopupimg.png

いつものWWW::OpenSearchのデモで作ってみました。(はてな検索でPerlと検索した結果)

CGI::Application::Plugin::DevPopupの利用はシンプル。

package TestApp::App;
use base qw(CGI::Application);
BEGIN { $ENV{'CAP_DEVPOPUP_EXEC'} = 1; }
use CGI::Application::Plugin::DevPopup;
use CGI::Application::Plugin::DevPopup::Timing;

$ENV{CAP_DEVPOPUP_EXEC}をCGI::Application::Plugin::DevPopupを読み込む前にtrueな値にしておく必要があります。

ちなみにCGI::Application::Plugin::TTの最新版0.09はDevPopupに対応しているので読む込むだけで自動的に処理時間とTTのオプションを表示してくれます。

ソース一式はこちら
情報を追加することもできるので、開発時にData::Dumperの出力先として便利かもしれない。

第三回 検索会議 『Yahoo! HACKS』行きます

第三回 検索会議 『Yahoo! HACKS』行きます。京都からなので泊まり。

日付 2005/09/30 (金) 19:15-22:00 (19:00開場)
場所 Yahoo! JAPAN会議室
〒106-6182
東京都港区六本木6-10-1 六本木ヒルズ森タワー


迷わずたどり着けるでしょうか。

2005年09月22日

修学旅行の引率中に旅行業者などから飲酒の接待

修学旅行の引率中に旅行業者などから飲酒の接待ってYahooのニュースにあったけど。

 府教委によると、教諭は今年5月、3年生を引率して長崎県に修学旅行に行った際、白昼、校長が制止するのを聞かず、ハウステンボスで添乗員が購入したビールをコップ4杯飲んだ。また、2日間にわたって宿泊したホテルの社長の誘いを受け、ラウンジやスナックをはしごして飲食の接待を受けた。校長も同行していた。


友人が某旅行代理店だけど京都によく使う酒(以下自主規制
修学旅行はかなりの金額が動きますからね。大変です。

ぱどタウンの部屋ページにJSON

ぱどタウンの部屋ページにJSONで部屋の情報をいくつか埋め込んでみた。

<script type="text/javascript">
var RoomJObj = {
	'address':'A1XXXX',
	'town':'fukuoka',
	'nickname':'ニックネーム',
	'format_address':'タワーBXX階XX号室',
	'town_name':'福岡よかよかタウン'
};
</script>


prototype.jsも読み込んでおいてみた。
JavaScriptはあまり使ってほしくないけど、面白いHackを作ってもらえたらいいかな。
ちなみに、部屋の自己紹介エリアは、基本的に何でも書けるようになっていますが、JavaScriptのdocument.writeとwhile(1)などの無限ループはフィルタしてます。

2005年09月17日

Redirectって相対リンクでもいけるのね。

ずっと絶対リンクでないと動かないものだと思っていたんだけど、違ったようだ。
恥さらしエントリーかもしれないけど、確認の意味も含めて。

#!/usr/bin/perl
use strict;
use CGI;
my $q = CGI->new;
print $q->redirect('hoge.cgi');


だけで同じ階層にあるhoge.cgiへ302 redirectされる。
FirefoxのLive HTTP HeaderでResponse Headerをみると

HTTP/1.x 302 Moved
Date: Fri, 16 Sep 2005 14:35:08 GMT
Server: Apache
Location: hoge.cgi
Connection: close
Transfer-Encoding: chunked
Content-Type: text/plain

Locationがhoge.cgiだけなのでApacheが補完してくれている訳でもなさそう。ちょっと以前はだめだったような気もするし、クライアント側の機能なのかしら。FirefoxとSafariで確認して、wgetでもOK。LWPもソースをみる限り大丈夫そう。大体大丈夫なのかしら。

CGI.pmのperldocには、

You should always use full URLs (including the http: or ftp: part) in redirection requests. Relative URLs will not work correctly.

とあるので絶対リンクを使うことが推奨みたいですが、、むぅ。

相対リンクから絶対リンクへの変換は、URIモジュールを使うと簡単

use URI;
my $uri = URI->new_abs("相対リンク","ベースURI");

CGI.pmと組み合わせたときは、上のhoge.cgiの例でいくと。

#!/usr/bin/perl
use CGI;
use URI;
my $q = CGI->new;
print $q->redirect(
  URI->new_abs('hoge.cgi',$q->url)
);

となります。再度headerを確認すると

HTTP/1.x 302 Moved
Date: Fri, 16 Sep 2005 14:59:50 GMT
Server: Apache
Location: http://example.com/hoge.cgi
Connection: close
Transfer-Encoding: chunked
Content-Type: text/plain

となってLocationが補完されたのが確認できます。

2005年09月16日

CGI::Application::Plugin::Redirect

CGI::Application::Plugin::Redirectが出ていますね。名前から想像する通り、redirectの処理を行ってくれるものです。

package MyApp;
use base qw(CGI::Application);
use CGI::Application::Plugin::Redirect;

sub start {
  my $self = shift;
  return $self->redirect('http://www.example.com/');
}


リダイレクトの相対→絶対への変換はサポートしていないのであまり役に立ちそうもないかなぁと思ってましたが、ところがどっこい。1つ面白い機能がありました。
cgiapp_prerunでのリダイレクト、

package MyApp;
use base qw(CGI::Application);

sub cgiapp_prerun{
  my $self = shift;
  if(なんちゅら){
    $self->header_add(-location =>'http://www.example.com/');
    $self->header_type('redirect');
  }
}

は正しく動作しません。CGI::AppにはSledgeのfinishメソッドのようなものがないので、prerunでredirectの処理をしていても何か工夫をしない限りその後のmodeは普通に動きます。header_type の下にexitを書くという手もprerunがevalの中で実行されているので不可。
CGI::Application::Plugin::Redirectはそのあたりも面倒を見てくれます。ソースをみると、

sub redirect {
    my $self     = shift;
    my $location = shift;

    # The eval may fail, but we don't care
    eval {
        $self->run_modes( dummy_redirect => sub { } );#何もしないmodeを追加
        $self->prerun_mode('dummy_redirect');#prerunの中でprerun_modeを利用してmodeを切り替えられる
    };

    $self->header_add( -location => $location );
    $self->header_type('redirect');
    return;
}

evalのコードの中で、dummy_redirectというrun_modeを設定して、prerun_modeにそのmode名を入れてます。こうすることでredirect後の動作が、何もしないダミーになるのでよけいなことをする心配がなくなります。

相対URLから絶対URLへの変換がないので、このモジュールは若干使いにくいですが、このテクニックは結構便利かもしれない。

2005年09月15日

XML::Simpleで変換したPerlのデータ構造を一気に文字コード変換

XML::Simpleで変換したPerlのデータ構造を一気に文字コード変換するかなり荒っぽい方法。

$xmlにXMLデータが入っているとして、
use XML::Simple;
use Data::Dumper;
my $ret = eval{
  my $ref=XML::Simple::XMLin($xml);
  my $VAR1=Data::Dumper::Dumper($ref);
  #$VAR1= pack('C0A*',$VAR1);#Perl 5.6以下のUTF-8フラグを外す場合
  return eval(Jcode->new($VAR1)->euc);
}


XMLに何が入っているかわからないと危険が伴う、諸刃の剣。素人にはお薦め出来ない(w

2005年09月14日

Flash Player 8

でました。Flash Player 8。インストールしてみませう。いまのところ問題なしです。
Macromediaが新機能体験ページを用意してます。demoの一番上の、rendering performanceには素直に驚きます。描画にいままでより無茶ができそうだ。

Studio8の日本語版はいつ出るのかなぁ。

2005年09月13日

Tokyo Bossa Nova~Outono~

残暑は相変わらず厳しいですが夏も終わったというのにHappiness Recordsのページを観ていたら欲しくなったので購入。

Tokyo Bossa Nova~Outono~
Tokyo Bossa Nova~Outono~
posted with amazlet at 05.09.13
オムニバス
インディペンデントレーベル (2004/10/25)
売り上げランキング: 37,312

奥さんがNanoを注文しました。Shuffleユーザの僕も欲しい。

2005年09月12日

Regexp::Trieにさわってみた

にわかににぎわっているはてなキーワードを高速に付与なのですが、dankogaiさんのRegexp::Trieをちょっとさわってみた。

Trieを利用したRegexpのオプティマイズという理解で間違っていないですよね。

#キーワードリスト
my @src = qw(1U 2ch amazon apache apple atom blog cdbi CentOS cgiapp colinux cpan csrf css dashboard db firefox flash foaf ftp google hacker hard httpd intrablog ipod);
my $rt = Regexp::Trie->new();
map{$rt->add($_)} @src;
my $regexp = $rt->as_regexp;
print $regexp,"?n";

とすると、

(?-xism:(?:1U|2ch|CentOS|a(?:mazon|p(?:ache|ple)|tom)|blog|c(?:dbi|giapp|olinux|pan|s(?:rf|s))|d(?:ashboard|b)|f(?:irefox|lash|oaf|tp)|google|h(?:a(?:cker|rd)|ttpd)|i(?:ntrablog|pod)))  

こういう正規表現が得られる。使う時は、

#キーワードの前後に「"」をつける
$text =~ s/$regexp/"$&"/go;


これのソースをみていて、やっぱりすげぇなぁと思った。

sub add{
    my $self = shift;
    my $str  = shift;
    my $ref  = $self;
    for my $char (split //, $str){
        $ref->{$char} ||= {};
        $ref = $ref->{$char};
    }
    $ref->{''} = 1; # { '' => 1 } as terminator
    $self;
}

なにげないように見える上のコードなんだけど。
この部分だけで動くようにしてみると、


$ perl -e '
> use Data::Dumper;
> my $self = {};
> my $ref = $self;
> foreach my $char (split //,"perl"){
> $ref->{$char} ||= {};
> $ref=$ref->{$char};
> }
> $ref->{""}=1;
> print Dumper($self);
> '
$VAR1 = {
          'p' => {
                   'e' => {
                            'r' => {
                                     'l' => {
                                              '' => 1
                                            }
                                   }
                          }
                 }
        }; 

こうなる。
これがなぜこうなるのかがすぐに分からなくて悩んだ。$refだけを見ているとわからない。リファレンスと$selfの動きをちゃんと追って行けばよかった。

こんな作り方(コード)ができるようになりたい。

2005年09月08日

PATH_INFOと相対パス(リンク)

おまえのブログさんのエントリーCGI::Application::Dispatch勉強中その2

でも、CGI::Application::Dispatchを使う場合は、PATH_INFO形式を利用することが前提なうえ、URIが全部、
 http://example.com/dispatch.cgi/モジュール名/Runモード
な感じになります。階層が全部一緒です。こうなると、今までの「URIの階層=ファイルのありか」という方法でテンプレートを並べて、リンクURIを相対パスで書く、というのが不便になりました。URIたびたび間違うし…。


これは僕も悩みました。あとでPATHが変更になりそうなときには絶対パス・リンクは使いづらいですし、Dreamweaverでも作成しにくい。なので最近作ったCGI::Application::Dispatchを利用したアプリではテンプレートの在処を以下のようにしてみました。

~/lib     -- モジュール類
~/html --  app.cgi
             |-  tmpl -- app名 -- テンプレートファイル1
             |                             |-テンプレートファイル2
             |- css
             |- js
             |- img/画像など

テンプレートのファイルをapp.cgiから2つ階層を下に配置することでcssや画像などの素材へのリンクを「../../」(app.cgiの階層)と相対パス(リンク)で書けるようにしました。ローカルでも同じ環境にしておけばDreamweaver等のツールでも編集がスムーズに可能っす。

それと、アプリケーションで出力されたHTML内でのパスの問題は、
 http://example.com/dispatch.cgi
 http://example.com/dispatch.cgi/
 http://example.com/dispatch.cgi/モジュール名
 http://example.com/dispatch.cgi/モジュール名/
 http://example.com/dispatch.cgi/モジュール名/Runモード
この5つのURLで出てくるページが同じだというところだと思う。出てきてしまうことが問題なら出てこないようにしてしまえば良いと思ってリダイレクトで対応。CGI::AppアプリケーションのBaseクラスにでも、

package MyApp;
use strict;
use base qw(CGI::Application);

sub redirect_dispatch{
	my ($self,$rmode,$query_string) = @_;
	my $q = $self->query;
	
	if($rmode !~ qr{^/}){
		my $module = lc $self->param('CGIAPP_DISPATCH_PATH');
		$rmode = "/$module/$rmode";
	}
	my $baseurl = $q->url();
	$baseurl .= $rmode;
	$baseurl .= '?' . $query_string if $query_string;
	$self->header_type('redirect');
	$self->header_props(-url=>$baseurl);	
}

これを追加。
アプリケーションクラスで

package MyApp::App;
use strict;
use base qw(MyApp);
sub setup{
	my $self = shift;
	$self->start_mode('index');
}

#本当のstart_modeへリダイレクト
sub dispatch_index{
	return shift->redirect_dispatch('start');
}

sub dispatch_start{
	#本当のstart_mode
}

こんなようにしておけば相対パス・リンクで迷うことはないと思われ。

redirect_dispatchはこのPATH補正でけではなく別のrun_modeへの移動一般で使えます。

redirect_dispatch('Runモード');

これは同じモジュールのRunモードへリダイレクトします。

redirect_dispatch('/モジュール/Runモード');

頭に「/」をつけて書くと指定モジュールのRunモードへリダイレクト。2つ目の引数にはquery_stringへ入れる文字列が「param=value¶m=value」で書けます。

このメソッドは一般化が難しいかなぁと思うのでプラグインとしては作成してなかったりします。

2005年09月07日

HTML::Prototypeを使ったauto complete field

HTML::Prototypeを使ったauto complete fieldをCGI::ApplicationCGI::Application::Plugin::HTMLPrototypeを利用して組んでみた。候補データの文字化け対策も。

HTML::Prototype説明は、mizzy.orgさんのエントリが詳しい。
すでに珍しくもないauto completeの動作サンプルは以下
http://nomadscafe.jp/test/autocompletefield/app.cgi/
市区町村名を途中まで入力すると候補がでてくる。

CGI::Applicationで

use base qw(CGI::Application);
use CGI::Application::Plugin::TT;
use CGI::Application::Plugin::HTMLPrototype;

としてTTとHTMLPrototypeプラグインを利用します。

上の入力フォームのあるページは、

$self->tt_process('index.tmpl.html',{proto=>$self->prototype});

な感じで出力します。方法はなんでも。テンプレートにはJavaScriptのコードを書き出す部分をいくつか追加。headの中に

<head>
...
[% proto.define_javascript_functions %]
[% proto.auto_complete_stylesheet %]
...
</head>

フォームの部分は

<input name="textf" type="text" id="textf" size="20" autocomplete="off">
<div id="textf_auto_complete" class="auto_complete"></div>
[% proto.auto_complete_field('textf',{url=>'autocompresults'}) %]

このdivの中に候補が描画されます。3行目はまたJavaScriptのコードを書き出す部分で、

<script type="text/javascript">
new Ajax.Autocompleter( 'textf', 'textf_auto_complete', 'autocompresults',{  })
</script>

になります。3つ目の引数がオートコンプリートのデータを返すURLで今回の/test/autocompletefield/app.cgi/の相対パスの/test/autocompletefield/app.cgi/autocompresultsにアクセスします。表示の方はこれで完了。

オートコンプリートのデータは、

<ul>
<li>候補1</li>
<li>候補2</li>
<li>候補3</li>
</ul>

という形式で返すのですが、HTML::Prototypeにはauto_complete_resultというメソッドが用意されていて、配列を渡すと上の形式に整えてくれるのですが、これがうまく動いてくれません。マルチバイト文字が化けてしまいます。「候補1」が&aring;&#140;&#151;&aelig;&micro;&middot;&eacute;&#129;&#147;のように変にエンコードされてしまう。HTML::Prototypeの中でHTML::Elementを利用しているのでHTML::Elementの問題かもしれない。Perl 5.8ならうまく行くのかなぁ。。
なのでこの部分を自分で書き直した。@retが候補の配列として、生に返す

return join("?n","<ul>",map{"<li>$_</li>"} @ret,"</ul>");

これはSafari以外ではOKでした。Safariに対応させるためには、HTML::ElementがエンコードをしているのをヒントにしてHTML::Entities::Numberedで変換してみたらOKでした。

return join("?n","<ul>",map{"<li>" . HTML::Entities::Numbered::name2hex($_) . "</li>"} @ret,"</ul>");

Macでは日本語変換のタイミングであまり気分よく候補がでませんが、文字化けもないので使えるようになりました。

ソースはここからみれます。

auto completeってデモには良いけど実際使い道があまりないなぁ。

2005年09月01日

Class::DBIで複数データベースを扱う+register_cleanup

Class::DBIで同じ構造の複数データベース扱う時には、まかまかさんのClass::DBI::Plugin::MultiDatabases(後で知った)や、Class::DBIのWikiにあるけど、さらにmod_perl上でのTips

ちょっと実際書いたコードと違うので全くこの通りでうごくかどうか心配なのですが、複数データベースに接続をするモジュールを下のように書いてみる。

package Object;

use strict;
use DBI;
use base qw(Class::DBI);
use Class::DBI::Plugin::NoCache;
use MyConfig;#データベースの接続情報を返すモジュールとする

__PACKAGE__->mk_classdata('dbhandles',{});
__PACKAGE__->mk_classdata('dbh_key');
__PACKAGE__->nocache(1);

sub change_db{
	my $class = shift;
	return Object->dbh_key(@_);
}

sub db_Main{
	my $proto = shift;
	my $self = ref($proto) || $proto;
	
	my $dbhandles = Object->dbhandles;
	my $key = $self->dbh_key;
	$key ||= "キーのデフォルト";
	
	return $self->_croak("Could not get dbh_key") unless $key;
	
	return $dbhandles->{$key} if($dbhandles->{$key});
	
	#MyConfigはデータベースの接続情報を返す
	my $confing=MyConfig->new($key)
		or return $self->_croak("Could not get dbh config");
		
	my $dbh = DBI->connect_cached(
		"dbi:mysql:".$config->dsn.":".$config->dbhost,
		$config->dbuser,$config->dbpass,
		{$self->_default_attributes}
	) or return $self->_croak("Could not connect to database");
	
	$dbhandles->{$key}=$dbh;
	Object->dbhandles($dbhandles);
	
	return $dbh;
}

1;

Cacheのこともあるので、Class::DBI::Plugin::NoCacheも使用してます。
これでこのモジュールを継承して使用します

package Object::CD;

use strict;
use base qw(Object);

__PACKAGE__->table('cds');
__PACKAGE__->column(All => qw/cdid title artist/);
__PACKAGE__->has_many(tracks => 'Object::Track');

package main;

Object::CD->change_db('dbA');
my $cd = Object::CD->retrieve(123);
my $tracks = $cd->tracks;

Object::CD->change_db('dbB');
Object::CD->retrieve_all();

たぶん、これはまとも動いてくれると思います。has_many、has_aも正しく動くでしょう。
けどこれを、mod_perl環境でうごかすと、

最初のアクセスで、

Object::CD->change_db('dbA');
my $cd = Object::CD->retrieve(123);
my $tracks = $cd->tracks;

としてしまうと、以降のアクセスで、デフォルトのDBを使いたくても、

my $cd = Object::CD->retrieve(123);
my $tracks = $cd->tracks;

としてしまったときに、デフォルトではなく、dbAが返ってくる(ことがある)ようになってしまいます。
dbh_keyをObjectモジュールのClassDataに保存してますから、グローバルな値として次のリクエストでも使われてしまうのです。

対策として、

Object::CD->change_db('デフォルトのキー');

を必ず入れる。例えば、CGI::Appのprerunなどに挿入しておけばOKです。もしくは、ApacheのCleanupHandlerを利用する手もあります。CleanupHandlerはリクエストのトランザクション終了後に呼び出される後処理Handlerで、register_cleanup()で登録をすることができます。これを使います。上記のchange_dbを以下のようにします。

sub change_db{
	my $class = shift;
	if(@_ > 0 && exists $ENV{MOD_PERL}){
		#classdataのdbh_keyを保持してしまうので、cleanup handlerで消す。
		#CGI.pmのソースが参考になる
		require Apache;
		my $r = Apache->request;
		$r->register_cleanup(sub{
			Object->dbh_key(0);
		});
	}
	return Object->dbh_key(@_);
}

リクエストの処理終了後に、dbh_keyに「0」をいれることで、値をresetしています。
mod_perl2への対応等はCGI.pmのソースをみるのがよさそうです。CGI.pmもglobalな変数の片付けをregister_cleanupを利用して行ってました。

Class::DBIとTemplate-Toolkitでマジ生産性あがりました。Apacheのプロセスのメモリサイズも増えそうだけど。バナーの管理ページ7つ分。10日間で完了。