File Coverage

lib/Sisimai/String.pm

Criterion	Covered	Total	%
statement	74	77	96.1
branch	26	32	81.2
condition	19	22	86.3
subroutine	11	11	100.0
pod	4	6	66.6
total	134	148	90.5

package Sisimai::String;
use v5.26;
use strict;
use warnings;
use Encode;

my $EncodingsC = [qw/big5-eten gb2312/];
my $EncodingsE = [qw/iso-8859-1/];
my $EncodingsJ = [qw/7bit-jis iso-2022-jp euc-jp shiftjis/];
use Encode::Guess; Encode::Guess->add_suspects(@$EncodingsC, @$EncodingsE, @$EncodingsJ);
sub encodenames { return [@$EncodingsC, @$EncodingsE, @$EncodingsJ] };

sub is_8bit {
    # The argument is 8-bit text or not
    # @param    [String] argv1  Any string to be checked
    # @return   [Integer]       0: ASCII Characters only
    #                           1: Including 8-bit character
    my $class = shift;
    my $argv1 = shift // return 0; return 0 if ref $argv1 ne 'SCALAR';
    return 1 unless $$argv1 =~ /\A[\x00-\x7f]+\z/;
    return 0;
}

sub sweep {
    # Clean the string out
    # @param    [String] argv1  String to be cleaned
    # @return   [Scalar]        Cleaned out string
    # @example  Clean up text
    #   sweep('  neko ') #=> 'neko'
    my $class = shift;
    my $argv1 = shift // return "";

    chomp $argv1;
    y/ //s, s/\A //g, s/ \z//g, s/ [-]{2,}[^ ].+\z// for $argv1;
    return $argv1;
}

sub aligned {
    # Check if each element of the 2nd argument is aligned in the 1st argument or not
    # @param    [String] argv1  String to be checked
    # @param    [Array]  argv2  List including the ordered strings
    # @return   [Bool]          0, 1
    # @since v5.0.0
    my $class = shift;
    my $argv1 = shift || return 0; return 0 unless length $$argv1;
    my $argv2 = shift || return 0; return 0 unless scalar @$argv2;
    my $align = -1;
    my $right =  0;

    for my $e ( @$argv2 ) {
        # Get the position of each element in the 1st argument using index()
        my $p = index($$argv1, $e, $align + 1);

        last if $p < 0;                 # Break this loop when there is no string in the 1st argument
        $align = length($e) + $p - 1;   # There is an aligned string in the 1st argument
        $right++;
    }
    return 1 if $right == scalar @$argv2;
    return 0;
}

sub to_plain {
    # Convert given HTML text to plain text
    # @param    [Scalar]  argv1 HTML text(reference to string)
    # @param    [Integer] loose Loose check flag
    # @return   [Scalar]        Plain text(reference to string)
    my $class = shift;
    my $argv1 = shift // return undef; return undef if ref $argv1 ne 'SCALAR';
    my $loose = shift // 0;
    my $plain = $$argv1;

    state $match = {
        'html' => qr|].+?|sim,
        'body' => qr|.+.*].+|sim,
    };

    if( $loose || $plain =~ $match->{'html'} || $plain =~ $match->{'body'} ) {
        #  ...
        # 1. Remove ...
        # 2. Remove ...
        # 3. ... to " http://... "
        # 4. ... to " Value  "
        s|.+||gsim,
        s|.+||gsim,
        s|(.*?)| [$2]($1) |gsim,
        s|(.*?)| [$2](mailto:$1) |gsim,
        s/<[^<@>]+?>\s*/ /g,    # Delete HTML tags except
        s/</
        s/>/>/g,             # Convert to right angle brackets
        s/&/&/g,            # Convert to "&"
        s/"/"/g,           # Convert to '"'
        s/'/'/g,           # Convert to "'"
        s/ / /g for $plain;

        if( length($$argv1) > length($plain) ) {
            $plain =~ y/ //s;
            $plain .= "\n"
        }
    }
    return \$plain;
}

sub to_utf8 {
    # Convert given string to UTF-8
    # @param    [String] argv1  String to be converted
    # @param    [String] argv2  Encoding name before converting
    # @return   [String]        UTF-8 Encoded string
    my $class = shift;
    my $argv1 = shift || return "";
    my $argv2 = shift;

    state $dontencode = ['utf8', 'utf-8', 'us-ascii', 'ascii'];
    my $tobeutf8ed = $$argv1;
    my $encodefrom = lc $argv2 || '';
    my $hasencoded = 0;
    my $hasguessed = Encode::Guess->guess($tobeutf8ed);
    my $encodingto = ref $hasguessed ? lc($hasguessed->name) : '';

    if( $encodefrom ) {
        # The 2nd argument is a encoding name of the 1st argument
        while(1) {
            # Encode a given string when the encoding of the string is neigther
            # utf8 nor ascii.
            last if grep { $encodefrom eq $_ } @$dontencode;
            last if grep { $encodingto eq $_ } @$dontencode;

            eval {
                # Try to convert the string to UTF-8
                Encode::from_to($tobeutf8ed, $encodefrom, 'utf8');
                $hasencoded = 1;
            };
            last;
        }
    }
    return \$tobeutf8ed if $hasencoded;
    return \$tobeutf8ed unless $encodingto;
    return \$tobeutf8ed if grep { $encodingto eq $_ } @$dontencode;

    # a. The 2nd argument was not given or failed to convert from $encodefrom to UTF-8
    # b. Guessed encoding name is available, try to encode using it.
    # c. Encode a given string when the encoding of the string is neigther utf8 nor ascii.
    eval { Encode::from_to($tobeutf8ed, $encodingto, 'utf8') };
    return \$tobeutf8ed;
}

1;
__END__