File Coverage

blib/lib/Search/Fulltext/Tokenizer/MeCab.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Search::Fulltext::Tokenizer::MeCab;
use strict;
use warnings;

use Carp;

our $VERSION = '1.05';
use Text::MeCab;
use Encode;

use File::Basename;
use Cwd;

use constant PREINSTALL_DICS => 'op.dic';  # '1.dic, 2.dic, 3.dic'

sub _mk_userdic_paths {
    my $libdir = Cwd::realpath(dirname(__FILE__));
    my $dicdir = "${libdir}/../../../../share/dic";

    # to pass tests even if this module file is put under blib/ directory.
    # FIXME: too ugly...
    unless (-d $dicdir) { $dicdir = "${libdir}/../../../../../share/dic" }

    my $p = "${dicdir}/" . PREINSTALL_DICS;
    if ($ENV{'MECABDIC_USERDIC'}) { $p .= ", $ENV{'MECABDIC_USERDIC'}" }
    $p;
}

sub _dbglog {
    my $str = shift;
    binmode(STDERR, ":utf8");
    if ($ENV{'MECABDIC_DEBUG'} && $ENV{'MECABDIC_DEBUG'} != '0') {
        print STDERR "$str";
    }
}

sub tokenizer {
    my $mecab = Text::MeCab->new({
        userdic => _mk_userdic_paths,
    });

    return sub {
        my $string     = shift;
        my $term_index = 0;
        my $node       = $mecab->parse($string);
        _dbglog "string to be parsed: $string (" . length($string) . ")\n";

        return sub {
            my $term  = Encode::decode_utf8 $node->surface or return;
            my $len   = length $term;
            _dbglog "token: $term ($len)\n";
            my $start = index($string, $term);
            my $end   = $start + $len;
            $start >= 0 or croak '$term must be included in $string';
            $node = $node->next or return;
            return ($term, $len, $start, $end, $term_index++);
        }
    };
}

1;
__END__