File Coverage

blib/lib/Lingua/JA/Categorize/Tokenizer.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Lingua::JA::Categorize::Tokenizer;
use strict;
use warnings;
use Lingua::JA::TFIDF;
use base qw( Lingua::JA::Categorize::Base );

__PACKAGE__->mk_accessors($_) for qw( calc user_extention);

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->calc( Lingua::JA::TFIDF->new( %{ $self->config } ) );
    return $self;
}

sub tokenize {
    my $self      = shift;
    my $text_ref  = shift;
    my $threshold = shift;

    my $text = $$text_ref;
    my $http_URL_regex
        = q{\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f}
        . q{][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)}
        . q{*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.}
        . q{[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f]}
        . q{[0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-}
        . q{Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f}
        . q{])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)}
        . q{*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])}
        . q{*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*}
        . q{)?};
    $text =~ s/$http_URL_regex//g;

    my $tfidf_result = $self->calc->tfidf($text);

    my %user_extention;
    while ( my ( $keyword, $ref ) = each %{ $tfidf_result->{data} } ) {
        my @f = split( ",", $ref->{info} );
        if ( $f[6] eq 'ユーザ設定' ) {
            $user_extention{$keyword} = $f[9];
        }
    }
    $self->user_extention( \%user_extention );

    my $list = $tfidf_result->list($threshold);
    my %hash;
    for (@$list) {
        my ( $word, $score ) = each(%$_);
        $hash{$word} = $score;
    }
    return \%hash;
}

1;
__END__