File Coverage

blib/lib/Lingua/Stem/Patch.pm
Criterion Covered Total %
statement 27 28 96.4
branch 3 4 75.0
condition n/a
subroutine 8 8 100.0
pod 2 2 100.0
total 40 42 95.2


line stmt bran cond sub pod time code
1             package Lingua::Stem::Patch;
2              
3 2     2   49613 use v5.8.1;
  2         9  
  2         94  
4 2     2   10 use utf8;
  2         2  
  2         13  
5 2     2   37 use Carp;
  2         14  
  2         147  
6              
7 2     2   1037 use Moo;
  2         22981  
  2         9  
8 2     2   3301 use namespace::clean;
  2         19001  
  2         10  
9              
10             our $VERSION = '0.06';
11              
12             my @languages = qw( eo io pl );
13             my %is_language = map { $_ => 1 } @languages;
14              
15             has language => (
16             is => 'rw',
17             isa => sub { croak "Invalid language '$_[0]'"
18             unless $is_language{$_[0]} },
19             coerce => sub { defined $_[0] ? lc $_[0] : '' },
20             trigger => sub { $_[0]->_clear_stemmer },
21             required => 1,
22             );
23              
24             has aggressive => (
25             is => 'rw',
26             coerce => sub { !!$_[0] },
27             trigger => sub { $_[0]->_clear_stemmer },
28             default => 0,
29             );
30              
31             has _stemmer => (
32             is => 'rw',
33             builder => '_build_stemmer',
34             clearer => '_clear_stemmer',
35             lazy => 1,
36             );
37              
38             sub _build_stemmer {
39 3     3   391 my $self = shift;
40 3         51 my $language = uc $self->language;
41 3         20 my $function = 'stem';
42              
43 3 50       33 if ($self->aggressive) {
44 0         0 $function .= '_aggressive';
45             }
46              
47 3         1426 require "Lingua/Stem/Patch/$language.pm";
48 3         7 $self->_stemmer( \&{"Lingua::Stem::Patch::${language}::${function}"} );
  3         85  
49             }
50              
51             sub languages {
52 6     6 1 2431 return @languages;
53             }
54              
55             sub stem {
56 9     9 1 841 my $self = shift;
57 9         16 my @stems = map { $self->_stemmer->($_) } @_;
  11         228  
58              
59 9 100       51 return wantarray ? @stems : pop @stems;
60             }
61              
62             1;
63              
64             __END__