CGIモジュールを利用して、フォームを作成しているのですが、入力画面からフォームの内容を受け取る際
utf8プラグマを付けると受け取った内容の一部が 文字化けます。
現象はフォームから受け取ったコードが、Laten-1の文字コードが表示されてしまいます
以下のようにパラメーターを取得しています。
ソースコードは抜粋ですが、
HTML
1 2<input type="text" name="name" id="name" value="名前" size="30"> 3に対応するパラメーター 4<input type="hidden" name="fm_disp_name" id="fm_disp_name" value="お名前"> 5<input type="hidden" name="fm_need_name" id="fm_need_name" value="1">
fm_disp_項目名 があるものには、項目名を
fm_need_項目名
を受け取る仕組みです。
フォームから入力した全角文字が文字化けしてしまいます。
結果表示すると
ãåå??????:Valueãåå値
のようになってしまいます。
perl
1コード 2#!/usr/bin/perl 3use strict; 4use Encode; 5use Encode::Guess; 6use Encode::EUCJPMS; 7#use Jcode; 8use CGI; 9use utf8; 10my $cgi = new CGI; 11require 'mimew.pl'; # jcode($subject)->mime_encode が動かないとき 12#エラーメッセージをブラウザに表示 13use CGI::Carp qw(fatalsToBrowser); 14use Data::Dumper; 15################################### 16print "Content-Type: text/html; charset=utf-8\n\n"; 17# 項目名 18my @item_names = (); 19# 項目の日本語表示名 20my %item_disp = (); 21# 項目の値 22my %item_value = (); 23# 項目の必須有無 24my %item_need = (); 25# フォームパラメータ 26my %fm_param = (); 27my $cgi_url = $cgi->url(); # このCGIのURL 28 29####################################################################### 30# 入力文字コード判定 31####################################################################### 32my $input_value = ''; 33my $name; 34my $value; 35my @values; 36foreach $name ($cgi->param) { 37 if ($name !~ /^submit$/i) { # 項目('submit'は除く) 38 @values = $cgi->param($name); 39 $value = join(',', @values); 40 if($cgi->param('fm_command') eq 'confsend') { # 確認フォームからのときデコード 41 $value = pack_param($value); 42 } 43 $input_value .= $value; 44 } 45} 46#エラーメッセージ配列 47my @err_namelist = (); 48 49#送信データがなければエラーとする 50if (0 == length($input_value)) { 51 push(@err_namelist, '呼び出しエラーです。管理者にお問い合わせ下さい。'); 52 print_input_error(@err_namelist); 53 exit; 54} 55 56#$input_jcode = Jcode::getcode($input_value); 57my $guess = guess_encoding($input_value, qw/euc-jp shiftjis 7bit-jis/); 58my $guess_encode = ($guess->name eq 'euc-jp') ? 'eucJP-ms' : $guess->name; 59 60####################################################################### 61# パラメータ読み込み 62####################################################################### 63 64my @checkboxes_array; 65 66foreach $name ($cgi->param) { 67 if ($name =~ /^fm_/) { # フォームパラメータ 68 $value = $cgi->param($name); 69 if($cgi->param('fm_command') eq 'confsend') { # 確認フォームからのときデコード 70 $value = pack_param($value); 71 } 72 #$value = jcode($value, $input_jcode)->sjis; 73 $value = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value; 74 $fm_param{$name} = $value; 75 if($name =~ /^fm_disp_(\w+)/) { # 項目の日本語表示名 76 $item_disp{$1} = $value; 77 if(!defined $item_value{$1}) { 78 push(@item_names, $1); 79 $item_value{$1} = ''; 80 } 81 } elsif($name =~ /^fm_need_(\w+)/) { # 項目の入力必須 82 $item_need{$1} = $value; 83 } 84 } elsif($name !~ /^submit$/i) { # 項目('submit'は除く) 85 if(!defined $item_value{$name}) { 86 push(@item_names, $name); 87 } 88 @values = $cgi->param($name); 89 90 my $len = @values; 91 if ($len > 1) { 92 logger($name . 'はチェックボックスなのです!で項目数は' . $len . 'なのです!(ただし複数選択可能なselectタグかもしれない・・・けど項目の上限を決めておけばいい($lenが上限以下ならselectでも項目をCSVに出す等))'); 93 for (my $k=0; $k<$len; $k++) { 94 logger(@values[$k]); 95 } 96 #MEMO: 97 #確認画面で項目数がここでわかったので、後ろの画面に$nameは$len項目ですと渡せばcsvでいい感じにできるのです! 98 #実際の処理には現状確認画面でスペース?区切りか何かにされてしまっているため、項目数がうまくは取れないと思われる(確認画面のhiddenタグ参照の事) 99 my $object = { 100 name => $name, 101 len => $len, 102 #values => @values, 103 values => [], 104 }; 105 for (my $k=0; $k<$len; $k++) { 106 logger(@values[$k]); 107 push(@{$object->{values}}, @values[$k]); 108 } 109 push(@checkboxes_array, $object); 110 } 111 112 $value = join(',', @values); 113 if($cgi->param('fm_command') eq 'confsend') { # 確認フォームからのときデコード 114 $value = pack_param($value); 115 } 116 #$item_value{$name} = jcode($value, $input_jcode)->sjis; 117 $item_value{$name} = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value; 118 119 if($item_disp{$name} eq '') { 120 $item_disp{$name} = $name; 121 } 122 } 123} 124 125my $len = @checkboxes_array; 126if ($len > 0) { 127 logger('新規オブジェクト配列は' . $len); 128 for (my $i=0; $i<$len; $i++) { 129 logger(@checkboxes_array[$i]->{name}); 130 logger(Dumper @checkboxes_array[$i]); 131 } 132} 133 134 foreach (keys %fm_param) { 135 print "\$fm_param\{$_\} = $fm_param{$_}<br>\n"; 136 } 137 foreach (@item_names) { 138 my $name = conv_html($item_disp{$_}); 139 my $value = conv_html($item_value{$_}); 140 print "$name:$value ($item_need{$_})<br>\n"; 141 142 } 143 exit; 144 145### csvに書けるように変換 146sub conv_csv { 147 my ($str) = @_; 148# $str =~ s/</</g; 149# $str =~ s/>/>/g; 150 $str =~ s/\t//g; 151 $str =~ s/\r//g; 152 $str =~ s/\n//g; 153 $str =~ s/\,/"\,\"/g; 154 #$str =~ s/"/""/g; 155 return '"' . $str . '"'; 156 #return '' . $str . ''; 157} 158sub conv_tsv { 159 my ($str) = @_; 160# $str =~ s/</</g; 161# $str =~ s/>/>/g; 162 $str =~ s/\t//g; 163 $str =~ s/\r//g; 164 $str =~ s/\n//g; 165 $str =~ s/\,/"\t\"/g; 166# $str =~ s/"/""/g; 167 return '"' . $str . '"'; 168 #return '' . $str . ''; 169} 170 171### htmlで表示できるように変換 172sub conv_html { 173 my ($str) = @_; 174 175 $str =~ s/</</g; 176 $str =~ s/>/>/g; 177 $str =~ s/\t//g; 178 $str =~ s/\r//g; 179 $str =~ s/\,/ /g; 180 $str =~ s/\n/<br>\n/g; 181 182 return $str; 183} 184 185### htmlで表示できるように変換 186sub conv_html2 { 187 my ($str) = @_; 188 189 $str =~ s/</</g; 190 $str =~ s/>/>/g; 191 $str =~ s/\t//g; 192 $str =~ s/\r//g; 193 #$str =~ s/\,/ /g; 194 $str =~ s/\n/<br>\n/g; 195 196 return $str; 197} 198sub conv_mail { 199 my ($str) = @_; 200# $str =~ s/</</g; 201# $str =~ s/>/>/g; 202 $str =~ s/\t//g; 203 $str =~ s/\r//g; 204 $str =~ s/\n//g; 205 $str =~ s/\,/"\t\"/g; 206# $str =~ s/"/""/g; 207 return '"' . $str . '"'; 208 #return '' . $str . ''; 209} 210 211### hiddenパラメータに格納できるようにエンコード 212sub unpack_param { 213 my ($str) = @_; 214 215 $str =~ s/([^\w.\/\-@ ])/'%'.unpack('H2',$1)/eg; 216 217 return $str; 218} 219 220### エンコードしたhiddenパラメータをデコード 221sub pack_param { 222 my ($str) = @_; 223 224 $str =~ s/%([A-Fa-f0-9]{2})/pack('H2', $1)/eg; 225 226 return $str; 227} 228 229sub conv_ahtml { 230 my ($str) = @_; 231# $str =~ s/</</g; 232# $str =~ s/>/>/g; 233 $str =~ s/\t//g; 234 $str =~ s/\r//g; 235 $str =~ s/\n/<br>\n/g; 236 237 return $str; 238} 239 240
回答7件
あなたの回答
tips
プレビュー