質問編集履歴

4 抜粋コードを確認できるようになりました。

motokix

motokix score 11

2015/12/16 15:09  投稿

utf8プラグマを付けると 受け取った内容の一部が文字化けます。
CGIモジュールを利用して、フォームを作成しているのですが、入力画面からフォームの内容を受け取る際
utf8プラグマを付けると受け取った内容の一部が 文字化けます。
現象はフォームから受け取ったコードが、Laten-1の文字コードが表示されてしまいます
以下のようにパラメーターを取得しています。
ソースコードは抜粋ですが、
```HTML
<input type="text" name="name" id="name" value="名前" size="30">
に対応するパラメーター
<input type="hidden" name="fm_disp_name" id="fm_disp_name" value="お名前">
<input type="hidden" name="fm_need_name" id="fm_need_name" value="1">
```
fm_disp_項目名 があるものには、項目名を
fm_need_項目名
を受け取る仕組みです。
フォームから入力した全角文字が文字化けしてしまいます。
結果表示すると
お名前??????:Valueお名前値
のようになってしまいます。
```perl
コード
#!/usr/bin/perl
use strict;
use Encode;
use Encode::Guess;
use Encode::EUCJPMS;
#use Jcode;
use CGI;
use utf8;
my $cgi = new CGI;
require 'mimew.pl';                               # jcode($subject)->mime_encode が動かないとき
#エラーメッセージをブラウザに表示
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;
###################################
print "Content-Type: text/html; charset=utf-8\n\n";
# 項目名
my @item_names = ();
# 項目の日本語表示名
my %item_disp = ();
# 項目の値
my %item_value = ();
# 項目の必須有無
my %item_need = ();
# フォームパラメータ
my %fm_param = ();
my $cgi_url = $cgi->url();   # このCGIのURL
#######################################################################
# 入力文字コード判定
#######################################################################
my $input_value = '';
my $name;
my $value;
my @values;
foreach $name ($cgi->param) {
   if ($name !~ /^submit$/i) {   # 項目('submit'は除く)
       @values = $cgi->param($name);
       $value = join(',', @values);
       if($cgi->param('fm_command') eq 'confsend') {   # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       $input_value .= $value;
   }
}
#エラーメッセージ配列
my @err_namelist = ();
#送信データがなければエラーとする
if (0 == length($input_value)) {
   push(@err_namelist, '呼び出しエラーです。管理者にお問い合わせ下さい。');
   print_input_error(@err_namelist);
   exit;
}
#$input_jcode = Jcode::getcode($input_value);
my $guess = guess_encoding($input_value, qw/euc-jp shiftjis 7bit-jis/);
my $guess_encode = ($guess->name eq 'euc-jp') ? 'eucJP-ms' : $guess->name;
#######################################################################
# パラメータ読み込み
#######################################################################
my @checkboxes_array;
foreach $name ($cgi->param) {
   if ($name =~ /^fm_/) {   # フォームパラメータ
       $value = $cgi->param($name);
       if($cgi->param('fm_command') eq 'confsend') {   # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$value = jcode($value, $input_jcode)->sjis;
       $value = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       $fm_param{$name} = $value;
       if($name =~ /^fm_disp_(\w+)/) {   # 項目の日本語表示名
           $item_disp{$1} = $value;
           if(!defined $item_value{$1}) {
               push(@item_names, $1);
               $item_value{$1} = '';
           }
       } elsif($name =~ /^fm_need_(\w+)/) {   # 項目の入力必須
           $item_need{$1} = $value;
       }
   } elsif($name !~ /^submit$/i) {   # 項目('submit'は除く)
       if(!defined $item_value{$name}) {
           push(@item_names, $name);
       }
       @values = $cgi->param($name);
       my $len = @values;
       if ($len > 1) {
           logger($name . 'はチェックボックスなのです!で項目数は' . $len . 'なのです!(ただし複数選択可能なselectタグかもしれない・・・けど項目の上限を決めておけばいい($lenが上限以下ならselectでも項目をCSVに出す等))');
           for (my $k=0; $k<$len; $k++) {
               logger(@values[$k]);
           }
           #MEMO:
           #確認画面で項目数がここでわかったので、後ろの画面に$nameは$len項目ですと渡せばcsvでいい感じにできるのです!
           #実際の処理には現状確認画面でスペース?区切りか何かにされてしまっているため、項目数がうまくは取れないと思われる(確認画面のhiddenタグ参照の事)
           my $object = {
               name => $name,
               len => $len,
               #values => @values,
               values => [],
           };
           for (my $k=0; $k<$len; $k++) {
               logger(@values[$k]);
               push(@{$object->{values}}, @values[$k]);
           }
           push(@checkboxes_array, $object);
       }
       
       $value = join(',', @values);
       if($cgi->param('fm_command') eq 'confsend') {   # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$item_value{$name} = jcode($value, $input_jcode)->sjis;
       $item_value{$name} = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       if($item_disp{$name} eq '') {
           $item_disp{$name} = $name;
       }
   }
}
my $len = @checkboxes_array;
if ($len > 0) {
   logger('新規オブジェクト配列は' . $len);
   for (my $i=0; $i<$len; $i++) {
       logger(@checkboxes_array[$i]->{name});
       logger(Dumper @checkboxes_array[$i]);
   }
}
   foreach (keys %fm_param) {
       print "\$fm_param\{$_\} = $fm_param{$_}<br>\n";
   }
   print "HTMLにかけるように変更";  
   foreach (@item_names) {
       my $name = conv_html($item_disp{$_});
       my $value = conv_html($item_value{$_});
       print "$name:$value ($item_need{$_})<br>\n";
       
   }
   exit;
### csvに書けるように変換
sub conv_csv {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n//g;
   $str =~ s/\,/"\,\"/g;
   #$str =~ s/"/""/g;
   return '"' . $str . '"';
   #return '' . $str . '';
}
sub conv_tsv {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n//g;
   $str =~ s/\,/"\t\"/g;
#   $str =~ s/"/""/g;
   return '"' . $str . '"';
   #return '' . $str . '';
}
### htmlで表示できるように変換
sub conv_html {
   my ($str) = @_;
   
   $str =~ s/</&lt;/g;
   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\,/ /g;
   $str =~ s/\n/<br>\n/g;
   
   return $str;
}
### htmlで表示できるように変換
sub conv_html2 {
   my ($str) = @_;
   
   $str =~ s/</&lt;/g;
   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   #$str =~ s/\,/ /g;
   $str =~ s/\n/<br>\n/g;
   
   return $str;
}
sub conv_mail {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n//g;
   $str =~ s/\,/"\t\"/g;
#   $str =~ s/"/""/g;
   return '"' . $str . '"';
   #return '' . $str . '';
}
### hiddenパラメータに格納できるようにエンコード
sub unpack_param {
   my ($str) = @_;
   
   $str =~ s/([^\w.\/\-@ ])/'%'.unpack('H2',$1)/eg;
   
   return $str;
}
### エンコードしたhiddenパラメータをデコード
sub pack_param {
   my ($str) = @_;
   
   $str =~ s/%([A-Fa-f0-9]{2})/pack('H2', $1)/eg;
   
   return $str;
}
sub conv_ahtml {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n/<br>\n/g;
   
   return $str;
}
```
  • Perl

    541 questions

    Perlは多目的に使用される実用性が高い動的プログラミング言語のひとつです。

3 動くコードに編集しました。

motokix

motokix score 11

2015/12/16 15:05  投稿

utf8プラグマを付けると 受け取った内容の一部が文字化けます。
CGIモジュールを利用して、フォームを作成しているのですが、入力画面からフォームの内容を受け取る際
utf8プラグマを付けると受け取った内容の一部が 文字化けます。
現象はフォームから受け取ったコードが、Laten-1の文字コードが表示されてしまいます
以下のようにパラメーターを取得しています。
ソースコードは抜粋ですが、
```HTML
<input type="text" name="name" id="name" value="名前" size="30">
に対応するパラメーター
<input type="hidden" name="fm_disp_name" id="fm_disp_name" value="お名前">
<input type="hidden" name="fm_need_name" id="fm_need_name" value="1">
```
fm_disp_項目名 があるものには、項目名を
fm_need_項目名
を受け取る仕組みです。
フォームから入力した全角文字が文字化けしてしまいます。
結果表示すると
お名前??????:Valueお名前値
のようになってしまいます。
```perl
コード
#!/usr/bin/perl
use strict;
 
use Encode;
use Encode::Guess;
use Encode::EUCJPMS;
#use Jcode;
use CGI;
use utf8;  
my $cgi = new CGI;
require 'mimew.pl';                            # jcode($subject)->mime_encode が動かないとき
require 'mimew.pl';                               # jcode($subject)->mime_encode が動かないとき
#エラーメッセージをブラウザに表示
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;
###################################  
print "Content-Type: text/html; charset=utf-8\n\n";  
# 項目名  
my @item_names = ();  
# 項目の日本語表示名  
my %item_disp = ();  
# 項目の値  
my %item_value = ();  
# 項目の必須有無  
my %item_need = ();  
# フォームパラメータ  
my %fm_param = ();  
my $cgi_url = $cgi->url();   # このCGIのURL  
 
#######################################################################  
# 入力文字コード判定  
#######################################################################  
my $input_value = '';  
my $name;  
my $value;  
my @values;  
foreach $name ($cgi->param) {  
   if ($name !~ /^submit$/i) {   # 項目('submit'は除く)  
       @values = $cgi->param($name);  
       $value = join(',', @values);  
       if($cgi->param('fm_command') eq 'confsend') {   # 確認フォームからのときデコード  
           $value = pack_param($value);  
       }  
       $input_value .= $value;  
   }  
}  
#エラーメッセージ配列  
my @err_namelist = ();  
 
#送信データがなければエラーとする  
if (0 == length($input_value)) {  
   push(@err_namelist, '呼び出しエラーです。管理者にお問い合わせ下さい。');  
   print_input_error(@err_namelist);  
   exit;  
}  
 
#$input_jcode = Jcode::getcode($input_value);  
my $guess = guess_encoding($input_value, qw/euc-jp shiftjis 7bit-jis/);  
my $guess_encode = ($guess->name eq 'euc-jp') ? 'eucJP-ms' : $guess->name;  
 
#######################################################################  
# パラメータ読み込み  
#######################################################################  
 
my @checkboxes_array;
foreach $name ($cgi->param) {
   if ($name =~ /^fm_/) { # フォームパラメータ
       $value = $cgi->param($name);
       if($cgi->param('fm_command') eq 'confsend') {  # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$value = jcode($value, $input_jcode)->sjis;
       $value = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       $fm_param{$name} = $value;
       if($name =~ /^fm_disp_(\w+)/) { # 項目の日本語表示名
           $item_disp{$1} = $value;
           if(!defined $item_value{$1}) {
               push(@item_names, $1);
               $item_value{$1} = '';
           }
       } elsif($name =~ /^fm_need_(\w+)/) {   # 項目の入力必須
           $item_need{$1} = $value;
       }
   } elsif($name !~ /^submit$/i) { # 項目('submit'は除く)
       if(!defined $item_value{$name}) {
           push(@item_names, $name);
       }
       @values = $cgi->param($name);
       my $len = @values;
       if ($len > 1) {
           for (my $k=0; $k $name,
               len => $len,
               #values => @values,
               values => [],
           };
           for (my $k=0; $k{values}}, @values[$k]);
           }
           push(@checkboxes_array, $object);
       }
       $value = join(',', @values);
       if($cgi->param('fm_command') eq 'confsend') {  # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$item_value{$name} = jcode($value, $input_jcode)->sjis;
       $item_value{$name} = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       if($item_disp{$name} eq '') {
           $item_disp{$name} = $name;
       }
   }
   if ($name =~ /^fm_/) {   # フォームパラメータ
       $value = $cgi->param($name);
       if($cgi->param('fm_command') eq 'confsend') {   # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$value = jcode($value, $input_jcode)->sjis;
       $value = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       $fm_param{$name} = $value;
       if($name =~ /^fm_disp_(\w+)/) {   # 項目の日本語表示名
           $item_disp{$1} = $value;
           if(!defined $item_value{$1}) {
               push(@item_names, $1);
               $item_value{$1} = '';
           }
       } elsif($name =~ /^fm_need_(\w+)/) {   # 項目の入力必須
           $item_need{$1} = $value;
       }
   } elsif($name !~ /^submit$/i) {   # 項目('submit'は除く)
       if(!defined $item_value{$name}) {
           push(@item_names, $name);
       }
       @values = $cgi->param($name);
       my $len = @values;
       if ($len > 1) {
           logger($name . 'はチェックボックスなのです!で項目数は' . $len . 'なのです!(ただし複数選択可能なselectタグかもしれない・・・けど項目の上限を決めておけばいい($lenが上限以下ならselectでも項目をCSVに出す等))');
           for (my $k=0; $k<$len; $k++) {
               logger(@values[$k]);
           }
           #MEMO:
           #確認画面で項目数がここでわかったので、後ろの画面に$nameは$len項目ですと渡せばcsvでいい感じにできるのです!
           #実際の処理には現状確認画面でスペース?区切りか何かにされてしまっているため、項目数がうまくは取れないと思われる(確認画面のhiddenタグ参照の事)
           my $object = {
               name => $name,
               len => $len,
               #values => @values,
               values => [],
           };
           for (my $k=0; $k<$len; $k++) {
               logger(@values[$k]);
               push(@{$object->{values}}, @values[$k]);
           }
           push(@checkboxes_array, $object);
       }
       
       $value = join(',', @values);
       if($cgi->param('fm_command') eq 'confsend') {   # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$item_value{$name} = jcode($value, $input_jcode)->sjis;
       $item_value{$name} = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       if($item_disp{$name} eq '') {
           $item_disp{$name} = $name;
       }
   }
}
my $len = @checkboxes_array;
if ($len > 0) {
   logger('新規オブジェクト配列は' . $len);
   for (my $i=0; $i{name});
       logger(Dumper @checkboxes_array[$i]);
   }
}`
   logger('新規オブジェクト配列は' . $len);
   for (my $i=0; $i<$len; $i++) {
       logger(@checkboxes_array[$i]->{name});
       logger(Dumper @checkboxes_array[$i]);
   }
}
   foreach (keys %fm_param) {
       print "\$fm_param\{$_\} = $fm_param{$_}<br>\n";
   }
   print "HTMLにかけるように変更";
   foreach (@item_names) {
       my $name = conv_html($item_disp{$_});
       my $value = conv_html($item_value{$_});
       print "$name:$value ($item_need{$_})<br>\n";
       
   }
   exit;
### csvに書けるように変換
sub conv_csv {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n//g;
   $str =~ s/\,/"\,\"/g;
   #$str =~ s/"/""/g;
   return '"' . $str . '"';
   #return '' . $str . '';
}
sub conv_tsv {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n//g;
   $str =~ s/\,/"\t\"/g;
#   $str =~ s/"/""/g;
   return '"' . $str . '"';
   #return '' . $str . '';
}
### htmlで表示できるように変換
sub conv_html {
   my ($str) = @_;
   
   $str =~ s/</&lt;/g;
   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\,/ /g;
   $str =~ s/\n/<br>\n/g;
   
   return $str;
}
### htmlで表示できるように変換
sub conv_html2 {
   my ($str) = @_;
   
   $str =~ s/</&lt;/g;
   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   #$str =~ s/\,/ /g;
   $str =~ s/\n/<br>\n/g;
   
   return $str;
}
sub conv_mail {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n//g;
   $str =~ s/\,/"\t\"/g;
#   $str =~ s/"/""/g;
   return '"' . $str . '"';
   #return '' . $str . '';
}
### hiddenパラメータに格納できるようにエンコード
sub unpack_param {
   my ($str) = @_;
   $str =~ s/([^\w.\/\-@ ])/'%'.unpack('H2',$1)/eg;
   return $str;
   my ($str) = @_;
   
   $str =~ s/([^\w.\/\-@ ])/'%'.unpack('H2',$1)/eg;
   
   return $str;
}
### エンコードしたhiddenパラメータをデコード
sub pack_param {
   my ($str) = @_;
   $str =~ s/%([A-Fa-f0-9]{2})/pack('H2', $1)/eg;
   return $str;
}
   my ($str) = @_;
   
   $str =~ s/%([A-Fa-f0-9]{2})/pack('H2', $1)/eg;
   
   return $str;
}
sub conv_ahtml {
   my ($str) = @_;
#   $str =~ s/</&lt;/g;
#   $str =~ s/>/&gt;/g;
   $str =~ s/\t//g;
   $str =~ s/\r//g;
   $str =~ s/\n/<br>\n/g;
   
   return $str;
}
```
  • Perl

    541 questions

    Perlは多目的に使用される実用性が高い動的プログラミング言語のひとつです。

2 入力に至るまでの概要を記載しました

motokix

motokix score 11

2015/12/16 14:20  投稿

utf8プラグマを付けると 受け取った内容の一部が文字化けます。
CGIモジュールを利用して、フォームを作成しているのですが、入力画面からフォームの内容を受け取る際
utf8プラグマを付けると受け取った内容の一部が 文字化けます。
現象はフォームから受け取ったコードが、Laten-1の文字コードが表示されてしまいます
以下のようにパラメーターを取得しています。
ソースコードは抜粋ですが、
入力フォームには
```HTML
<input type="text" name="name" id="name" value="名前" size="30">
に対応するパラメーター
<input type="hidden" name="fm_disp_name" id="fm_disp_name" value="お名前">
<input type="hidden" name="fm_need_name" id="fm_need_name" value="1">
```  
fm_disp_項目名 があるものには、項目名を
fm_need_項目名
を受け取る仕組みです。
フォームから入力した全角文字が文字化けしてしまいます。
結果表示すると
お名前??????:Valueお名前値
のようになってしまいます。
```perl
コード
use strict;
use Encode;
use Encode::Guess;
use Encode::EUCJPMS;
#use Jcode;
use CGI;
my $cgi = new CGI;
require 'mimew.pl';                            # jcode($subject)->mime_encode が動かないとき
#エラーメッセージをブラウザに表示
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;
my @checkboxes_array;
foreach $name ($cgi->param) {
   if ($name =~ /^fm_/) { # フォームパラメータ
       $value = $cgi->param($name);
       if($cgi->param('fm_command') eq 'confsend') {  # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$value = jcode($value, $input_jcode)->sjis;
       $value = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       $fm_param{$name} = $value;
       if($name =~ /^fm_disp_(\w+)/) { # 項目の日本語表示名
           $item_disp{$1} = $value;
           if(!defined $item_value{$1}) {
               push(@item_names, $1);
               $item_value{$1} = '';
           }
       } elsif($name =~ /^fm_need_(\w+)/) {   # 項目の入力必須
           $item_need{$1} = $value;
       }
   } elsif($name !~ /^submit$/i) { # 項目('submit'は除く)
       if(!defined $item_value{$name}) {
           push(@item_names, $name);
       }
       @values = $cgi->param($name);
       my $len = @values;
       if ($len > 1) {
           for (my $k=0; $k $name,
               len => $len,
               #values => @values,
               values => [],
           };
           for (my $k=0; $k{values}}, @values[$k]);
           }
           push(@checkboxes_array, $object);
       }
       $value = join(',', @values);
       if($cgi->param('fm_command') eq 'confsend') {  # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$item_value{$name} = jcode($value, $input_jcode)->sjis;
       $item_value{$name} = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       if($item_disp{$name} eq '') {
           $item_disp{$name} = $name;
       }
   }
}
my $len = @checkboxes_array;
if ($len > 0) {
   logger('新規オブジェクト配列は' . $len);
   for (my $i=0; $i{name});
       logger(Dumper @checkboxes_array[$i]);
   }
}`
### hiddenパラメータに格納できるようにエンコード
sub unpack_param {
   my ($str) = @_;
   $str =~ s/([^\w.\/\-@ ])/'%'.unpack('H2',$1)/eg;
   return $str;
}
### エンコードしたhiddenパラメータをデコード
sub pack_param {
   my ($str) = @_;
   $str =~ s/%([A-Fa-f0-9]{2})/pack('H2', $1)/eg;
   return $str;
}
```
  • Perl

    541 questions

    Perlは多目的に使用される実用性が高い動的プログラミング言語のひとつです。

1 発生がおきるまでのフローを記載しました。

motokix

motokix score 11

2015/12/16 14:18  投稿

utf8プラグマを付けると 受け取った内容の一部が文字化けます。
CGIモジュールを利用して、フォームを作成しているのですが、入力画面からフォームの内容を受け取る際
utf8プラグマを付けると受け取った内容の一部が 文字化けます。
現象はフォームから受け取ったコードが、Laten-1の文字コードが表示されてしまいます
以下のようにパラメーターを取得しています。
 
ソースコードは抜粋ですが、  
入力フォームには  
<input type="text" name="name" id="name" value="名前" size="30">  
に対応するパラメーター  
<input type="hidden" name="fm_disp_name" id="fm_disp_name" value="お名前">  
<input type="hidden" name="fm_need_name" id="fm_need_name" value="1">  
fm_disp_項目名 があるものには、項目名を  
fm_need_項目名  
を受け取る仕組みです。  
 
フォームから入力した全角文字が文字化けしてしまいます。  
結果表示すると  
お名前??????:Valueお名前値  
のようになってしまいます。  
```perl
コード
use strict;
use Encode;
use Encode::Guess;
use Encode::EUCJPMS;
#use Jcode;
use CGI;
my $cgi = new CGI;
require 'mimew.pl';                            # jcode($subject)->mime_encode が動かないとき
#エラーメッセージをブラウザに表示
use CGI::Carp qw(fatalsToBrowser);
use Data::Dumper;
my @checkboxes_array;
foreach $name ($cgi->param) {
   if ($name =~ /^fm_/) { # フォームパラメータ
       $value = $cgi->param($name);
       if($cgi->param('fm_command') eq 'confsend') {  # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$value = jcode($value, $input_jcode)->sjis;
       $value = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       $fm_param{$name} = $value;
       if($name =~ /^fm_disp_(\w+)/) { # 項目の日本語表示名
           $item_disp{$1} = $value;
           if(!defined $item_value{$1}) {
               push(@item_names, $1);
               $item_value{$1} = '';
           }
       } elsif($name =~ /^fm_need_(\w+)/) {   # 項目の入力必須
           $item_need{$1} = $value;
       }
   } elsif($name !~ /^submit$/i) { # 項目('submit'は除く)
       if(!defined $item_value{$name}) {
           push(@item_names, $name);
       }
       @values = $cgi->param($name);
       my $len = @values;
       if ($len > 1) {
           for (my $k=0; $k $name,
               len => $len,
               #values => @values,
               values => [],
           };
           for (my $k=0; $k{values}}, @values[$k]);
           }
           push(@checkboxes_array, $object);
       }
       $value = join(',', @values);
       if($cgi->param('fm_command') eq 'confsend') {  # 確認フォームからのときデコード
           $value = pack_param($value);
       }
       #$item_value{$name} = jcode($value, $input_jcode)->sjis;
       $item_value{$name} = ($guess->name ne 'shiftjis') ? encode('utf8', decode($guess_encode, $value)) : $value;
       if($item_disp{$name} eq '') {
           $item_disp{$name} = $name;
       }
   }
}
my $len = @checkboxes_array;
if ($len > 0) {
   logger('新規オブジェクト配列は' . $len);
   for (my $i=0; $i{name});
       logger(Dumper @checkboxes_array[$i]);
   }
}`
### hiddenパラメータに格納できるようにエンコード
sub unpack_param {
   my ($str) = @_;
   $str =~ s/([^\w.\/\-@ ])/'%'.unpack('H2',$1)/eg;
   return $str;
}
### エンコードしたhiddenパラメータをデコード
sub pack_param {
   my ($str) = @_;
   $str =~ s/%([A-Fa-f0-9]{2})/pack('H2', $1)/eg;
   return $str;
}
```
  • Perl

    541 questions

    Perlは多目的に使用される実用性が高い動的プログラミング言語のひとつです。

思考するエンジニアのためのQ&Aサイト「teratail」について詳しく知る