File Coverage

blib/lib/Format/CN.pm

Criterion	Covered	Total	%
statement	57	62	91.9
branch	20	34	58.8
condition	15	16	93.7
subroutine	10	10	100.0
pod	0	1	0.0
total	102	123	82.9

package Format::CN;
{
    $Format::CN::VERSION = '0.01';
}
use strict;
use warnings;
use Encode qw/encode decode is_utf8/;
use Sub::Exporter -setup => {exports => ['f']};
use Carp qw/carp croak/;

sub f {
    my %args = @_;
    my ($output, $perl_internal);
    my ($in,     $out);
    my $en = $args{encoding} || 'utf8';
    if ($args{output}) {
        open $out, ">:encoding($en)", $args{output} or die $!;
    } else {
        $out = *STDOUT;
    }

    if ($args{content}) {
        if (!$args{encoding}) {
            if (is_utf8($args{encoding})) {
                open $in, "<", \$args{content} or die $!;
            } else {
                open $in, "<:encoding(utf8)", \$args{content} or die $!;
            }
        } else {
            open $in, "<:encoding($args{encoding})", \$args{content}
              or die $!;
        }
        return _format($in, $out);
    } elsif ($args{file}) {
        $args{encoding} ||= 'utf8';
        open $in, "<:encoding($args{encoding})", $args{file} or die $!;
        return _format($in, $out);
    } else {
        return;
    }
}

sub _format($$) {
    my ($input_fh, $output_fh) = @_;
    my ($n_is_han, $p_is_han, $p_is_pun, $n_is_pun, $n_is_others);
    while (my $c = getc($input_fh)) {
        if ($c =~ /\p{han}/) {
            $n_is_han = 1;
            $n_is_pun = 0;
            $ENV{DEBUG_MATCH} && print "get han $c\n";
        } elsif ($c =~ /\p{p}/) {
            $n_is_han = 0;
            $n_is_pun = 1;
            $ENV{DEBUG_MATCH} && print "get punctuation $c\n";
        } elsif ($c =~ /\s/s) {
            $n_is_others = 1;
        } else {
            $n_is_han = 0;
            $n_is_pun = 0;
            $ENV{DEBUG_MATCH} && print "get others" . ord($c) . "\n";
        }
        (        defined $p_is_han
              && !$n_is_others
              && !$n_is_pun
              && ($n_is_han ^ $p_is_han)
              && !$p_is_pun)
          && print $output_fh " ";

        print $output_fh $c;
        $p_is_han = $n_is_han;
        $p_is_pun = $n_is_pun;
    }
    close $input_fh;
    close $output_fh;
}

1;

__END__