File Coverage

blib/lib/Text/VisualWidth/PP.pm

Criterion	Covered	Total	%
statement	47	48	97.9
branch	13	14	92.8
condition			n/a
subroutine	14	15	93.3
pod	0	9	0.0
total	74	86	86.0

package Text::VisualWidth::PP;
use strict;
use warnings;
use 5.008001;
use parent qw(Exporter);
our $VERSION = '0.08';
use Unicode::EastAsianWidth;

our @EXPORT_OK = qw(vwidth vtrim);

our $EastAsian = $Unicode::EastAsianWidth::EastAsian;

if ($^V lt v5.32) {
    no strict 'refs';
    *{"utf8::Is_Emoji_Modifier"} = sub { "1F3FB\t1F3FF\n" };
};

sub Spacing {
    $_[0] . <
-utf8::Nonspacing_Mark
-utf8::Enclosing_Mark
-utf8::Default_Ignorable_Code_Point
-utf8::Is_Emoji_Modifier
END
}

sub InVWPP1Fullwidth() {
    Spacing
    InEastAsianFullwidth() . InEastAsianWide() . InEastAsianAmbiguous()
}
sub InVWPP0Fullwidth() {
    Spacing
    InEastAsianFullwidth() . InEastAsianWide()
}
sub InVWPP1Halfwidth() {
    Spacing
    InEastAsianHalfwidth().
    InEastAsianNarrow().
    InEastAsianNeutral()
}
sub InVWPP0Halfwidth() {
    Spacing
    InEastAsianHalfwidth().
    InEastAsianNarrow().
    InEastAsianNeutral().
    InEastAsianAmbiguous()
}

sub vwidth { width(@_) }
sub vtrim  {  trim(@_) }

# E_Modifier not following E_Base has full-width visual representation
my $EM = $^V ge v5.28 ? '(?>(?
                      : '(?!)' ;
$EM = qr/$EM/; # to avoid error on v5.24

sub width {
    my $str = shift;

    my $ret = 0;
    if ($EastAsian) {
        while ($str =~ /((?:$EM|(?
                       |((?:    (?
            $ret += $1 ? length($1) * 2 : length($2)
        }
    } else {
        while ($str =~ /((?:$EM|(?
                       |((?:    (?
            $ret += $1 ? length($1) * 2 : length($2)
        }
    }
    $ret;
}

sub trim {
    my ($str, $limit) = @_;

    my $cnt = 0;
    my $ret = '';
    my $fullwidth = $EastAsian ? qr/\p{InVWPP1Fullwidth}/ : qr/\p{InVWPP0Fullwidth}/;
    while ($str =~ /\G(\X)/g) {
        my $ch = $1;
        my $w = do {
            if ($ch =~ /\A$fullwidth\z/) {
                2;
            } elsif (length($ch) == 1) {
                1;
            } else {
                width($ch);
            }
        };
        if ($cnt+$w <= $limit) {
            $ret .= $ch;
            $cnt += $w;
        } else {
            last;
        }
    }
    $ret;
}

1;
__END__