日本語の横幅を2としたlength, padding, alignの実装

背景

perl5 にはlength, format, printf, sprintf などのサブルーチンがあるが、これらは日本語の処理では不具合がでるように思える。3バイトであるとか1文字であるとかではなく、幅2としてカウントするものが、整形には必要だ。
よって、そういう見た目の長さを返すサブルーチンを書いた。
padding, align はそれを考慮に入れて、日英混合文で動作するようになっている。

概要

\P{ascii} で日本語であると分類している。おそらく、幅2文字のものと過不足無くマッチする。trueLength.pm では改行を除くそれ意外が1文字1幅と考えている。
padding.pm は配置する空間の大きさと文の長さが日英混合文で判れば、あとは空白で埋めるだけだ。中央揃えは 左3、文字4幅、右4 のように左右均等にならない時は左に寄る実装にした。
align.pl はそれぞれのセパレータまでの長さの最大値を調査すれば、NxMの次元のデータに対して padding を適用することで成り立つ。矩形選択できる縦に長い長方形は隣り合う長方形との間にセパレータがあったほうが見やすい。よって基本的にはq( )という1つのホワイトスペースをデフォルト値とし、必要なら替えられるようにしてある。
また、 ls -l がファイルサイズは右揃えなのにファイル名は左揃えであるように、整形方法は1つ1つ変更できるようにした。

コード

trueLength.pm

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode;

package TrueLength;

=head1 ABSTRUCT
This function returns number that counts Wide character as 2.
USAGE
    count($text_here);
=cut

sub count {
    my ( $raw_line, $Japanese, $English ) = ( shift, 0, 0 );
    return 0 unless defined $raw_line ;
    for ( split( //, Encode::decode( 'UTF8', $raw_line ) ) ) {
        /\P{ascii}/ ? ++$Japanese:
        /\N/        ? ++$English :
                             next;
    }
    2 * $Japanese + $English;
}

1;

padding.pm

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Encode;

package Padding;

=head1 ABSTRUCT
This code offer align text methods as below.
USAGE
    Left($text, $length_of_box);
    Right($text, $length_of_box);
    Center($text, $length_of_box);
=cut

require TrueLength;
sub true_length { TrueLength::count(@_) };


sub Left {
    my $text  = shift;
    my $textLn = true_length($text);
    my $boxLn = shift;
    $boxLn > $textLn ? $text . q( ) x ($boxLn - $textLn) : $text;
}
sub Right {
    my $text  = shift;
    my $textLn = true_length($text);
    my $boxLn = shift;
    $boxLn > $textLn ? q( ) x ($boxLn - $textLn) . $text : $text;
}
sub Center {
    my $text  = shift;
    my $textLn = true_length($text);
    my $boxLn = shift;
    my $LP = ($boxLn - $textLn) >> 1;
    if ($boxLn < $textLn) {
        $text;
    }
    else {
        q( ) x $LP . $text . q( ) x ($boxLn - $textLn - $LP);
    }
}

1;

align.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Smart::Comments;
use List::Util 'max';
sub say {print @_, "\n"};

use File::Basename 'basename';
my $code_name = (basename $0);
my $usage = << "EOL";
Name
    $code_name
Form
    $code_name separator align_methods::optional fill_up_char::optional
    cat /etc/passwd | $code_name :
    cat /etc/passwd | $code_name : l
    cat /etc/passwd | $code_name : c
    cat /etc/passwd | $code_name : r
    cat /etc/passwd | $code_name : lcr
    cat cvs         | $code_name "(?<=,)"
    cat cvs         | $code_name "(?=,)"
    cat cvs         | $code_name , l :
EOL

=head1 ABSTRACT
This is align program as most of ls do.
This program remove separator by default,
but lookahead and lookbehind would be help in some cases.
Method of align way are optional.
Default is left align.
If short, continue final align way.
Filling up fill_up_char is also optional.
It is just a space by default.

Form
    $code_name separator align_methods::optional fill_up_char::optional
    cat /etc/passwd | $code_name :
    cat /etc/passwd | $code_name : l
    cat /etc/passwd | $code_name : c
    cat /etc/passwd | $code_name : r
    cat /etc/passwd | $code_name : lcr
    cat cvs         | $code_name "(?<=,)"
    cat cvs         | $code_name "(?=,)"
    cat cvs         | $code_name , l :
=cut


require TrueLength;
sub true_length { TrueLength::count(@_) };

require Padding;
sub Left { Padding::Left(@_) };
sub Center { Padding::Center(@_) };
sub Right { Padding::Right(@_) };

my %opt_map = (
    l => \&Left,
    c => \&Center,
    r => \&Right,
);
# parse option
die "input align regexp as argment.\n$usage\n" if @ARGV == 0;
my @methods;
my( $delimiter, $align_way, $adding_in_gap) = @ARGV;
if (defined $align_way) {
    for my $opt (split(//, $align_way)) {
        if ($opt_map{$opt}) {
            push @methods, $opt_map{$opt};
        }
        else {
            die "Sorry. $opt is not supported option for align\n";
        }
    }
}

my (@column_widths);
my (@matrixs_ref);
OBSERB_BOX_LENGTH:
while ( my $raw_line = <STDIN> ) {
    chomp $raw_line;
    my @columns = split( /$delimiter/, $raw_line );
    push @matrixs_ref, \@columns;
    # extend list to modify map working by longer list
    push( @column_widths, 0 ) while ( $#column_widths - $#columns < 0 );
    @column_widths = map {
            $column_widths[$_] > true_length( $columns[$_] )
          ? $column_widths[$_]
          : true_length( $columns[$_] )
          ;
    } ( 0 .. $#column_widths );
}

for my $boxes_ref (@matrixs_ref) {
    my $i = 0;
    LINE:
    for my $box (@$boxes_ref) {
        
        if (defined $methods[$i]) {
            printf "%s", &{ $methods[$i] }($box, $column_widths[$i]);
        }
        elsif (defined $methods[-1]) {
            printf "%s", &{ $methods[-1] }($box, $column_widths[$i]);
        }
        else {
            printf "%s", Left($box, $column_widths[$i]);
        }
        $i++;
    }
    continue {
        print defined $adding_in_gap ? $adding_in_gap : q( );
    };
    print "\n";
}