diff --git a/lib/Text/FormatTable.pm b/lib/Text/FormatTable.pm index 5c2a7af..ccc4856 100644 --- a/lib/Text/FormatTable.pm +++ b/lib/Text/FormatTable.pm @@ -4,6 +4,10 @@ use Carp; use strict; use warnings; use vars qw($VERSION); +use Unicode::GCString; +use Unicode::LineBreak; +use Text::LineFold; +use Encode; $VERSION = '1.03'; @@ -32,24 +36,39 @@ Methods: =cut +sub _linefold_columns_min { + my $str = shift; + my $min; + my $lb = Unicode::LineBreak->new( ColMax => 1 ); + foreach ($lb->break($str)) { + my $l = $_->columns; + $min = $l if not defined $min or $l > $min; + } + return $min ? $min : 1; +} + +sub _columns { + my $str = scalar shift; + + return 0 if ( !defined $str || $str eq '' ); + + $str = decode_utf8($str) unless utf8::is_utf8($str); + return Unicode::GCString->new($str)->columns(); +} + # Remove ANSI color sequences when calculating length sub _uncolorized_length($) { my $str = shift; $str =~ s/\e \[ [^m]* m//xmsg; - return length $str; + return _columns $str; } # minimal width of $1 if word-wrapped sub _min_width($) { my $str = shift; - my $min; - for my $s (split(/\s+/,$str)) { - my $l = _uncolorized_length $s; - $min = $l if not defined $min or $l > $min; - } - return $min ? $min : 1; + return _linefold_columns_min $str; } # width of $1 if not word-wrapped @@ -71,63 +90,17 @@ sub _max($$) sub _wrap($$) { my ($width, $text) = @_; - my @lines = split(/\n/, $text); my @w = (); - for my $l (@lines) { - push @w, @{_wrap_line($width, $l)}; - } + my $lf = Text::LineFold->new( ColMax => $width ); + @w = split /\n/, + decode_utf8( + $lf->fold( + '', '', utf8::is_utf8($text) ? encode_utf8($text) : $text + ) + ); return \@w; } -sub _wrap_line($$) -{ - my ($width, $text) = @_; - my $width_m1 = $width-1; - my @t = ($text); - while(1) { - my $t = pop @t; - my $l = _uncolorized_length $t; - if($l <= $width){ - # last line is ok => done - push @t, $t; - return \@t; - } - elsif($t =~ /^(.{0,$width_m1}\S)\s+(\S.*?)$/) { - # farest space < width - push @t, $1; - push @t, $2; - } - elsif($t =~ /(.{$width,}?\S)\s+(\S.*?)$/) { - # nearest space > width - if ( _uncolorized_length $1 > $width_m1 ) - { - # hard hyphanation - my $left = substr($1,0,$width); - my $right= substr($1,$width); - - push @t, $left; - push @t, $right; - push @t, $2; - } - else - { - push @t, $1; - push @t, $2; - } - } - else { - # hard hyphanation - my $left = substr($t,0,$width); - my $right= substr($t,$width); - - push @t, $left; - push @t, $right; - return \@t; - } - } - return \@t; -} - # render left-box $2 with width $1 sub _l_box($$) { diff --git a/test.pl b/test.pl index 94d3d07..6d90cac 100644 --- a/test.pl +++ b/test.pl @@ -5,6 +5,7 @@ use strict; use warnings; +use utf8; { my $table = Text::FormatTable->new('r| l l'); @@ -17,20 +18,19 @@ my $is = $table->render(15); my $shouldbe = <<'END'; - a| b c -================= -this a| oh, yep - test,| cool, -a nice| a - test| test! -------+---------- - you| yes, z - mean| it - it's| is. -really| - a| - test?| -================= + a| b c +==================== + this a| oh, yep +test, a| cool, a + nice| test! + test| +-------+------------ + you| yes, it z + mean| is. + it's| + really| +a test?| +==================== END ok($is, $shouldbe); @@ -72,3 +72,85 @@ END my $output = $table->render(); ok(not defined $warning); } + +# line folding using Text::LineFold +{ + my @format = (' 14l ', ' 20L ', ' 30r ', ' 40R '); + my $table = Text::FormatTable->new( '|' . ( join '|', @format ) . '|' ); + my @text = (); + push @text, +q(This document is intended to give you a quick overview of the Perl programming language, along with pointers to further documentation. It is intended as a "bootstrap" guide for those who are new to the language, and provides just enough information for you to be able to read other peoples' Perl and understand roughly what it's doing, or write your own simple scripts.); + push @text, +q(この文書は Perl プログラミング言語の簡単な概要を伝えて、更なる 文書へのポインタを示すことを目的としています。 これはこの言語を知らない人のためへの「自習」ガイドを目的としていて、 他の人の Perl を読んで何をしているかを大まかに理解したり、 自分自身で簡単なスクリプトを書くことができるようになるために 十分な情報を提供しています。); + $table->rule('-'); + $table->head(@format); + foreach my $text (@text) { + $table->rule('-'); + $table->row( map { $text } ( 0 .. $#format ) ); + } + $table->rule('-'); + my $is = $table->render(); + my $shouldbe = <<'END'; ++----------------+----------------------+--------------------------------+------------------------------------------+ +| 14l | 20L | 30r | 40R | ++----------------+----------------------+--------------------------------+------------------------------------------+ +| This document | | This document is intended to | | +| is intended to | | give you a quick overview of | | +| give you a | | the Perl programming language, | | +| quick overview | | along with pointers to further | | +| of the Perl | | documentation. It is intended | | +| programming | | as a "bootstrap" guide for | | +| language, | | those who are new to the | | +| along with | | language, and provides just | | +| pointers to | | enough information for you to | | +| further | | be able to read other peoples' | | +| documentation. | | Perl and understand roughly | | +| It is intended | This document is | what it's doing, or write your | | +| as a | intended to give you | own simple scripts. | | +| "bootstrap" | a quick overview of | | | +| guide for | the Perl programming | | | +| those who are | language, along with | | | +| new to the | pointers to further | | | +| language, and | documentation. It is | | | +| provides just | intended as a | | | +| enough | "bootstrap" guide | | | +| information | for those who are | | | +| for you to be | new to the language, | | This document is intended to give you a | +| able to read | and provides just | | quick overview of the Perl programming | +| other peoples' | enough information | | language, along with pointers to further | +| Perl and | for you to be able | | documentation. It is intended as a | +| understand | to read other | | "bootstrap" guide for those who are new | +| roughly what | peoples' Perl and | | to the language, and provides just | +| it's doing, or | understand roughly | | enough information for you to be able to | +| write your own | what it's doing, or | | read other peoples' Perl and understand | +| simple | write your own | | roughly what it's doing, or write your | +| scripts. | simple scripts. | | own simple scripts. | ++----------------+----------------------+--------------------------------+------------------------------------------+ +| この文書は | | この文書は Perl プログラミング | | +| Perl プログラ | | 言語の簡単な概要を伝えて、更な | | +| ミング言語の簡 | | る 文書へのポインタを示すこと | | +| 単な概要を伝え | | を目的としています。 これはこ | | +| て、更なる 文 | | の言語を知らない人のためへの | | +| 書へのポインタ | | 「自習」ガイドを目的としてい | | +| を示すことを目 | | て、 他の人の Perl を読んで何 | | +| 的としていま | この文書は Perl プロ | をしているかを大まかに理解した | | +| す。 これはこ | グラミング言語の簡単 | り、 自分自身で簡単なスクリプ | | +| の言語を知らな | な概要を伝えて、更な | トを書くことができるようになる | | +| い人のためへの | る 文書へのポインタ | ために 十分な情報を提供してい | | +| 「自習」ガイド | を示すことを目的とし | ます。 | | +| を目的としてい | ています。 これはこ | | | +| て、 他の人の | の言語を知らない人の | | | +| Perl を読んで | ためへの「自習」ガイ | | | +| 何をしているか | ドを目的としていて、 | | この文書は Perl プログラミング言語の簡単 | +| を大まかに理解 | 他の人の Perl を読ん | | な概要を伝えて、更なる 文書へのポインタ | +| したり、 自分 | で何をしているかを大 | | を示すことを目的としています。 これはこ | +| 自身で簡単なス | まかに理解したり、 | | の言語を知らない人のためへの「自習」ガイ | +| クリプトを書く | 自分自身で簡単なスク | | ドを目的としていて、 他の人の Perl を読 | +| ことができるよ | リプトを書くことがで | | んで何をしているかを大まかに理解したり、 | +| うになるために | きるようになるために | | 自分自身で簡単なスクリプトを書くことがで | +| 十分な情報を提 | 十分な情報を提供して | | きるようになるために 十分な情報を提供し | +| 供しています。 | います。 | | ています。 | ++----------------+----------------------+--------------------------------+------------------------------------------+ +END + ok( $is, $shouldbe ); +}