File Coverage

blib/lib/Lingua/Stem/Patch/IO.pm

Criterion	Covered	Total	%
statement	30	30	100.0
branch	12	12	100.0
condition			n/a
subroutine	7	7	100.0
pod	0	2	0.0
total	49	51	96.0

package Lingua::Stem::Patch::IO;

use v5.8.1;
use utf8;
use strict;
use warnings;
use parent 'Exporter';

our $VERSION   = '0.06';
our @EXPORT_OK = qw( stem stem_io stem_aggressive stem_io_aggressive );

*stem_io            = \&stem;
*stem_io_aggressive = \&stem_aggressive;

my %protect = (
    root => { map { $_ => 1 } qw(
        la li me ni on vi
    ) },
);

sub stem {
    my $word = lc shift;

    for ($word) {
        # standalone roots
        last if $protect{root}{$word};

        # nouns: -on -i -in → -o
        last if s{ (?: on | in? ) $}{o}x;

        # remove -u from pronouns: elu ilu olu onu
        last if s{ (?<= ^ [eio] l | on ) u $}{}x;

        # pariciple adjectives: -inta -anta -onta -ita -ata -ota → -ar
        last if s{ (?: [aio] n? t ) a $}{ar}x;

        # verbs: -ir -or -is -as -os -us -ez → -ar
        s{ (?: [io] r | [aiou] s | ez ) $}{ar}x;

        # remove -ab- from verbs
        s{ ab (?= ar $ ) }{}x;
    }

    return $word;
}

sub stem_aggressive {
    my $word = stem(shift);

    for ($word) {
        # standalone roots
        last if $protect{root}{$word};

        # remove final suffix
        s{ (?: [aeo] | ar ) $}{}x;

        # remove -u from pronouns: elu ilu olu onu
        last if s{ (?<= ^ [eio] l | on ) u $}{}x;
    }

    return $word;
}

1;

__END__