#! /usr/local/bin/perl -w $TITLE = "UTF8エンコードをデコードする"; @LINK = ( ['ck-non-ascii.cgi', '非ASCII文字チェック'], ['decode64.cgi', 'Base64 デコード'], ['exsjis2.cgi', 'SJIS 第2バイトチェック'], ); $CVSID = ''; BEGIN{open(STDERR, ">$0.stderr.log")} require 5.006; use CGI; my $q = CGI::new(); (my $CGI = $0) =~ s{^.*[/\\]} {}; my @MSG = (); my %FORM; my (@input, @org) = (); my @ASCTRL = qw(NUL SOH STX ETX EOT ENQ ACK BEL BS HT LF VT FF CR SO SI DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM SUB ESC FS GS RS US); my $COL_OK = '#88FFFF'; my $COL_NG = 'Red'; my $COL_CONT = '#ffff88'; my $COL_CHR = '#00FF00'; { my $req = &init; if( $req eq 'dl' ) { &dlcgi(); exit 0; } &put_menu($req); &proc(); &term(); exit 0; } sub init{ %FORM = ( 'text' => '', 'oct' => '', 'hex' => '', 'url' => '', ); foreach my $nam ($q->param()) { my $val = $q->param($nam); $FORM{$nam} = &encode_data($val); } my $req = $q->param('req') || ''; my $input = $q->param($req) or return $req; my $firstline = []; if( $req eq 'oct' ) { foreach my $inbyte (split(/\D+/, $input)) { push(@{$org[0]}, $inbyte); push(@$firstline, oct($inbyte) % 256); } $input[0] = $firstline; }elsif( $req eq 'hex' ) { while( $input ne '' ) { $input =~ s/^[^\da-f]+//i and next; $input =~ s/^([\da-f])[^\da-f]*([\da-f]?)//i; my $inbyte = $1; if( $2 eq '' ) { $inbyte .= '0'; }else{ $inbyte .= $2; } push(@{$org[0]}, $inbyte); push(@$firstline, hex($inbyte) % 256); } $input[0] = $firstline; }elsif( $req eq 'text' ) { foreach my $line (split(/\r*\n/, $input)) { push(@input, [map(ord($_), split(//, $line))]); } }elsif( $req eq 'url' ) { my @chrs = split(//, $input); while( @chrs ) { my $chr = shift(@chrs); if( $chr ne '%' ) { push(@{$org[0]}, $chr); push(@$firstline, ord($chr)); next; } my $hex = shift(@chrs) . shift(@chrs); push(@{$org[0]}, $chr . $hex); push(@$firstline, hex($hex) % 256); } $input[0] = $firstline; } return $req; } sub put_menu{ my $req = shift; my $oct = join(' ', map(sprintf('%o', $_), @{$input[0]})) . '
'; my $hex = join(' ', map(sprintf('%02X', $_), @{$input[0]})) . '
'; my $url = &encode_url(join('', map(chr($_), @{$input[0]}))) . '
'; print"Content-type: text/html; charset=UTF-8\r\n\r\n"; print < $TITLE

$TITLE

HTML print("$CVSID    use=", -s "$0.use.log", "  dl=", -s "$0.dl.log", "\n", <このページは、文字列の UTF-8 エンコードをデコードし、各文字のUnicode番号(U+XXXX)を得ることができます。 実用には向きませんが、短かい UTF-8 文字列の手軽な解や、あるいは UTF-8エンコーディングの入門学習に向いています。

HTML print < テキスト入力

8進入力
1バイト毎に非数字文字で区切ってください。 各バイトの8進数をゼロで始める必要はありません。
例: 343 201 202
$oct
16進入力
1バイト2桁で表記してください。区切の有無は自由で、非英数字は無視されます。 例: e38182
$hex
URLエンコード
\%XXの形式の16進表現と通常文字の混在が可能です。 例: AB%E3%81%82C
$url
HTML2 return; } sub proc{ return if( ! @input ); open(CNT, ">>$0.use.log"); print CNT "\n"; close(CNT); #### 入力の解釈 # 入力値 foreach my $li (0 .. $#input) { my $input = $input[$li]; my $org = $org[$li]; my $str = join('', map(($_ >= 0x20) ? chr($_) : '?', @$input)); my $lineno = $li + 1; print < HTML if( $org ) { print map(qq{}, @$org); } # 文字 print < HTML while( $str ne '' ) { $str =~ s/^(.[\x80-\xbf]*)//; my $chr = $1; my $clen = length($chr); $chr = &encode_data($chr); print qq{\n}; } # 8進 print < HTML foreach my $chr (@$input) { $_ = sprintf('%o', $chr); print qq{\n}; } # 10進 print < HTML foreach my $chr (@$input) { $_ = sprintf('%d', $chr); print qq{\n}; } # 16進 print < HTML foreach my $chr (@$input) { $_ = sprintf('%02X', $chr); print qq{\n}; } # UTF-8結合チェック print < HTML my @bincells = (); my @uni = (); my $seconds = 0; foreach my $chr (reverse(@$input)) { my $bits = join('', unpack('B8', chr($chr))); $bits =~ s{^(1*0)} {}; my $ctrl = $1; my $col; if( $ctrl eq '10' ) { $col = $COL_CONT; $seconds++; }else{ if( $ctrl ne '0' ) { $seconds -= length($ctrl) - 2; } if( $seconds ) { $col = $COL_NG; }else{ $col = $COL_OK; } $seconds = 0; } unshift(@bincells, qq{}); unshift(@uni, [$ctrl, $bits]); } print @bincells, "\n"; # 実行 print < HTML my @chars = (); while( my $bcb = shift(@uni) ) { my $span = 1; my $bits = $bcb->[1]; while( @uni and $uni[0][0] eq '10' ) { $span++; $bits .= shift(@uni)->[1]; } $bits =~ s/^0+//; if( my $add = (8 - length($bits) % 8) % 8 ) { $bits = substr('00000000', 0, $add) . $bits; } $bits =~ s/(.{4})/$1 /g; push(@chars, [$span, $bits]); print qq{\n}; } # 番号 print < HTML foreach my $char (@chars) { my ($span, $bits) = @$char; my $uno = 0; while( $bits ne '' ) { $uno <<= 8; $bits =~ s/^(....)\s+(....)\s*//; $uno += ord(pack('B*', $1 . $2)); } push(@$char, $uno); printf qq{\n}, $uno; } # 文字 print < HTML my $normstr = ''; foreach my $char (@chars) { my ($span, $bits, $code) = @$char; my $str = $ASCTRL[$code] || sprintf(qq{&#X\%X;}, $code); print qq{\n}; $normstr .= $str; } print <
第 $lineno 行
入力の
解釈
入力値$_
文字$chr
8進$_
10進$_
16進$_
UTF-8
結合
チェック$ctrl$bits
実行$bits
Unicode 番号U+\%02X
文字
$str
HTML print qq{$normstr
\n}; } } sub term{ print <
UTF-8結合の説明
01バイト文字を意味するビットパターンです。
1102バイト文字の先頭バイトを意味するビットパターンです。
11103バイト文字の先頭バイトを意味するビットパターンです。
102バイト以上の文字中の、継続バイト(第2バイト以降)を意味するビットパターンです。
xx各種の先頭バイトにあるビットパターンのうち、自身が表現するバイト長と伴う継続バイト数が不一致のものです。 これが現われたときは、入力文字列はUTF-8でもASCIIでも無いコードかも知れません。

このCGIをゲットする (実行には Perl 5.6 以上が必要です。 他にも、サーバーが変ったら不都合が出るかも知れません)

姉妹CGI
    HTML foreach my $lp (@LINK) { print qq{
  1. $lp->[1]\n}; } print < HTML } sub dlcgi{ open(CNT, ">>$0.dl.log"); print CNT "\n"; close(CNT); local $cgipath = $ENV{'SCRIPT_FILENAME'}; $cgipath =~ s|^.*/||; print("Content-type: text/plain; charset=UTF-8\r\n"); print(qq|Content-Disposition: filename="$cgipath"\r\n|); print("\r\n"); if( ! open(CGI, $cgipath) ) { print("失敗しました。\r\n"); print("$cgipath $!\r\n"); exit 1; } while() { s/\n/\r\n/; print; } close(CGI); } sub encode_data{ my $in = shift; if( ! defined($in) ) { return ''; } $in =~ s|([&<>\"])| sprintf('&#X%02X;', ord($1)) |eg; return $in; } sub decode_data{ my $in = shift; if( ! defined($in) ) { return ''; } $in =~ s{(&(?:(\w+)|(?:#x([\da-f]+))|(?:#(\d+)));?)} {&_decode($1, $2, $3, $4)}eig; return $in; sub _decode{ my $whole = shift; my $nim = shift; my $hex = shift; my $dec = shift; my $chr; if( $nim ) { $chr = {'lt' => '<', 'gt' => '>', 'amp' => '&', 'quot' => '"'}->{$nim}; }elsif( $hex ) { $chr = chr(hex($hex)); }else{ $chr = chr($dec); } return defined($chr) ? $chr : $whole; } } sub encode_url{ my $path = shift; if( ! defined($path) ) { return ''; } $path =~ s|([^ \$\-_\.\!\*\(\)\w/])| sprintf("%%%02lX", ord($1)) |egi; $path =~ s| |+|g; return $path; }