File Coverage

blib/lib/Text/Shingle.pm

Criterion	Covered	Total	%
statement	38	47	80.8
branch	5	10	50.0
condition	1	3	33.3
subroutine	8	10	80.0
pod	4	4	100.0
total	56	74	75.6

# Copyright 2018 Francesco Nidito. All rights reserved.
#
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Text::Shingle;

use strict;
use Carp;
use Unicode::Normalize;
use Text::NGrammer;

use vars qw($VERSION);
$VERSION = '0.07';

sub new {
  my $class = shift;
  my %config = ( w => 2,       # shingles length
                 norm => 1,    # by default, enable the normalization
                 lang => 'en', # used by the sentencer
               );

  my %param = @_;

  for my $opt (keys %param) {
    croak "option $opt unsupported by version $VERSION of Text::Shingle" unless exists $config{$opt};
    croak "window size cannot be negative or zero" if $opt eq 'w' && $param{w} < 1;
    $config{$opt} = $param{$opt};
  }
  $config{version} = $VERSION;
  return bless \%config, $class;
}

sub _shingles_from_ngrams {
  my $self   = shift;
  my @ngrams = @_;

  my %shingles = ();
  for my $ngram (@ngrams) {
    my $shingle = join(' ', sort {$a cmp $b}
                            map  { ($self->{norm}) ? NFKC($_) : $_ }
                            @{$ngram}
                      );
    $shingles{$shingle} = 1 if (!exists $shingles{$shingle});
  }
  return keys %shingles;
}

sub shingle_array {
  my $self = shift;
  my $n    = scalar(@_);

  return () if $n < $self->{w};

  my $ngrammer = Text::NGrammer->new(lang => $self->{lang});
  return $self->_shingles_from_ngrams($ngrammer->ngrams_array($self->{w}, @_));
}

sub shingle_sentence {
  my $self     = shift;
  my $sentence = shift;

  my $ngrammer = Text::NGrammer->new(lang => $self->{lang});
  return $self->_shingles_from_ngrams($ngrammer->ngrams_sentence($self->{w}, $sentence));
}

sub shingle_text {
  my $self = shift;
  my $text = shift;

  my $ngrammer = Text::NGrammer->new(lang => $self->{lang});
  return $self->_shingles_from_ngrams($ngrammer->ngrams_text($self->{w}, $text));
}

1;

__END__