だいたい193日前に更新最終更新日時: 2010-02-28 (日) 17:01:04 193日前
現在の位置
FrontPage > Perl > フレームワーク(MVC) > Sledge > Apache2(mod_perl2)+UTF8
SledgeのApache2(mod_perl2)対応+UTF8 †
Sledgeをmod_perl2に対応させ、且つUTF8にも対応させます。
Sledge自体はCompatを通さず、mod_perl2のみを利用し、UTF8コードを前提としています。
既存部分からの変更点 †
SledgeのUTF8化について †
- Bundle::Sledge::I18Nをインスパイアし、Apache2に対応した環境を作ります。
Apache2の対応について †
Dispatcherについて †
- Sledge::Dispatcherを元にApache2(mod_perl2)のAPIに対応させます。
使い方 †
mod_perl2設定例 †
httpd.conf †
<Location /> SetHandler perl-script PerlResponseHandler Sledge::Dispatcher::Apache2::Properties PerlSetVar SledgeMapFile /path/to/map.props </Location>
startup.plはApache1の書式をそのまま踏襲 (PerlPostConfigRequire?で読み込むとうまいこといかなかったので。)
PerlRequire /path/to/app/conf/startup.pl <Perl> BEGIN { use lib qw(/path/to/app/lib); } </Perl>
- startup.plの詳細については
iandeth. - モジュールをuseした際のメモリ使用量(増加量)を調べてみる を参照。
- startup.pl時の動的モジュール読み込みについては
startup.plに書いておいた方が良い事。(マツモブログ) を参照。
WebアプリケーションのPagesクラス †
既定クラスをSledge::Pages::Apache2::I18Nに設定します。
※Compatではないので、ソースコードレベルでmod_perl2での動作が前提になります。
package App::Pages; use utf8; use strict; use warnings; use base qw(Sledge::Pages::Apache2::I18N); use Sledge::Authorizer::Null; use Sledge::Charset::UTF8::I18N; use Sledge::SessionManager::Cookie; use Sledge::Session::Memcached::Fast; use Sledge::Template::TT::I18N; use Template::Stash::ForceUTF8; ・ ・ ・
ソースコード †
Apache2のAPIに対応させている以外の部分は既存のコードを利用しています。
Sledge::Pages †
Sledge::Pages::Apache2::I18N †
Apache->request
は
Apache2::RequestUtil->request
に変更になっている。
package Sledge::Pages::Apache2::I18N; use utf8; use strict; use warnings; use vars qw($VERSION); $VERSION = '0.01'; use base qw(Sledge::Pages::Base); use Sledge::Request::Apache2::I18N; use Apache2::RequestUtil; sub create_request { my($self, $r) = @_; return Sledge::Request::Apache2::I18N->new($r || Apache2::RequestUtil->request); } 1;
Sledge::Request †
Sledge::Request::Apache2::I18N †
package Sledge::Request::Apache2::I18N; use utf8; use warnings; use strict; use vars qw($VERSION); $VERSION = '0.01'; use base qw(Class::Accessor::Fast); __PACKAGE__->mk_accessors(qw(req)); use vars qw($AUTOLOAD); use Sledge::Request::Apache2::I18N::Upload; use Apache2::Request; use Apache2::Upload; use Encode; sub new { my($class, $r) = @_; bless { req => Apache2::Request->new($r) }, $class; } sub upload { my $self = shift; Sledge::Request::Apache2::I18N::Upload->new($self, @_); } sub param { my $self = shift; if ( @_ == 0) { return map { $self->_decode_param($_) } $self->req->param; } elsif ( @_ == 1) { my @value = map { $self->_decode_param($_) } $self->req->param($_[0]); return wantarray ? @value : $value[0]; } else { my ($key, $param) = @_; if (ref $param eq 'ARRAY') { $param = [map { $self->_encode_param($_) } @$param]; return $self->req->param( $key, $param); } elsif ( ! ref $param ) { return $self->req->param($_[0], $self->_encode_param($_[1])); } else { return $self->req->param(@_); } } } sub _decode_param { my ($self, $val) = @_; return Encode::is_utf8($val) ? $val : Encode::decode('utf-8', $val); } sub _encode_param { my ($self, $val) = @_; return Encode::is_utf8($val) ? Encode::encode('utf-8', $val) : $val; } sub send_http_header { my $self = shift; my $type = shift; $self->req->content_type($type) if($type); } sub header_in { my $self = shift; $self->req->headers_in->get($_[0]); } sub header_out { my($self, $key, @v) = @_; if($key eq 'Content-Length'){ $self->req->set_content_length(shift @v); }elsif($key =~ /^(?:Set-Cookie|Location)$/){ $self->req->err_headers_out->add($key => $_) for @v; }elsif($key ne 'Content-Type'){ $self->req->content_type(shift @v); }else{ $self->req->headers_out->add($key => $_) for @v; } } sub DESTROY { } sub AUTOLOAD { my $self = shift; (my $meth = $AUTOLOAD) =~ s/.*:://; $self->req->$meth(@_); } 1;
Sledge::Request::Apache2::I18N::Upload †
package Sledge::Request::Apache2::I18N::Upload; use utf8; use warnings; use strict; use vars qw($VERSION); $VERSION = '0.01'; use base qw(Class::Accessor::Fast); __PACKAGE__->mk_accessors(qw(upload)); use vars qw($AUTOLOAD); sub new { my $class = shift; my $r = shift; my @upload = $r->req->upload(@_); my @list; for (@upload) { next unless $_->size; my $self = bless {upload => $_}, $class; push @list, $self; } return wantarray ? @list : shift @list; } sub DESTROY { } sub AUTOLOAD { my $self = shift; (my $meth = $AUTOLOAD) =~ s/.*:://; $self->upload->$meth(@_); } 1;
Sledge::Dispatcher †
Sledge::Dispatcher::Apache2 †
ほとんどがSledge::Dispatcherのコードのママなのですが
Apache2の定数に書き換えや、handlerの記述をApache2の方式に変更しています。
package Sledge::Dispatcher::Apache2; use strict; use warnings; use vars qw($VERSION); $VERSION = 0.01; use Apache2::Const -compile => qw(OK DECLINED); use Apache2::Log; use File::Basename; use Sledge::Exceptions; use vars qw($DEBUG); $DEBUG = 0; my %loaded; sub debug { my ($r, $args) = @_; chomp($args); $r->log->warn($args) if $DEBUG; } sub _load_module { my($class, $r, $module) = @_; debug($r, "loading $module"); return if $loaded{$module}; no strict 'refs'; eval "require $module"; if ($@ && $@ !~ /Can't locate/) { debug($r, "error loading $module: $@"); die $@; } elsif ($@) { debug($r, "erorr loading $module: $@"); } $loaded{$module} = 1; } sub null_method { } sub determine { my($class, $r) = @_; # we can ignore extensions! my $ext = $r->dir_config('SledgeExtension') || '.cgi'; # for static .html my $static = $r->dir_config('SledgeStaticExtension') || '.html'; # determine directory and page name my($page, $dir, $suf) = File::Basename::fileparse($r->uri, $ext, $static); # don't match with $ext and $static if (index($page, '.') >= 0) { #debug($r, "$page doesn't match with $ext and $static"); debug($r, "$page doesn't match with ".$static); return; } # <Location /foo>: /foo/bar => /bar (my $location = $r->location) =~ s!/$!!; $dir =~ s/^$location// if $location; $dir =~ s!/$!!; # remove trailing slash my $loadclass = $class->do_determine($r, $dir); return $loadclass, $page, $suf eq $static, ($page eq '' && $suf eq ''); } sub handler : method { my($class, $r) = @_; ## $r equal Apache2::RequestUtil->request my($loadclass, $page, $is_static, $slash) = $class->determine($r); unless ($loadclass) { debug($r, "Can't determine loadclass"); return Apache2::Const::DECLINED; }; debug($r, "loadclass is $loadclass, page is $page"); $class->_load_module($r, $loadclass); my $no_static = uc($r->dir_config('SledgeDispatchStatic') || 'On') eq 'OFF'; if ($is_static && !$class->_generated($loadclass, $page)) { debug($r, 'static method, but not yet auto-generated'); if ($no_static || $loadclass->can("dispatch_$page")) { debug($r, "dispatch_$page exists, but access is $page.html"); return Apache2::Const::DECLINED; } else { $class->_generate_method($r, $loadclass, $page); } } elsif ($slash) { my @indexes = $r->dir_config('SledgeDirectoryIndex') ? split(/\s+/, $r->dir_config('SledgeDirectoryIndex')) : 'index'; debug($r, "indexes: ", join(",", @indexes)); for my $index (@indexes) { if ($loadclass->can("dispatch_$index")) { debug($r, "$loadclass can do $index"); $page = $index; last; } } $page ||= $indexes[0]; debug($r, "page is $page"); if (!$loadclass->can("dispatch_$page")) { if ($no_static) { debug($r, "access to slash, but no_static is on"); return Apache2::Const::DECLINED; } $class->_generate_method($r, $loadclass, $page); } } elsif (!$is_static && $class->_generated($loadclass, $page)) { debug($r, "access to dynamic after static method $page made"); return Apache2::Const::DECLINED; } unless ($loadclass->can("dispatch_$page")) { debug($r, "$loadclass can't do $page"); return Apache2::Const::DECLINED; } debug($r, "ok now loading $loadclass - $page"); $loadclass->new->dispatch($page); return Apache2::Const::OK; } my %generated; sub _generate_method { my($class, $r, $loadclass, $page) = @_; debug($r, "generating $page on $loadclass"); no strict 'refs'; if (-e $loadclass->guess_filename($page)) { *{"$loadclass\::dispatch_$page"} = \&null_method; $generated{$loadclass, $page} = 1; } } sub _generated { my($class, $loadclass, $page) = @_; return $generated{$loadclass, $page}; } sub do_determine { Sledge::Exception::AbstractMethod->throw } 1;
Sledge::Dispatcher::Apache2::Properties †
ベースになるモジュールの変更や、APIをApacheからApache2の呼び出し方式に変更をしています。
package Sledge::Dispatcher::Apache2::Properties; use strict; use warnings; require Sledge::Dispatcher::Apache2; use base qw(Sledge::Dispatcher::Apache2); use Apache2::ServerUtil; use Data::Properties; use FileHandle; use UNIVERSAL::require; my %Cache; sub load_property { my($class, $r, $path) = @_; if (!$Cache{$path} || ($class->_reload($r) && ($Cache{$path}->[1] < _mtime($path)))) { my $props = Data::Properties->new; my $handle = FileHandle->new($path) or Sledge::Exception::PropertiesNotFound->throw("$path: $!"); $props->load($handle); $class->init_modules($props); $Cache{$path} = [ $props, _mtime($path) ]; } return $Cache{$path}->[0]; } sub _reload { my($class, $r) = @_; my $reload = $r->dir_config('SledgeMapReload'); return !(defined $reload && uc($reload) eq 'OFF'); } sub init_modules { my($class, $props) = @_; for my $name ($props->property_names) { my $module = $props->get_property($name); $module->require or die $UNIVERSAL::require::ERROR; } } sub _mtime { (stat(shift))[9] } sub do_determine { my($class, $r, $dir) = @_; # load property file my $map_path = $r->dir_config('SledgeMapFile') or Sledge::Exception::MapFileUndefined->throw; my $props = $class->load_property($r, Apache2::ServerUtil::server_root_relative($r->pool, $map_path)); return $props->get_property($dir) || $props->get_property("$dir/"); } 1;
mod_perl2のリンク集 †
ドキュメント †
- おいぬま日報(不定期) - Apache2 + mod_perl2.0.1 + Sledge-1.11
- SledgeをApache2で動かした方
- mod_perl 2.0 Documentation(英語)
- 数少ないmod_perl2のドキュメント。mod_perl1とのAPIでの相違点などを調べる
- mod_perl クイックリファレンス
- こちらは日本語版。mod_perl1と2の相違点などが明確。
- mod_perl環境下による高速化 SourceForge?.JP
参考リンク †
- mod_perl2 インストール
- Apache2のhttpd.conf周りの設定が詳しい
- MENTA(mod_perl2に対応しました)
- handerに渡しているので、コードを読むと勉強になります。
- 10分で完了、mod_perl 2.0 で Hello, World! (naoyaのはてなダイアリー)
- コンテンツハンドラを作るまでの流れ。
- mod_perl 2.0.4 httpd.conf 設定メモ
- mod_perl 2.0 の Server Life CycleCommentsAdd Star
- mod_perl2の設定についての詳細
- Perlを最適化する - コードから、できる限り余分なものを削り取る
- http://www.ibm.com/developerworks/jp/linux/library/l-optperl/
- mod_perl に限った話しではありませんが、PerlでのWebアプリを作るという部分で有用なTIPSが多いです。
- 関連ページ
ツールボックス
メニュー
最新の20件
最新の20件
2010-09-05
2010-09-01
2010-07-31
2010-07-27
2010-07-26
2010-04-23
2010-04-07
2010-04-04
2010-04-03
2010-03-31
2010-03-20
2010-03-19
2010-03-02
2010-02-28

