perlのアーカイブ

CodeReposにDBIx::Class::Tree::NestedSetをコミットしてみた

投稿者: chiba
2007/12/21 金曜日 2:10:30
coderepos | perl

がCodeReposにDBIx::Class::Tree::NestedSetをCommitしてみました。これのアルゴリズムに関しては[mysql 12071] 階層化されたデータをMySQLで扱うを参照ということで省略。ここに書いてあるのと違う点としては、親ノードの付け替え用にmvgフラグを必要としています。(インスパイア From DBIx::OO::Tree)

メソッドはDBIx-Class-Treeを~~パクリ~~準拠していますのでテストも~~パクリ~~準拠してまったく同じ(あ、mvgカラムは追加してるけど)テストを通しています。

あとはDBIx::OO::Tree,DBIx::Tree::NestedSetあたりを~~パクリ~~参考にしてみました。

でもってTODOにも書いてるのですが、rootノード取得用にResultSetManagerなメソッドを生やしたいんですがどうすればいいのかが分からない…。もうちょい調べよう。

あとDBIx-Class-TreeのTODOに

– DBIx::Class::Tree::NestedSet

ってかかれてるんですがこの場合やっぱ空気読んでCPANには上げないほうがいいのでしょうか。まだCPANあげたこともないのでCPANの空気が読めません＞＜

コメント: 0
トラックバック: 0

緯度経度から住所

投稿者: chiba
2007/7/1 日曜日 1:52:05
perl

フレンジャーでは携帯3キャリアすべての簡易位置情報取得（基地局）とGPS位置情報取得に対応しています。

で、DoCoMoのオープンiエリアを除いた5つの形式では緯度経度がとれるのですが、そこから住所文字列に変更してあげています（逆ジオコーディング）。その変換にはinvgeocoderを今までは使わせていただいていました。

ところが、今日埼玉県の秩父群小鹿野にきて位置情報取得すると埼玉県秩父市田村に変換されてしまったんですねぇ。これはまずいなぁということで、いろいろほかに方法がないか調べるとCPANにて以下を発見。

Geo::Coder::YahooJapan::Inverse

Yahooの非公開apiを利用しているようですがきちんと秩父郡小鹿野に変換してくれたのでとりあえずこちらに乗り換えました。

あと、auにて測地系をtokyo指定しておきながら逆ジオコーディング時にwgs84系を利用していたため微妙にずれてたということも発覚。修正しておきました。

いままで精度が悪いなぁと思ってたかた、再度お試しください。
うん。

コメント: 0
トラックバック: 1

Template::Stash::FiltersでTemplate::Stash::Contextを併用する方法

投稿者: chiba
2007/6/20 水曜日 4:14:30
perl

ここの最後のほうで問題にしてた件。

BEGIN {
    $Template::Config::STASH = 'Template::Stash::Context';
};

use Template::Stash::Filters;
use Template::Stash::Filters::EscapeHTMLByCase;
use Template::Stash::Filters::ForceUTF8;

__PACKAGE__->config(
    STASH => Template::Stash::Filters->new(
        FILTERS => [
            Template::Stash::Filters::ForceUTF8->new,
            Template::Stash::Filters::EscapeHTMLByCase->new,
        ],
    ),
);

こんな風にしたらいけそうだと思ってやってみたけど
Template::Stash::Contextで

 Can't locate object method "component" via package "Template::Stash::Filters" at /usr/local/lib/perl/5.8.8/Template/Stash/Context.pm line 627.

こんなエラーが・・・。

で、いいのか悪いのかもあまり深く理解しないまま以下のような修正をTemplate::Stash::Context(VERSION 1.63)に当ててみた。

--- Context.pm.org      2007-06-20 03:02:46.000000000 +0900
+++ Context.pm  2007-06-20 04:07:23.000000000 +0900
@@ -422,7 +422,7 @@
         $rootref = 'ARRAY';
         $root = [$root];
     }
-    if ($rootref eq __PACKAGE__ || $rootref eq 'HASH') {
+    if (eval { $rootref->isa(__PACKAGE__) } || $rootref eq 'HASH') {

        # if $root is a regular HASH or a Template::Stash kinda HASH (the
        # *real* root of everything).  We first lookup the named key
@@ -607,7 +607,7 @@
     return undef                                               ## RETURN
        unless $root and defined $item and $item !~ /^[._]/;

-    if ($rootref eq 'HASH' || $rootref eq __PACKAGE__) {
+    if ($rootref eq 'HASH' || eval { $rootref->isa( __PACKAGE__)}) {
 #      if ($item eq 'IMPORT' && UNIVERSAL::isa($value, 'HASH')) {
 #          # import hash entries into root hash
 #          @$root{ keys %$value } = values %$value;

なんかこれで不具合おきたりするんだろーか。
http://search.cpan.org/src/ABW/Template-Toolkit-2.19/t/stashc.t
このテストはとりあえずパスしたけど。。。

はてなブックマーク - Template::Stash::FiltersでTemplate::Stash::Contextを併用する方法

コメント: 0
トラックバック: 0

それTemplate::Stash::Contextで

投稿者: chiba
4:00:21
perl

ちと古い話題だけど、
TTでDBICのhas_manyなメソッドを使う
 TTでDBICのmany_to_manyなメソッドを使う
 [% WHILE %] の中のこと　その後
ここら辺で問題になっていた

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

それ、Template::Stash::Contextでもいけますですよ。

(Catalystの場合)MyAPP::View::TT
で

__PACKAGE__->config(
STASH => Template::Stash::Context->new(),
);

こうして、Viewのほうでは

<html><body>
<ul>
[% WHILE (topic = topics.next) %]
<li>
[% topic.title %]
: comments([% topic.comments.scalar.count %])
</li>
[% END %]
</ul>
</body>
</html>

こんな感じで。これだとmany-to-manyでもたぶんいける。（試してないけど）

ただ、自分はTemplate::Stash::Filtersを使ってるので結局使えなかったり。
うーんなんとかしたい。というか、Stashをauto-filter的な使い方してるのが間違っているのかもしれないけど。。。
追記
なんとかしてみた->Template::Stash::FiltersでTemplate::Stash::Contextを併用する方法

コメント: 0
トラックバック: 0

さて、そろそろ反撃してもいいですか？(携帯サイトでCSSを3キャリア共通にする)

投稿者: chiba
2007/6/19 火曜日 4:07:43
perl

DoCoMoはCSSの外部参照に対応してくれていない。
via モバイル勉強会が開催されました！
んなわけで、作ってみました。
Catalyst::Plugin::CSS::Docomo

package Catalyst::Plugin::CSS::Docomo;
use strict;

use CSS::Tiny;
use CSS::Tiny::Style;
use HTML::TreeBuilder::Select;
use NEXT;

our $VERSION = '0.01';

sub finalize {
    my $c = shift;
    unless ( $c->response->body and not ref $c->response->body ) {
        return $c->NEXT::finalize;
    }
    unless ( $c->response->content_type =~ /^text|xml$|javascript$/ ) {
        return $c->NEXT::finalize;
    }

    unless ($c->req->mobile_agent->is_docomo) {
        return $c->NEXT::finalize;
    }

    $c->res->content_type('application/xhtml+xml; charset=Shift_JIS');

    my $tree = HTML::TreeBuilder::Select->new()->parse($c->res->output)->eof;

    my @stylesheets = $tree->select('link[rel="stylesheet"]');
    unless (@stylesheets) {
        return $c->NEXT::finalize;
    }

    foreach my $stylesheet_el (@stylesheets) {
        my $css = CSS::Tiny->read( $c->path_to('root' . $stylesheet_el->attr('href')) );
        if ($css) {
                for my $st ($css->styles) {
                    foreach my $el ($tree->select($st->selector)) {
                        $st->add_to($el)
                    }
                }
                {
                    no warnings 'redefine';
                    local *HTML::Element::_xml_escape = &_xml_escape;
                    $c->res->output($tree->as_XML);
                }
        }
    }

    $c->NEXT::finalize;
}

sub _xml_escape {
    foreach my $x (@_) {
        $x =~ s!([<&>])!'&#'.(ord($1)).';'!seg;
    }
    return;
}

1;

まぁかなりやっつけ仕事なのはいなめないですが。一応動きます。
キャリア判別のためにCatalyst::Plugin::MobileAgentに依存してます。
他にはCSS::Tiny::Style,HTML::TreeBuilder::Selectあたりを使ってます。それぞれ依存モジュールがどばっとあるので一緒にいれまくってください。

仕組み的には、外部参照していてrootの下にStatic::Simpleとかで読み込ませてるCSSファイルをCSS::Tinyで読み込んでセレクタごとにスタイルをstyle属性に追加しまくるというかんじです。
優先順位なんかはチェックしてないのでどうなるか分りません。
で、これは実はこういうことをやりたくてCPANをあさってたらCSS::Tiny::StyleのSYNOPSISに

#——————————————————
# more interesting example
#——————————————————
# inline a stylesheet onto the single HTML elements
#——————————————————

use HTML::TreeBuilder;

my $tree = HTML::TreeBuilder->new();
$tree->parse_file(‘filename.html’);

$css = CSS::Tiny->read( ‘stylesheet.css’ );

for my $el ($tree->descendants) {
for my $st ($css->styles) {
if ($st->match($el)) {
$st->add_style($el);
}
}
}
print $tree->as_HTML;

こんなのがかいてあったのでこれがほぼ元ネタです。
$st->match($el)がいまいちな動きだったので
HTML::TreeBuilder::Selectを使うことにしましたけどね。

また、動的にクラスを付与しないとかであれば最初にTTを変換してキャッシュしておくというアプローチのほうが賢いでしょう。
あとは、root配下じゃないcssに対応するためbase_pathなんかが設定できたり、LWPなんかと連動して外部サーバのCSSなんかにも
対応するとなかなか汎用的になるかなぁ。
Catalyst以外でも使えるように別の名前空間でモジュール化してもいいだろうし・・・。
まぁ今日はのところは疲れたのでこれぐらい。必要に駆られないとやらなそうだけどね。

以上、反撃終わり。

はてなブックマーク - さて、そろそろ反撃してもいいですか？(携帯サイトでCSSを3キャリア共通にする)

コメント: 0
トラックバック: 0

Template::Stash::Filters(TTのStashで複数のfilterを実行)

投稿者: chiba
2007/6/18 月曜日 2:23:32
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/&/&amp;/g;
        s/</&;t;/g;
        s/>/&gt;/g;
        s/"/&quot;/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しちゃう方式つくってみるかなぁ。

まぁまた時間があったときにでも。

はてなブックマーク - Template::Stash::Filters(TTのStashで複数のfilterを実行)

コメント: 0
トラックバック: 0

Template::Stash::EscapeHTMLByCase(TTでXSS対策)

投稿者: chiba
2007/6/15 金曜日 2:41:55
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>&amp;lt;html&amp;gt;</title>
</head>
<body>

となってしまう。
これは意図した結果ではなく正しくは

<html>
<head>
<title>&lt;html&gt;</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/&/&amp;/g;
        s/</&lt;/g;
        s/>/&gt;/g;
        s/"/&quot;/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>&lt;html&gt;</title>
</head>
<body>

と、こんなことをやってみましたが皆さんはこんな状況をどうしてるもんなんでしょ
それ、TemplateToolkitの標準機能で解決できるよ。とかありそうだけど・・・。
なかったらCPANに上げてみたいなぁ（まだCPAN Authorじゃない・・・）とか。

はてなブックマーク - Template::Stash::EscapeHTMLByCase(TTでXSS対策)

コメント: 0
トラックバック: 1

Encode::JP::Mobile::Vodafone関連の不具合の修正パッチ

投稿者: chiba
2007/6/10 日曜日 20:05:46
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のこことかは使われてるもんなのかなぁ。

はてなブックマーク - Encode::JP::Mobile::Vodafone関連の不具合の修正パッチ

コメント: 0
トラックバック: 0

Encode::JP::Mobileにvodafoneの絵文字相互変換させるパッチ達

投稿者: chiba
12:54:57
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に変換する。
んで、できたのがこれ。

emoji_v2ie_private.txt

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全体のパッチを以下においときます。

Encode-JP-Mobile.patch

ひとつ気になるのがここ。

+    $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を優先にしてみたけど･･･どうするのが正しいのだろうか･･･。

追記
Encode::JP::Mobile::Vodafone関連の不具合の修正パッチ

はてなブックマーク - Encode::JP::Mobileにvodafoneの絵文字相互変換させるパッチ達

コメント: 0
トラックバック: 1

Catalystで携帯端末ID取得

投稿者: chiba
2007/6/7 木曜日 19:13:28
perl

Catalystで携帯の端末IDを取得することになったので

Catalyst::Plugin::MobileUserID
http://d.hatena.ne.jp/fbis/20070506/1178464915

を使うことにする。

しかしまず自分の携帯であるau端末のIDが取れない。

んーなんでだ？と調べてみたところ

Catalyst::Plugin::MobileAgent

に問題がありそう。

下記のコード部分。

$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