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

Perl初心者のためのPerlノートです!

HTML/ CSS/ CGI-Perl/ JavaScript/ JavaApplet/ AccessUp/ Internet/ EnglishLearn/ ちゃいちゃん天使/ 天使メッセージ/ 飯田ワールド/ 結城ワールド/ プロフィール/ WEB相談室/ WEBアンテナ/ WEBリーダー/ 燈明日記/ yahoo

◆ はじめに

本ページは、私がPerlを習得した時(いや習得中)のノートです。

ごく普通の言語(COBOL,C,Java,VB等)を知っている人が、Perlをやり始めるといろいろと悩むことがあります。

それは、

です。

本ページは、そのようなハードルを一つ一つクリアにしていけたらと思います。

そして、本ページが何かのお役に立てれば幸いです。では、ごゆっくりご覧ください。

尚、ご感想、ご意見、誤字、脱字、間違い等がありましたら遠慮なくPerlノート掲示板へご指摘ください。

◆ サイト最新情報

◆ コンテンツ

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

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


質問

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>

◆ おすすめ Perl本

■ 続・初めてのPerl 改訂版

『初めてのPerl』の次ぎに読むと吉です。

結構いいですが・・・、初心者にはちょっと難しいかもです。

■ 結城浩のPerlクイズ

この本には、ちゃいちゃんパパの小話しが載っています(謎)。

ある程度、Perlを理解している人には、たまらない内容になっています。さすが結城先生だな!

結城浩のPerlクイズ

■ 新版Perl言語プログラミングレッスン入門編

実は、私はまだ読んでいませんが、結城先生の本なので良くないはずがありません。

新版Perl言語プログラミングレッスン入門編

■ CGI&Perlポケットリファレンス (Pocket reference)

この本は、非常に役に立ちます。ちょっと調べるのに最適です。サンプルも説明も的を射ています。

CGI&Perlポケットリファレンス (Pocket reference)

■ Perlベストプラクティス

一読の価値有りだと思います。

Perlベストプラクティス

■ プログラミングPerl〈VOLUME1〉

ご存知、Perl本の聖書、ラクダ本(上)です。

■ プログラミングPerl〈VOLUME2〉

ご存知、Perl本の聖書、ラクダ本(下)です。

◆ おわりに

最後に、本ページが、何かのお役に立てれば幸いです。

尚、ご感想、ご意見、誤字、脱字、間違い等がありましたら遠慮なくPerlノート掲示板へご指摘ください。

HTML/ CSS/ CGI-Perl/ JavaScript/ JavaApplet/ AccessUp/ Internet/ EnglishLearn/ ちゃいちゃん天使/ 天使メッセージ/ 飯田ワールド/ 結城ワールド/ プロフィール/ WEB相談室/ WEBアンテナ/ WEBリーダー/ 燈明日記/ yahoo

人のよいところをどんどん見つけよう