File Coverage

blib/lib/Lingua/Stem/Snowball/Lt.pm

Criterion	Covered	Total	%
statement	35	42	83.3
branch	8	14	57.1
condition	3	6	50.0
subroutine	9	9	100.0
pod	3	3	100.0
total	58	74	78.3

package Lingua::Stem::Snowball::Lt;
use strict;
use warnings;
use 5.006002;

use Carp;
use Exporter;
use vars qw(
    $VERSION
    @ISA
    @EXPORT_OK
    $AUTOLOAD
    %EXPORT_TAGS
    $stemmifier
    %instance_vars
);

$VERSION = '0.03';

@ISA         = qw( Exporter DynaLoader );
%EXPORT_TAGS = ( 'all' => [qw( stem )] );
@EXPORT_OK   = ( @{ $EXPORT_TAGS{'all'} } );

require DynaLoader;
__PACKAGE__->bootstrap($VERSION);

# Ensure that C symbols are exported so that other shared libaries (e.g.
# KinoSearch) can use them.  See Dynaloader docs.
sub dl_load_flags {0x01}

# A shared home for the actual struct sb_stemmer C modules.
$stemmifier = Lingua::Stem::Snowball::Lt::Stemmifier->new;

%instance_vars = (
    lang              => 'lt',
    encoding          => 'UTF-8',
    locale            => undef,
    stemmer_id        => -1,
    strip_apostrophes => 0,
);

sub new {
    my $class = shift;
    my $self = bless { %instance_vars, @_ }, ref($class) || $class;

    # Get an sb_stemmer.
    $self->_derive_stemmer;

    return $self;
}

sub stem {
    my ( $self, $words, $locale, $is_stemmed );

    # Support lots of DWIMmery.
    if ( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
        ( $self, $words, $is_stemmed ) = @_;
    }
    else {
        ( $words, $locale, $is_stemmed ) = @_;
        $self = __PACKAGE__->new( );
    }

    # Bail if there's no input.
    return undef unless ( ref($words) or length($words) );

    # Duplicate the input array and transform it into an array of stems.
    $words = ref($words) ? $words : [$words];
    my @stems = map {lc} @$words;
    $self->stem_in_place( \@stems );

    # Determine whether any stemming took place, if requested.
    if ( ref($is_stemmed) ) {
        $$is_stemmed = 0;
        if ( $self->{stemmer_id} == -1 ) {
            $$is_stemmed = 1;
        }
        else {
            for ( 0 .. $#stems ) {
                next if $stems[$_] eq $words->[$_];
                $$is_stemmed = 1;
                last;
            }
        }
    }

    return wantarray ? @stems : $stems[0];
}

1;

__END__