漢字クッキーをPerlでSetし、JavaScriptでGetする！

perlノート

まずは、以下の引用（質問と回答）をご覧ください。

質問

ieのjavascriptでescapeすると
おはよう ⇒ %u304A%u306F%u3088%u3046
となりますが、これをperlなどで同じように
エンコードする方法はありませんでしょうか？

http://oshiete1.goo.ne.jp/kotaeru.php3?q=1257793

回答

使い方は
　　$escaped_str = js_escape($str, $icode);
となります。
$icode には $str のエンコーディング（"sjis" や "euc-jp" など）を指定して下さい。
# print js_escape("おはよう", "sjis"); など

sub js_escape {
    use Encode;
    my $str = join "", map sprintf("%%u%04X", $_), unpack "n*", encode("utf16be", decode($_[1], $_[0]));
    my ($ch, $hex);
    $str =~ s<%u00(..)>{ ($ch = pack("H2", $hex = $1)) =~ m<[^\w\@.*/+-]> ? "%$hex" : $ch }eg;
    $str;
}
http://oshiete1.goo.ne.jp/kotaeru.php3?q=1257793

js_escapeの解説

  1. join...のソースのdecode($_[1], $_[0])は、$_[0]の文字列を$_[1]で指定された漢字コードからUTF-8にデコードしています。
  2. encode("utf16be", decode($_[1], $_[0]))は、1でデコードしたものをutf16beにエンコードしています。
  3. unpack "n*", encode("utf16be", decode($_[1], $_[0]))は、2でエンコードしたものをリストにアンパックしています。
  4. map sprintf("%%u%04X", $_)は、3を%uXXXXの形式にフォーマットし、それらのリストを返します。
  5. join ""は、4のリストを連結して一つの文字列にします。
  6. s<%u00(..)>...のソースは、1バイト文字(%u00(..))を、[^\w\@.*/+-]で弾いたものは%$hexとし、それ以外は$chとして置換します。
  7. 留意点としては、置換や検索の区切り文字に<>や{}を使用しています。
  8. つまり、join...のソースは、2バイト系（漢字）をデコードし、 s<%u00(..)>...のソースは1バイト系をデコードしています。

以下にjs_escapeを使ったサンプルをアップしときます。

CGI(Perl)ソース（漢字クッキーをPerlでSetする）

#!/usr/local/bin/perl
use strict;

&set_cooKie('test_javascript_cookie1', 'ID:111,X X:あ,YY:1あ1,ZZ:あ1あ', 1,'','/');
&set_cooKie('test_javascript_cookie2', 'ID:111,XXX:い,YY:1あ1,ZZ:あ1あ', 1,'','/');

print <<"HERE1";
Content-type: text/html; charset=Shift_JIS

<html>
<body>
<p>漢字クッキーをPerlでSetし、JavaScriptでGetする！</p>
</body>
</html>
HERE1

sub set_cooKie {
    my ($CookieName, $cookie, $daycount, $domain, $path) = @_;
    my ($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg) = gmtime(time + $daycount*24*60*60);
    my @week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    my @mons = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
    my $date_g = sprintf("%s, %02d\-%s\-%04d %02d:%02d:%02d GMT",
       $week[$wdayg],$mdayg,$mons[$mong],$yearg+1900,$hourg,$ming,$secg);
    $cookie = js_escape($cookie, "sjis");
    if ($domain eq '' && $path eq '') {
        print "Set-Cookie: $CookieName=$cookie; expires=$date_g; \n";
    }
    elsif ($domain eq '') {
        print "Set-Cookie: $CookieName=$cookie; expires=$date_g; path=$path; \n";
    }
    elsif ($path eq '') {
        print "Set-Cookie: $CookieName=$cookie; expires=$date_g; domain=$domain; \n";
    }
    else{
        print "Set-Cookie: $CookieName=$cookie; expires=$date_g; domain=$domain; path=$path \n";
    }
}

sub js_escape {
    use Encode;
    my $str = join "", map sprintf("%%u%04X", $_), unpack "n*", encode("utf16be", decode($_[1], $_[0]));
    my ($ch, $hex);
    $str =~ s<%u00(..)>{ ($ch = pack("H2", $hex = $1)) =~ m<[^\w\@.*/+-]> ? "%$hex" : $ch }eg;
    $str;
}

HTML(JavaScript)ソース（漢字クッキーをJavaScriptでGetする）

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
<title>漢字クッキーをPerlでSetし、JavaScriptでGetする！</title>
</head>
<body>
<script type="text/javascript">
function getCookie(){
        this.data = new Array();
        this.string = (document.cookie) ? document.cookie.split(';') : new Array();
        for (var i = 0; i != this.string.length; i++) {
             this.data[this.string[i].split('=')[0].match(/[^ ].*/)]
                                  = unescape(this.string[i].split('=')[1]);
        }
}
getCookie = new getCookie();
document.write(getCookie.data.test_javascript_cookie1, "<br>");
document.write(getCookie.data.test_javascript_cookie2, "<br>");
</script>
</body>
</html>