Perlでカラム数単位のlengthとsubstrを作ってみる
1バイト文字とキャラクター端末の時代には、文字数とバイト数、画面上の桁数(カラム数)の3つは同じでした。シフトJISや古いEUC-JPの時代にも、文字数はともかく、バイト数とカラム数は(偶然?)同じでした。
現在では、これらは異なります。たとえばPerlで「あ」を内部コード表現にした場合、1文字/3バイト/2カラムとなります。
「graph-easyでテキストのハコ図をらくらく生成」で紹介したPerlのGraph::Easyモジュールは、内部コードの1文字=1カラムを前提にして、lengthとsubstrでテキストのハコ図を描いています。lengthもsubstrも文字数単位で数える仕様です。そのため、日本語ではカラムがずれてしまいます。
そこで、カラム単位で処理するlengthとsubstr相当のルーチンを作って置きかえてみました。Unicode::EastAsianWidthモジュールを使っています。方針は次のとおり。
- lengthやsubstrとさしかえても、1バイト文字での挙動は変わらないこと(substrの左辺値には対応できませんでしたが)
- 1バイト文字の場合にできるだけオーバーヘッドが少ないこと
けっこう意外だったのが、「ü」がEast Asian WidthでAmbiguousになっていることでした。最初「■」などを考えてAmbiguousをデフォルトで全角扱いにしていたのですが、Graph::Easyのテストケースでは「ü」が1カラムとして扱われる想定になっていて、エラーになってしまいました。
とりあえずGraph::Easy内のモジュールとして作ったものを下に貼ります。独立したモジュールにしてもいい気もしますが、気のせいかもしれません。
Graph::Easy全体へのパッチは pastebin(テキスト共有サイト)に期限1か月で貼っておきます。人柱希望のかたはどうぞ。基本的に、lengthとsubstrを置き換えているだけですが、テストケースは通っています。本家に取り込んでもらったほうが楽ではあるものの、日本語の問題を説明するのは正直面倒だなぁ。
package Graph::Easy::UnicodeColumn;
use strict;
use warnings;
use Unicode::EastAsianWidth;
my @EXPORT = qw( columnlength columnsubstr );
use constant FULLWIDTH_WITH_AMBI_RE
=> qr/[\p{InFullwidth}\p{InEastAsianAmbiguous}]/;
use constant FULLWIDTH_WITHOUT_AMBI_RE => qr/\p{InFullwidth}/;
my $FULLWIDTH_RE = FULLWIDTH_WITHOUT_AMBI_RE;
sub import {
no strict 'refs';
my $module = shift;
my %opt = @_;
my $callpkg = caller;
*{"${callpkg}::$_"} = \&$_ for (@EXPORT);
if (exists $ENV{'UNICODECOLUMN_AMBIWIDTH'}) {
if ($ENV{'UNICODECOLUMN_AMBIWIDTH'} eq 'double') {
$FULLWIDTH_RE = FULLWIDTH_WITH_AMBI_RE;
}
} elsif (exists $opt{'ambiwidth'} && $opt{'ambiwidth'} eq 'double') {
$FULLWIDTH_RE = FULLWIDTH_WITH_AMBI_RE;
}
}
sub columnlength {
my $str = shift;
my $lenw = 0;
while ($str =~ m/${FULLWIDTH_RE}+/g) {
# strings without fullwidth character never step into this loop
$lenw += length($&);
}
$lenw + length($str);
}
sub columnsubstr {
if ($_[0] =~ /\P{InBasicLatin}/) {
columnsubstr_mb(@_);
} else {
# if no mult-byte-characer, just call substr (for efficiency).
if (exists $_[3]) {
substr($_[0], $_[1], $_[2], $_[3]);
} else {
substr($_[0], $_[1], $_[2]);
}
}
}
sub columnsubstr_mb {
my ($str, $pos, $len, $replace) = @_;
die if ($len <= 0);
my @ary = split //, $str;
my $reversed;
if ($pos < 0) {
@ary = reverse(@ary);
$pos = -1 - $pos;
$reversed = 1;
}
my $sum;
my $start = 0;
for ($sum = 0; $sum < $pos; $start++) {
$sum += ($ary[$start] =~ /${FULLWIDTH_RE}/ ? 2 : 1 );
}
splice(@ary, $start++, 1, (' ', ' ')) if ($sum > $pos);
my $end = $start;
for ($sum = 0; $sum < $len; $end++) {
$sum += (defined($ary[$end]) &&
$ary[$end] =~ /${FULLWIDTH_RE}/ ? 2 : 1 );
}
$end--;
splice(@ary, $end, 1, (' ', ' ')) if ($sum > $len);
my $ret;
if (defined wantarray) {
my @part = @ary[$start..$end];
$ret = join('', $reversed ? reverse(@part) : @part);
}
if (defined $replace) {
splice(@ary, $start, $end - $start + 1, ($replace));
$_[0] = join('', $reversed ? reverse(@ary) : @ary);
}
$ret;
}
1;
__END__
=head1 NAME
Graph::Easy::UnicodeColumn - subroutines to handle colums of unicode string
=head1 SYNOPSIS
use Graph::Easy::UnicodeColumn;
# or
use Graph::Easy::UnicodeColumn ambiwidth => 'double';
=head1 DESCRIPTION
=over 4
=item columnlength STRING
return how many columns contains in STRING.
=item columnsubstr STRING, OFFSET, LENGTH
=item columnsubstr STRING, OFFSET, LENGTH, REPLACEMENT
Similar to substr, but OFFSET and LENGTH is given as column number.
Also, columnsubstr can't be lvalue.
=back
=head1 "AMBIGUOUS" WIDTH
By default, characters that have "Ambiguous" East Asian Width is
treated as single column width.
When "ambiwidth => 'double'" is given to "use Graph::Easy::UnicodeColumn",
or environment variable UNICODECOLUMN_AMBIWIDTH is set to 'double',
characters that have "Ambiguous" East Asian Width is treated as
double column width.
=head1 ATENTION
Multibyte characters in strings must be utf-8 flagged.
=head1 COPYRIGHT
Copyright (c) 2008 Masakazu Takahasi L<http://emasaka.blog65.fc2.com/>.
=cut
コメント
コメントの投稿
トラックバック
http://emasaka.blog65.fc2.com/tb.php/504-afcc3d4c
