物語研究所 “夢前案内人”

Perlのバージョンが5になるかならないかの頃に作った送信フォームPerlスクリプトを「そろそろいい加減UTF-8化しないとなぁ」と思って、use CGI すらしていなかった(古っ！)シロモノだったので殆ど抜本的に作り直していて、、、「まぁ、こんなもんか(取り敢えず)」というとこまで辿り付いたので、ハッカー諸氏の「ツッコミという名の添削(|| s/ツッコミ/添削/g )」を期待して。

use strict;
use warnings;
use utf8;
use Encode;
use open ":utf8";
binmode STDIN, ':utf8';
use CGI;
use CGI::Carp qw(fatalsToBrowser);
my $eucjp = Encode::find_encoding('eucjp');
my $utf8 = Encode::find_encoding('utf8');

#----------------------#
# フォームDATAのデコード #
#----------------------#
sub CGI_decode{
my $q = CGI->new;

my @keys = $q->param();
foreach my $key (@keys)
  {
  my $value = $q->param($key);
    if($main::debug_mode==1){$main::sample_str1 .= $key.'<>'.$value.', ';} #debug用テキスト収集
  my $utf8 = Encode::find_encoding('utf8');
  $value = $utf8->decode($value);
    if($main::debug_mode==1){$main::sample_str2 .= $key.'<>'.$value.', ';} #debug用テキスト収集
  $value = initdata::jp_hankaku_trans($value);
    if($main::debug_mode==1){$main::sample_str3 .= $key.'<>'.$value.', ';} #debug用テキスト収集
    $main::in{ $key } = $value;
  }
}

先ずformから送られて来たデータをデコードしつつバラして取り出すルーチン。 $in{ } で括りたがるのなんかコード書き出した時「Kent Web さんのソースのコピペ」から始めたのが丸バレのコードですが。
ツッコんで欲しいのは「$q->param() した@keys をforeachループで連想配列に入れたがる」のは古い記述なのかどうか。もっと 冴えた|モダンな 書き方が在るのかどうか。
ウェブで調べても「CGI.pm 使って my @keys = $q->param(); で取り出す」という記述だけは在るのですが、「汎用性のある」「フォームデータの取り出しルーチン」を、と考えると、key 値はその時毎の送信元HTMLによって違ってくるわけだから、取り出すルーチンの側で変数名を決め打ちできない。のでフォームデータの分解は「受け取った値で key=>value しといたよ！」というかたちになっていて欲しいので、こういう形式にしたのですが、、、どうざんしょ？

それと eucjp、utf8 それぞれの「Encode::find_encoding()」の記述は冒頭に宣言してしまってグローバル・スコープ的に使ってしまう使い方で良いのかどうかもご意見頂きたく(「そんなことしたらメモリー無駄使い」とか「処理速度が遅く(|速く)なる」とか、、、あれこれ)。

外字の処理をする

次に「最終的にiso-2022-jpメールにして送信」を前提として、Encodeの応用として所謂 機種依存文字(正しくは「プラットフォーム依存文字」と云うべき)を以下のように判定しつつエラー表示を返すルーチンを考えてみた。
utf-8のテキストをちゃんと表示してくれるメール・クライアントを使っている人が多くなってきている(少なくとも、Mac OS X 10.5以降、Windows Vista以降、iPhone、Android OS では)ので「メール本文はutf-8で送っちゃって良いんじゃない？」という意見も今や無謀な意見ではなくなってきているとは言え、まだ「iso-2022-jpにして送っておいた方が安全」ということで。
少し巡りくどい引き回しかも知れませんが、Encode.pm でeuc-jpに(sjisでもiso-2022-jpでも構わない)変換を通過させると変換からDropする文字は第三引数に渡してくれて別途処理をさせてくれるという便利な機能を流用します。で、Dropしなかった(使って差し支えない)文字はutf-8に戻すという流れになっています。

元アイデア：404 Blog Not Found:perl – Encode 中級
http://blog.livedoor.jp/dankogai/archives/51047005.html

sub CGI_decode{
my $q = CGI->new;
my @keys = $q->param();
foreach my $key (@keys)
  {
  my $value = $q->param($key);
  my $utf8 = Encode::find_encoding('utf8');
  $value = $utf8->decode($value);
  $value = omit_izonmoji($value);
  $value = initdata::jp_hankaku_trans($value);
    $main::in{ $key } = $value;
  }
 if ($initdata::gaijiflag){
	initdata::error('プラットホーム依存文字（機種依存文字）を使わないで下さい。',"<p>プラットホーム依存文字（機種依存文字）は、<br />貴方のと違う環境では文字化けして意味不明になる文字です。<br />ブラウザーの「戻る」で戻って<br />プラットホーム依存文字（機種依存文字）を削除または非プラットフォーム依存文字に修正して下さい。</p><p><span style=\"color:#ff0000; font-size:14px !important;\"><b>丸・括弧囲み文字、ローマ数字など</b></span><br />が代表的なプラットホーム依存文字（機種依存文字）です。</p>",'','inquiry_cgi_izonmoji');
 }
}

sub omit_izonmoji {
my $str = shift;
#my $eucjp = Encode::find_encoding('eucjp'); #グローバルで宣言していない場合必要
#my $utf8 = Encode::find_encoding('utf8'); #グローバルで宣言していない場合必要
$str = $utf8->encode($str);
  Encode::from_to($str, "utf8", "eucjp", sub {if (Encode::FB_XMLCREF){$initdata::gaijiflag = $_[0] } } );
  $str = $eucjp->decode($str);
  return $str;
}

どれがプラットフォーム依存文字だか分かるようにする

単にエラーを返すだけだと「どれがプラットフォーム依存文字だと分かっている」人じゃないと不親切(わかっている人はそもそも外字を入力したりしないだろうし)なので「これがプラットフォーム依存文字ですよ」と表示してあげるのが良いだろうと考えて以下のようにコードを追加。

sub CGI_decode{
my $q = CGI->new;

my @keys = $q->param();
foreach my $key (@keys)
  {
  my $value = $q->param($key);
  my $utf8 = Encode::find_encoding('utf8');
  $value = $utf8->decode($value);
  $value = omit_izonmoji($value);
  $value = initdata::jp_hankaku_trans($value);
    $main::in{ $key } = $value;
  }
 if ($initdata::gaijiflag){
	initdata::error('プラットホーム依存文字（機種依存文字）は使わないで下さい。',"<p>プラットホーム依存文字（機種依存文字）は、<br />貴方のと違う環境では文字化けして意味不明になる文字です。<br />ブラウザーの「戻る」で戻って<br />プラットホーム依存文字（機種依存文字）を削除または非機種依存文字に修正して下さい。</p><p><span style=\"color:#ff0000; font-size:14px !important;\"><B>丸・括弧囲み文字、ローマ数字など</B></span><br />が代表的なプラットホーム依存文字（機種依存文字）です。</p><p>あなたの入力した内、以下が外字に該当します：$initdata::gaijiflag</p>",'','inquiry_cgi_izonmoji');
 }
}

sub omit_izonmoji {
my $str = shift;
#my $eucjp = Encode::find_encoding('eucjp'); #グローバルで宣言していない場合必要
#my $utf8 = Encode::find_encoding('utf8'); #グローバルで宣言していない場合必要
$str = $utf8->encode($str);
  Encode::from_to($str, "utf8", "eucjp", sub {if (Encode::FB_HTMLCREF){$initdata::gaijiflag .= chr($_[0]).", ";}});
  $str = $eucjp->decode($str);
  return $str;
}

最初 if (Encode::FB_HTMLCREF){ 以下の部分で $initdata::gaijiflag .= $_[0]; としてしまっていて数字の羅列がprintされ「あれ(･_･?)」となってしまった。というのは

Encode::from_to($str, "utf8", "eucjp", Encode::FB_HTMLCREF);

とした場合「数値文字参照：&#nnnn; 形式」で以降の処理に渡されブラウザ表示上では普通に表示されていたので、そのまま持っていけば良いと思っていたら、文字列処理を通過させてしまうと「純粋に十進数(|十六進数)になってしまう」みたい。
ということで chr() してやって文字コードに戻してやらないといけないと。
因みに、これを $str = $eucjp->decode($str); すると「Wide character in subroutine entry」と怒られます。一つ前の処理で $utf8->encode() しているのでutfフラッグは立っていないと思うので、この挙動はイマイチ納得できない(エライ人の解説希望！)。(euc-jpへの変換からDropしているのでutf-8のままであるとは分かるのですが、、、)

おまけ：全角英数字を半角に && 半角カタカナを全角に

sub jp_hankaku_trans{
my $after=shift;

    $after =~ tr/　！”＃＄％＆’（）＊＋，－．／０-９：；＜＝＞？＠Ａ-Ｚ［￥］＾＿｀ａ-ｚ｛｜｝/ -}/;

{
  use Encode::JP::H2Z;
  my $eucjp = Encode::find_encoding('eucjp');
  sub hankaku2zenkaku { 
    my $str = $eucjp->encode(shift);
    Encode::JP::H2Z::h2z($str);
    $eucjp->decode($str);
  }
  sub zenkaku2hankaku { 
      my $str = $eucjp->encode(shift);
      Encode::JP::H2Z::z2h($str);
      $eucjp->decode($str);
  }
}
hankaku2zenkaku($after);
}

前半：全角英数字を半角には

Perl用、日本語「全角」→「半角」変換ルーチン – adiary開発日誌 http://adiary.blog.abk.nu/0263

から、
後半：半角カタカナを全角に

404 Blog Not Found:perl – 勝手に添削 – utf8環境でperl::Jcodeのtrが使えないとき http://blog.livedoor.jp/dankogai/archives/51693618.html

から丸々借用です。

追記：2012年5月8日19時56分
Encode::FB_HTMLCREF の代わりに Encode::FB_XMLCREF と記述すると16進数表記になるわけですが、FB_XMLCREF とする場合は、Encode.pm のバージョンが中途半端に古いと(ver.2.10～2.12)上手く動いてくれない場合があるという情報をDankoghaiさんの別のページで見付けましたので念の為、補記しておきます。

404 Blog Not Found:perl – Encode::from_to() and fallback options
http://blog.livedoor.jp/dankogai/archives/50502791.html

この場合、以下の通りにすると良いみたいです(手元環境のEncodeは最新版なので未検証)。

sub omit_izonmoji {
my $str = shift;
my $eucjp = Encode::find_encoding('eucjp');
my $utf8 = Encode::find_encoding('utf8');
$str = $utf8->encode($str);
  my $check = ( $Encode::VERSION < 2.13 ) ?  Encode::FB_XMLCREF() : Encode::XMLCREF();
  Encode::from_to($str, "utf8", "eucjp", sub {if ($check){$initdata::gaijiflag .= chr($_&#91;0&#93;).", ";}});
  $str = $eucjp->decode($str);
  return $str;
}