« CGI::Application::Plugin::DevPopupでCGI::Appの実行情報を出力 | メイン | サマータイムマシンブルース »

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;