Perlでマルチバイト文字列を含むJSONデータを扱う(JSON.pm)

今さらはまったのでメモ。

JSONはPHPだと何にも考えずにjson_(en|de)codeで行ったり来たりできるので楽なのだが、Perlは、utf8の扱いが紛らわしい。

前提条件

Perlを使う(5.10.1)
use utf8は使わない
Encodeを使わない(代わりにUnicode::Japaneseを使う)

テストコード1(Perl)

#!/usr/bin/perl
use strict;
use warnings;
use JSON;
use Unicode::Japanese;
my $d = {
	"id" => "123456",
	"email" => "user\@example.com",
	"name" => "田中　一郎",
};
my $encoded = to_json($d);
my $decoded = from_json($encoded);
print "Content-type: text/html; charset=utf-8\n\n<h1>JSON.pmテスト</h1>";
print $encoded;
print "<br>";
print join(", ", map { $decoded->{$_} } qw(id email name));
exit;

結果1

{"email":"user@example.com","name":"田中　一郎","id":"123456"}
000000, user@example.com, 田中　一郎

多分これでもいいのだろうが、JSONのリテラルを\uxxxxの形式(PHPと同じ)にしたい。で試行錯誤の結果(ここが長かったがサクッと省略)、to_jsonする前に、マルチバイト文字をすべてflagged utf8にして、asciiとutf8のフラグを立てればよいことが分かった。

テストコード2(Perl)

#!/usr/bin/perl
use strict;
use warnings;
use JSON;
use Unicode::Japanese;
my $d = {
	"id" => "123456",
	"email" => "user\@example.com",
	"name" => Unicode::Japanese->new("田中　一郎")->getu,
};
my $encoded = JSON->new->ascii(1)->utf8(1)->encode($d);
my $decoded = JSON->new->decode($encoded);
print "Content-type: text/html; charset=utf-8\n\n<h1>JSON.pmテスト</h1>";
print $encoded;
print "<br>";
print join(", ", map { $decoded->{$_} } qw(id email name));
exit;

結果2

{"email":"user@example.com","name":"\u7530\u4e2d\u3000\u4e00\u90ce","id":"123456"}
000000, user@example.com, 田中　一郎

これでよさげ。結果2のJSON リテラルをPHPでdecodeしてみると、

テストコード3(PHP)

<?php
$decoded = json_decode('{"email":"user@example.com","name":"\u7530\u4e2d\u3000\u4e00\u90ce","id":"123456"}', true);
print_r($decoded);
?>

結果3

Array
(
    [id] => 000000
    [email] => user@example.com
    [name] => 田中　一郎

)

以上より、Perlでこの形式に作れれば、PHPでもアクセスできることが分かった。

実際には、セッションデータとしてJSONデータを作り、セッション用テーブルの1つのtext型フィールドに突っ込んで使おうとしていたので、flaggedにする部分を汎用的なコードにする必要がある。①ハッシュの階層は2、②キーはすべてascii文字、という前提で、

flagged ut8にする

	my %d; # セッションデータ
	for my $f1(keys %d) {
		if (ref $d{$f1} eq "HASH") {
			for my $f2(keys %{$d{$f1}}) {
				$d{$f1}{$f2} = Unicode::Japanese->new($d{$f1}{$f2})->getu;
			}
		} else {
			$d{$f1} = Unicode::Japanese->new($d{$f1})->getu;
		}
	}

utf8バイト列にする

	my %d = %$d; # デコード後のリファレンスをハッシュに代入
	for my $f1(keys %d) {
		if (ref $d{$f1} eq "HASH") {
			for my $f2(keys %{$d{$f1}}) {
				$d{$f1}{$f2} = Unicode::Japanese->new($d{$f1}{$f2})->get;
			}
		} else {
			$d{$f1} = Unicode::Japanese->new($d{$f1})->get;
		}
	}

というベタな方法でとりあえず使うことにした。。