File Coverage

blib/lib/Word/Segmenter/Chinese/Lite.pm

Criterion	Covered	Total	%
statement	56	57	98.2
branch	13	16	81.2
condition	6	11	54.5
subroutine	10	10	100.0
pod	2	5	40.0
total	87	99	87.8

package Word::Segmenter::Chinese::Lite;

use 5.008008;
use strict;
use warnings;

use Encode;
use Word::Segmenter::Chinese::Lite::Dict qw(wscl_get_dict_default);

require Exporter;
our @ISA     = qw(Exporter);
our @EXPORT  = qw(wscl_seg wscl_set_mode);
our $VERSION = '0.08';

our $WSCL_MODE = 'dict';
our %WSCL_DICT;

sub wscl_set_mode {
    my $mode = shift;
    if ( $mode eq 'dict' or $mode eq 'obigram' or $mode eq 'unigram' ) {
        $WSCL_MODE = $mode;
    }
    return 0;
}

sub wscl_seg {
    my $str = shift;
    if ( $WSCL_MODE eq 'dict' ) {
        %WSCL_DICT = wscl_get_dict_default() unless defined $WSCL_DICT{'1'};
        return wscl_seg_dict($str);
    }
    if ( $WSCL_MODE eq 'obigram' ) {
        return wscl_seg_obigram($str);
    }
    if ( $WSCL_MODE eq 'unigram' ) {
        return wscl_seg_unigram($str);
    }
    return 0;
}

sub wscl_seg_unigram {
    my $w = shift;
    my @r = map { $_ = encode( 'utf8', $_ ) } split //, decode( 'utf8', $w );
    return @r;
}

sub wscl_seg_obigram {
    my $w = shift;
    my @r;
    for ( 0 .. length( decode( 'utf8', $w ) ) ) {
        my $tmp = encode( 'utf8', substr( decode( 'utf8', $w ), $_, 2 ) );
        push @r, $tmp;
    }
    return @r;
}

sub wscl_seg_dict {
    my $string = shift;
    my $real_max_length = shift || 9;

    my $line = decode( 'utf8', $string );
    my $len = length($line);
    return 0 if !$len or $len <= 0;

    my @result;
    my @eng = $line =~ /[A-Za-z0-9\-\_\:\.]+/g;
    unshift @result, @eng;

    while ( length($line) >= 1 ) {
        for ( 0 .. $real_max_length - 1 ) {
            my $len = $real_max_length - $_;
            my $w = substr( $line, $_ - $real_max_length );
            if ( defined $WSCL_DICT{$len}{$w} ) {
                unshift @result, encode( 'utf8', $w );
                $line =
                  substr( $line, 0, length($line) - ( $real_max_length - $_ ) );
                last;
            }

            if ( $_ == $real_max_length - 1 ) {
                $line = substr( $line, 0, length($line) - 1 );
            }
        }
    }
    return @result;
}

1;
__END__