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   58361 use v5.8.1;
  2         8  
  2         82  
4 2     2   10 use utf8;
  2         3  
  2         14  
5 2     2   44 use Carp;
  2         5  
  2         178  
6              
7 2     2   1273 use Moo;
  2         54828  
  2         13  
8 2     2   4183 use namespace::clean;
  2         22412  
  2         13  
9              
10             our $VERSION = '0.05';
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   358 my $self = shift;
40 3         48 my $language = uc $self->language;
41 3         18 my $function = 'stem';
42              
43 3 50       33 if ($self->aggressive) {
44 0         0 $function .= '_aggressive';
45             }
46              
47 3         1436 require "Lingua/Stem/Patch/$language.pm";
48 3         7 $self->_stemmer( \&{"Lingua::Stem::Patch::${language}::${function}"} );
  3         79  
49             }
50              
51             sub languages {
52 6     6 1 1838 return @languages;
53             }
54              
55             sub stem {
56 9     9 1 660 my $self = shift;
57 9         16 my @stems = map { $self->_stemmer->($_) } @_;
  11         207  
58              
59 9 100       51 return wantarray ? @stems : pop @stems;
60             }
61              
62             1;
63              
64             __END__