[Tokyo.pm] [Encode] use encoding made practical!

[Dan Kogai]

弾です。

現在CGIの本を書いているのですが（何匹目のどぜう、という言い方もあるけど）、初心者向けとはいえ、やはり日本語の扱いを避けるわけにはいかないの 
はご存じのとおりです。当然 jcode.pl か Jcode.pm を紹介する、というのが今までのやり方でしたが、今回は堂々と Encode  
も取り上げます。

なぜかって？ s/小飼[　\s]弾/Dan Kogai/ が堂々と使えるからです。

とはいうものの、UTF-8でスクリプトを書け、なんてことは、エディタはとにかく端末がまだきちんと対応していない時点では言えません。そこで  
use encoding 'euc-jp'; が登場します。

ところがぎっちょん、それだけでは automagical に s/(らくだ|ラクダ|駱駝)/perl/ とは行きません。

にも関わらず、フォーム処理に CGI.pm を使っている限りは実にうまい方法があります。

enctype を multipart/form-data にしてしまうのです。

以下、ちょっと長いですが、テストCGIを添付します。EUC-JPで保存して動かしてみて下さい。$Methodや$Enctypeをいじって様子を 
見てみて下さい。

なぜうまく行くかは、クイズとします。

あと eval qq{} もクイズ。

Dan the Encode Maintainer

#!/usr/local/bin/perl
#
# Save me in EUC-JP!

use 5.008;
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
our $Method  = 'POST';
#our $Method  = 'GET';
our $Enctype = 'multipart/form-data';
#our $Enctype = 'application/x-www-form-urlencoded';
our $Charset = 'euc-jp';
use encoding 'euc-jp';

my $cgi = CGI->new();

my %Label =
     (
      name    => '名前',
      kana    => 'フリガナ',
      mailto  => '電子メール',
      mailto2 => '電子メール(確認)',
      tel     => '電話',
      fax     => 'ファックス',
      zip     => '〒',
      address => '住所',
      comment => 'ご意見',
      );


unless ($cgi->param()){
     print_input($cgi);
}else{
     my $kana = $cgi->param('kana');
     $kana =~ s/[\s　]+//g; # 期待どおりに機能します。
     eval qq{ \$kana =~ tr/ぁ-ん/ァ-ン/ };
     # $kana =~ tr/ぁ-ん/ァ-ン/; でないのはなぜでしょう?
     $cgi->param(kana => $kana);
     print_output($cgi);
}

sub print_input{
     my $c = shift;
     print_html(
                $c,
                title =>    "Form:入力",
                name    => $c->textfield(-name => 'name'),
                kana    => $c->textfield(-name => 'kana'),
                mailto  => $c->textfield(-name => 'mailto'),
                mailto2 => $c->textfield(-name => 'mailto2'),
                tel     => $c->textfield(-name => 'tel'),
                fax     => $c->textfield(-name => 'fax'),
                zip     => $c->textfield(-name => 'zip'),
                address => $c->textfield(-name => 'address'),
                comment => $c->textarea(-name => 'comment'),
                );
}

sub print_output{
     my $c = shift;
     print_html(
                $c,
                title   => "Form:出力",
                name    => $c->param('name'),
                kana    => $c->param('kana'),
                mailto  => $c->param('mailto'),
                mailto2 => $c->param('mailto2'),
                tel     => $c->param('tel'),
                fax     => $c->param('fax'),
                zip     => $c->param('zip'),
                address => $c->param('address'),
                comment => $c->param('comment'),
                );
};

sub print_html{
     my $c = shift;
     my %arg = @_;
     print
         $c->header(-charset   => $Charset),
         $c->start_html(-title => $arg{title}),
         $c->h1($arg{title});
     $c->param() or print
         $c->start_form(-method => $Method, -enctype => $Enctype);
     print
         $c->start_table({border => 1}),
         $c->Tr([
                 $c->td([ $Label{name}    => $arg{name} ]),
                 $c->td([ $Label{kana}    => $arg{kana} ]),
                 $c->td([ $Label{mailto}  => $arg{mailto} ]),
                 $c->td([ $Label{mailto2} => $arg{mailto2} ]),
                 $c->td([ $Label{tel}     => $arg{tel} ]),
                 $c->td([ $Label{fax}     => $arg{fax} ]),
                 $c->td([ $Label{zip}     => $arg{zip} ]),
                 $c->td([ $Label{address} => $arg{address} ]),
                 $c->td([ $Label{comment} => $arg{comment} ]),
                 ]);
     if ($c->param()){
         print
             $c->td($c->a({href=>$ENV{SCRIPT_TEXT}}, "Retry"));
     }else{
         print
             $c->td([$c->reset(), $c->submit()]),
         };
     print $c->end_form() unless $c->param();
     print
         $c->end_table(),
         $c->end_html();
}
__END__