Home > perl Archive
perl Archive
Template::Stash::Filters(TTのStashで複数のfilterを実行)
- 2007-06-18 (月)
- perl
前回のエントリーでTemplate::Stash::EscapeHTMLByCaseというのを作ったわけですが、こうやっていろいろStashで対応しようとすると、Template::Stash::ForceUTF8も使ってるから使えない～とかが発生する。
というのも、TTのSTASHは一つのObjectしか渡せないからだ。これには多分いろいろ理由があって、Template::Stash::Contextのようにgetのアルゴリズム自体に手を入れてる場合どうすんの？ってことだからだと思う。
ただ、EscapeHTMLByCaseやForceUTF8なんかのように単にfilterを掛けたいだけであれば繋げたい。
というわけでTemplate::Stash::Filters作ってみました。
package Template::Stash::Filters;
use strict;
use Template::Config;
use base ($Template::Config::STASH);
our $VERSION = '0.01';
sub get {
my ($self, @args) = @_;
PRE_PROCESS:
foreach my $filter (@{$self->{FILTERS}}) {
if (!$filter->can('pre_process')) {
next PRE_PROCESS;
}
$filter->pre_process(@args);
}
my $var = $self->SUPER::get(@args);
FILTER:
foreach my $filter (@{$self->{FILTERS}}) {
if (!$filter->can('filter')) {
next GET;
}
$var = $filter->filter($var);
}
return $var;
}
1;
__END__
Template::Stash::XXX系のモジュールを再利用できたらいいんだろうけど、$self->SUPER::getをhackする方法が分らなかったのでFilter実装モジュールも車輪の再発明。
Template::Stash::Filters::EscapeHTMLByCase
package Template::Stash::Filters::EscapeHTMLByCase;
use strict;
our $VERSION = '0.01';
use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(is_raw));
sub pre_process {
my ($self, $args) = @_;
if (is_this_raw(@{$args})) {
$self->is_raw(1);
strip_raw_specifier($args);
}
else {
$self->is_raw(0);
}
}
sub filter {
my ($self, $var) = @_;
if ($self->is_raw || ref $var) {
return $var;
}
return html_filter($var);
}
sub html_filter {
my $text = shift;
for ($text) {
s/&/&/g;
s/</&;t;/g;
s/>/>/g;
s/"/"/g;
}
return $text;
}
sub is_this_raw {
my @args = @_;
if (ref $args[0] ne 'ARRAY') {
return 0;
}
if ($args[0]->[0] ne 'RAW') {
return 0;
}
return 1;
}
sub strip_raw_specifier {
my $args = shift;
splice @{$args->[0]}, 0, 2;
}
1;
pre_processを活用してます。
Template::Stash::Filters::ForceUTF8
package Template::Stash::Filters::ForceUTF8;
use strict;
our $VERSION = '0.01';
use base qw(Class::Accessor);
use Encode;
sub filter {
my ($self, $var) = @_;
return $var if ref $var;
Encode::_utf8_on($var) unless Encode::is_utf8($var);
return $var;
}
1;
__END__
で、使い方はこんな感じ
use Template;
use Template::Stash::Filters;
use Template::Stash::Filters::EscapeHTMLByCase;
use Template::Stash::Filters::ForceUTF8;
my $template = Template->new({
STASH => Template::Stash::Filters->new(
FILTERS => [
Template::Stash::Filters::ForceUTF8->new,
Template::Stash::Filters::EscapeHTMLByCase->new,
],
),
});
うーん、newへの引数が無いモジュールばっかなのでTemplate::Stash::Filters::がうっとうしいなぁ。useするのも面倒だし勝手にuseしちゃう方式つくってみるかなぁ。
まぁまた時間があったときにでも。
- Comments: 0
- Trackbacks: 0
Template::Stash::EscapeHTMLByCase(TTでXSS対策)
- 2007-06-15 (金)
- perl
TTでのXSS対策としては下記の2つの方法がまずは考えられます。
1. [% data | html %]のようにFILTERをすべての変数出力部分に使う
2. Template::Stash::EscapeHTMLを使って自動的に全ての変数出力をEscapeする
1は毎回”| html”と書くことになるので、間違いが置きやすいので2を使うことが多いのですが
システム側からescapeしないで出力したいとか、INCLUDEで変数を渡したいとかいうときに問題がでてしまう。
INCLUDEの話はどういうことかというと
たとえば、ヘッダーをheader.ttというファイルにまとめて共有で使っており
渡された変数を用いてタイトルを構成するときなんかがあったとする。
(ちなみにMETAだと変数は渡せない）
content.tt
[% INCLUDE header.tt
title = title_html
%]
header.tt
<html>
<head>
<title>[% title %]</title>
</head>
<body>
まぁこんな構成で下記のように呼び出したとする
#!/usr/bin/perl
use strict;
use Template;
use Template::Stash::EscapeHTML;
my %var = (
title_html => ‘<html>’,
);
my $template = Template->new({
STASH => Template::Stash::EscapeHTML->new(),
});
$template->process(’content.tt’, \%var);
そうするとこれの実行結果は
<html> <head> <title>&lt;html&gt;</title> </head> <body>
となってしまう。
これは意図した結果ではなく正しくは
<html> <head> <title><html></title> </head> <body>
となってほしいわけですね。
二重にEscapeされてしまう。
これは、STASHのgetは変数の代入の時にも呼ばれている影響です。
代入する度にEscapeされるわけでINCLUDEしなくても単純に
[% title = title_html %]
[% title %]
このようにしていてもやはり同じ問題は起きてしまう。
というわけで、escapeしないことを明示的に指示することをしたい。
こうなってくると最初の1の方法の”| html”でも同じじゃないかと思われるかもしれないが
Order allow, deny
より
Order deny, allow
(Apache用語)
のほうがセキュリティ上は好ましいし、何よりコード量も減る。
で、Template::Stash::EscapeHTMLByCaseってのを作ってみた。
命名はまずいかもしれない。
package Template::Stash::EscapeHTMLByCase;
use strict;
use Template::Config;
use base ($Template::Config::STASH);
our $VERSION = '0.01';
sub get {
my ($self, @args) = @_;
if (is_raw(@args)) {
@args = strip_raw_specifier(@args);
return $self->SUPER::get(@args);
}
my ($var) = $self->SUPER::get(@args);
unless (ref($var)) {
return html_filter($var);
}
return $var;
}
sub html_filter {
my $text = shift;
for ($text) {
s/&/&/g;
s/</</g;
s/>/>/g;
s/"/"/g;
}
return $text;
}
sub is_raw {
my @args = @_;
if (ref $args[0] ne 'ARRAY') {
return 0;
}
if ($args[0]->[0] ne 'RAW') {
return 0;
}
return 1;
}
sub strip_raw_specifier {
my @args = @_;
splice @{$args[0]}, 0, 2;
return @args;
}
1;
使い方はこんな感じにRAWを最初につけてあげる。
content_kai.tt
[% INCLUDE header.tt
title = RAW.title_html
%]
そうすると期待通りに下記の文字列が出力される。
<html> <head> <title><html></title> </head> <body>
と、こんなことをやってみましたが皆さんはこんな状況をどうしてるもんなんでしょ
それ、TemplateToolkitの標準機能で解決できるよ。とかありそうだけど・・・。
なかったらCPANに上げてみたいなぁ（まだCPAN Authorじゃない・・・）とか。
- Comments: 0
- Trackbacks: 1
Encode::JP::Mobile::Vodafone関連の不具合の修正パッチ
- 2007-06-10 (日)
- perl
今日書いたばかりの
Encode::JP::Mobileにvodafoneの絵文字相互変換させるパッチ達
に早速不具合発見。
aliasの張り方を間違って(define_aliasが反対だった)shift_jis-softbank-privateが使えてなかったです。
そのパッチがこれ。
diff -ruN Encode-JP-Mobile-0.05.org/lib/Encode/JP/Mobile.pm Encode-JP-Mobile-0.05/lib/Encode/JP/Mobile.pm
--- Encode-JP-Mobile-0.05.org/lib/Encode/JP/Mobile.pm 2007-06-10 19:53:57.000000000 +0900
+++ Encode-JP-Mobile-0.05/lib/Encode/JP/Mobile.pm 2007-06-10 19:49:52.000000000 +0900
@@ -9,7 +9,7 @@
define_alias('shift_jis-docomo' => 'shift_jis-imode');
define_alias('shift_jis-ezweb' => 'shift_jis-kddi');
define_alias('shift_jis-airh' => 'shift_jis-airedge');
-define_alias('shift_jis-vodafone-private' => 'shift_jis-softbank-private');
+define_alias('shift_jis-softbank-private' => 'shift_jis-vodafone-private');
use Encode::JP::Mobile::Vodafone;
で、もひとつ。これは自分の修正とは関係ない部分なんですが、Encode::JP::Mobile::Vodafone::_encode_vodafoneのビット演算に
誤りがあって、$highが必ず0xE000になってページ1の絵文字に集約されてしまうというバグが。
というわけで下記が修正パッチです。
diff -ruN Encode-JP-Mobile-0.05.org/lib/Encode/JP/Mobile/Vodafone.pm Encode-JP-Mobile-0.05/lib/Encode/JP/Mobile/Vodafone.pm
--- Encode-JP-Mobile-0.05.org/lib/Encode/JP/Mobile/Vodafone.pm 2007-06-10 19:53:57.000000000 +0900
+++ Encode-JP-Mobile-0.05/lib/Encode/JP/Mobile/Vodafone.pm 2007-06-10 19:45:35.000000000 +0900
@@ -47,7 +47,7 @@
my $res = "x1bx24";
my $buf = '';
for my $str (@str) {
- my $high = ord($str) & 0xF000;
+ my $high = ord($str) & 0xEF00;
my $low = ord($str) & 0x00FF;
if ($buf ne $high) {
$res .= $HighBitToChar{$high};
で、それぞれの修正に対応したテストも書いたので（まとまっちゃってますが）それもおいておきます。
diff -ruN Encode-JP-Mobile-0.05.org/t/Mobile.t Encode-JP-Mobile-0.05/t/Mobile.t
--- Encode-JP-Mobile-0.05.org/t/Mobile.t 2007-05-16 18:46:16.000000000 +0900
+++ Encode-JP-Mobile-0.05/t/Mobile.t 2007-06-10 19:41:34.000000000 +0900
@@ -1,5 +1,5 @@
use strict;
-use Test::More tests => 18;
+use Test::More tests => 42;
use_ok('Encode');
use_ok('Encode::JP::Mobile');
@@ -13,6 +13,20 @@
test_rt("shift_jis-vodafone", "x82xb1x1bx24x47x21x22x0f", "x{3053}x{e001}x{e002}");
test_rt("shift_jis-softbank", "x82xb1x1bx24x47x21x22x0f", "x{3053}x{e001}x{e002}");
+test_rt("shift_jis-vodafone", "x82xb1x1bx24x45x21x22x0f", "x{3053}x{e101}x{e102}");
+test_rt("shift_jis-softbank", "x82xb1x1bx24x45x21x22x0f", "x{3053}x{e101}x{e102}");
+test_rt("shift_jis-vodafone", "x82xb1x1bx24x46x21x22x0f", "x{3053}x{e201}x{e202}");
+test_rt("shift_jis-softbank", "x82xb1x1bx24x46x21x22x0f", "x{3053}x{e201}x{e202}");
+test_rt("shift_jis-vodafone", "x82xb1x1bx24x4fx21x22x0f", "x{3053}x{e301}x{e302}");
+test_rt("shift_jis-softbank", "x82xb1x1bx24x4fx21x22x0f", "x{3053}x{e301}x{e302}");
+test_rt("shift_jis-vodafone", "x82xb1x1bx24x50x21x22x0f", "x{3053}x{e401}x{e402}");
+test_rt("shift_jis-softbank", "x82xb1x1bx24x50x21x22x0f", "x{3053}x{e401}x{e402}");
+test_rt("shift_jis-vodafone", "x82xb1x1bx24x51x21x22x0f", "x{3053}x{e501}x{e502}");
+test_rt("shift_jis-softbank", "x82xb1x1bx24x51x21x22x0f", "x{3053}x{e501}x{e502}");
+
+test_rt("shift_jis-vodafone-private", "x82xb1xf9x41xf9x42", "x{3053}x{e001}x{e002}");
+test_rt("shift_jis-softbank-private", "x82xb1xf9x41xf9x42", "x{3053}x{e001}x{e002}");
+
sub test_rt {
my ( $enc, $byte, $uni ) = @_;
is esc( decode( $enc, $byte ) ), esc($uni), "decode $enc";
一応これはmiyagawaさんにメールしておこうかな。
というかバグ報告なんてわざわざ自分のblogに載せるもんじゃない気がしてきたorz
まぁ今回はvodafone-private追加からの流れなのでいっか…。
CPANのこことかは使われてるもんなのかなぁ。
- Comments: 637
- Trackbacks: 0
Encode::JP::Mobileにvodafoneの絵文字相互変換させるパッチ達
- 2007-06-10 (日)
- perl
はぁー疲れた。
絵文字変換をUnicode::Japaneseをつかってやろうといろいろと試行錯誤してたのですがUnicode私用領域にマップするので4byte文字になってmysqlにbinary型にしないと格納できなかったり:”mysql 13823] MySQLの現行UTF-8の問題とその対処方法について”:http://www.mysql.gr.jp/mysqlml/mysql/msg/13823/ 、softbank(vodafone)のShift_JIS外字にマップされて送信されてくる絵文字:”3GC型端末の中には絵文字を違う形式で送ってくる端末がある(HTML編)”:http://labs.unoh.net/2006/10/softbank.html に対応してなかったりと苦労が多いので、どうせ苦労するならいっそのことと、カッとなってPerl的には由緒正しいであろうEncode::JP::Mobileで挑戦することにした。今は反省している。
Encode::JP::Mobile に i-mode と ezweb 間での絵文字相互変換をさせるパッチ
でi-mode< =>ezwebの相互変換が実装されて本体にもとりこまれてるようなので同じようにVodafoneのShift_JIS外字の絵文字でもやってみるかぁと思ったが結構めんどくさかったのでした・・・。というわけで以下作業メモです。
まぁまずは何はともあれucmファイルを作らないとだよね。ucmファイルって何なのかさっぱり分かってないけど。まぁ見よう見まね。ようはUnicodeと他の文字コードをマッピングするもんでしょ。
とりあえずEncode::JP::Mobileのshift_jis-imode.ucmを参考に。
ふむふむ。id:tokuhiromさんが作ってたのは
# below are KDDI => i-mode pictogram convert map.
この部分ね。
まぁとりあえずそれはおいといて純粋なucmファイルを作りましょう。
SoftBankの技術資料のHTML編の211-222pにその対応表があるんだけど・・・げげっこれテキストコピーできないじゃん。そういう権限設定らしい。
と、ここで2時間ほどはまる。テキストコピーできる表がないかググってみたり、PDFを印刷してOCRにかけてみたり（いまいちな結果だった・・）。最終的にはxdoc2txtの-nオプションとやらで解決しましたが・・・いいんだろうか？
で、まぁできたファイルがこれ。
pre_shift_jis-vodafone-private.ucm
encodeing名はshift_jis-vodafone-privateにとりあえず決定。
さて、元となるucmファイルはできたので次は相互変換分のエントリを作るのですが、せっかくスクリプトを公開してくれていたので
前述のid:tokuhirom氏のrubyスクリプトを使わせてもらうことにする。なので同じように絵文字の相互変換リストのSoftBank → i-mode, EZwebからとってくる。ただし、こいつの2番目の要素は”Webコードの一部”となっていて今回やりたいShift_JIS外字には適さないのでこれをi-modeやezwebと同じようにShift_JISのコードに変換したいんだけど、またこれがちと大変でした。
一応元にしたのは
SoftBank技術資料の絵文字一覧
と先ほどのPDF。PDFのほうにはウェブコードとやらは乗ってないのでUnicodeを経由してウェブコードをShift_JISに変換する。
んで、できたのがこれ。
v(odafone)だのs(oftbank)だのが入り混じっててややこしいですが、まぁ気にしないということで。
で、次はrubyスクリプトのほうに手をいれてみましょう。まぁこんな感じのパッチになりました。
--- make_convert.rb.org 2007-06-10 12:13:31.000000000 +0900
+++ make_convert.rb 2007-06-10 12:15:15.000000000 +0900
@@ -1,18 +1,20 @@
ucm_for = {
:i => 'ucm/shift_jis-imode.ucm',
:e => 'ucm/shift_jis-kddi.ucm',
+ :v => 'ucm/shift_jis-vodafone-private.ucm',
}
map_for = {
:e => 'emoji_e2is.txt',
:i => 'emoji_i2es.txt',
+ :v => 'emoji_v2ie_private.txt',
}
uni2bytes = { :v => {}, :e => {}, :i => {}, :h => {} }
bytes2uni = { :v => {}, :e => {}, :i => {}, :h => {} }
-no2byte = { :e => {}, :i => {} }
-no2no = { :e2i => {}, :i2e => {} }
-name_for = { :i => 'DoCoMo pictogram', :e => 'KDDI/AU Pictogram' }
+no2byte = { :e => {}, :i => {}, :v => {} }
+no2no = { :e2i => {}, :e2v => {}, :i2e => {}, :i2v => {}, :v2i => {}, :v2e => {} }
+name_for = { :i => 'DoCoMo pictogram', :e => 'KDDI/AU Pictogram', :v => 'Vodafone Pictogram' }
ucm_for.each {|carrier, fname|
open(fname) {|io|
@@ -31,18 +33,26 @@
io.readline
io.each {|line|
+ line.chomp!
case carrier
when :e
- # EZwebﾈﾖｹ・Shift_JIS(web/hex) i-mode SoftBank
- eno, byte, ino, sno =line.split(/t/)
+ # EZwebﾈﾖｹ・Shift_JIS(web/hex) i-mode Vodafone
+ eno, byte, ino, vno =line.split(/t/)
no2byte[eno] = byte.gsub(/(..)/) { "x#{$1}" }
no2no[:e2i][eno] = ino
+ no2no[:e2v][eno] = vno
when :i
- # i-modeﾈﾖｹ・Shift_JIS(hex) EZweb SoftBank EZweb(web､ﾇ､ﾎｼｫﾆｰﾊﾑｴｹ)
- ino, byte, eno, sno =line.split(/t/)
+ # i-modeﾈﾖｹ・Shift_JIS(hex) EZweb Vodafone EZweb(web､ﾇ､ﾎｼｫﾆｰﾊﾑｴｹ)
+ ino, byte, eno, vno =line.split(/t/)
no2byte[ino] = byte.gsub(/(..)/) { "x#{$1}" }
no2no[:i2e][ino] = eno
+ no2no[:i2v][ino] = vno
when :v
+ # Vodafoneﾈﾖｹ・Shift_JIS(hex) i-mode EZweb
+ vno, byte, ino, eno =line.split(/t/)
+ no2byte[vno] = byte.gsub(/(..)/) { "x#{$1}" }
+ no2no[:v2i][vno] = ino
+ no2no[:v2e][vno] = eno
else
print "ORZ"
exit
@@ -59,6 +69,8 @@
srccarrier = :i
when 'e'
srccarrier = :e
+ when 'v'
+ srccarrier = :v
end
srccarrier = eval ":#{srccarrier}"
で、これを実行すると[iev]2[iev].txtが6個できるのでそのうちvに関係するものをEncode::JP::Mobileのucmファイルに突っ込む。
shift_jis-vodafone-private.ucmに関してはさっき作ったファイルに追記。
優先順位は基本i-modeを優先としてみた。
あとはテストを書いて、MakeFileに追記していつもの
perl Makefile.pl
make test
make install
して完了。
うまくいきました。
ちょっと気をよくしたので、ついでにshift_jis-vodafoneのほうにも手を加えて相互変換できるようにしてみました。
そんなわけで、Encode::JP::Mobile全体のパッチを以下においときます。
ひとつ気になるのがここ。
+ $str = Encode::decode("shift_jis-vodafone-private", Encode::encode("shift_jis-vodafone-private", $str, $check), $check);
Encode::JP::Mobile::Vodafoneの変更はこんな感じでいいんかなぁ。
とりあえずテストは通ったからいいことにするけど・・・。
もっと良い方法あったら誰か教えてください。
というわけでおしまい。
これに絡むCatalyst回りの話なんかもあるんだけど・・・まぁまた今度時間があったら書きます。
追記
あっ、auとvodafone(softbank)はunicodeのマッピングが一部被ってた。
auを優先にしてみたけど･･･どうするのが正しいのだろうか･･･。
- Comments: 0
- Trackbacks: 1
Catalystで携帯端末ID取得
- 2007-06-07 (木)
- perl
Catalystで携帯の端末IDを取得することになったので
Catalyst::Plugin::MobileUserID
http://d.hatena.ne.jp/fbis/20070506/1178464915
を使うことにする。
しかしまず自分の携帯であるau端末のIDが取れない。
んーなんでだ？と調べてみたところ
に問題がありそう。
下記のコード部分。
$c->req->mobile_agent(HTTP::MobileAgent->new($c->req->user_agent));
HTTP::MobileAgentのインスタンス生成の際の引数は
HTTP::MobileAgent::Request
に直接渡される仕組みになってるんだけど、ここでUserAgentも渡せることになっていて、
その仕組みを利用しているようだけど、これだと他のヘッダが取得できなくなる。
HTTP::Headersも渡せるので、$c->req->headersがそれなのでそいつを渡すように
$c->req->mobile_agent(HTTP::MobileAgent->new($c->req->headers));
に変えてあげればいいのだ。
これでau端末のIDも取れました。
試してないけどj-phone(softbank)もヘッダから取得するので取れてなかったと思う。
以下パッチ
--- MobileAgent.pm.orig Thu Jun 07 19:18:24 2007
+++ MobileAgent.pm.new Thu Jun 07 19:18:48 2007
@@ -6,7 +6,7 @@
use Catalyst::Request;
use HTTP::MobileAgent;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
{
package Catalyst::Request;
@@ -16,7 +16,7 @@
sub prepare_headers {
my $c = shift;
$c->NEXT::prepare_headers(@_);
- $c->req->mobile_agent(HTTP::MobileAgent->new($c->req->user_agent));
+ $c->req->mobile_agent(HTTP::MobileAgent->new($c->req->headers));
}
=head1 NAME
- Comments: 0
- Trackbacks: 0
Perl勉強会
- 2007-06-05 (火)
- perl
プログラム初めてという人にPerlを教える機会を得た。
一緒に「初めてのPerl」を読み進めて例題をやっているだけだけで、
なかなか プログラムの楽しさというのを伝えることができなくてもどかしい。
うーん。どうすれば伝わるのか。
毎日更新を一応続けてはいるがほんとどうでもいいことばかり書いているな。。。
- Comments: 0
- Trackbacks: 0
Home > perl Archive
- Search
- Feeds
- Meta