/usr/share/perl5/Lingua/Stem/Gl.pm is in liblingua-stem-perl 0.84-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 | package Lingua::Stem::Gl;
# $RCSfile: De.pm,v $ $Revision: 1.4 $ $Date: 1999/06/24 23:33:37 $ $Author: snowhare $
=head1 NAME
Lingua::Stem::Gl - Stemming algorithm for Galacian
=head1 SYNOPSIS
use Lingua::Stem::Gl;
my $stems = Lingua::Stem::Gl::stem({ -words => $word_list_reference,
-locale => 'gl',
-exceptions => $exceptions_hash,
});
=head1 DESCRIPTION
This routine applies a stemming algorithm to a passed anon array of Galician words,
returning the stemmed words as an anon array.
It is a 'convienence' wrapper for 'Lingua::Stemmer::GL' that provides
a standardized interface and caching.
=head1 CHANGES
1.02 2004.04.26 - Documenation fix
1.01 2003.09.28 - Documentation fix
1.00 2003.04.05 - Initial release
=cut
#######################################################################
# Initialization
#######################################################################
use strict;
use Lingua::GL::Stemmer;
use Exporter;
use Carp;
use vars qw (@ISA @EXPORT_OK @EXPORT %EXPORT_TAGS $VERSION);
BEGIN {
@ISA = qw (Exporter);
@EXPORT = ();
@EXPORT_OK = qw (stem clear_stem_cache stem_caching);
%EXPORT_TAGS = ();
}
$VERSION = "1.02";
my $Stem_Caching = 0;
my $Stem_Cache = {};
=head1 METHODS
=cut
#######################################################################
=over 4
=item stem({ -words => \@words, -locale => 'gl', -exceptions => \%exceptions });
Stems a list of passed words using the rules of Galican. Returns
an anonymous list reference to the stemmed words.
Example:
my $stemmed_words = Lingua::Stem::Gl::stem({ -words => \@words,
-locale => 'gl',
-exceptions => \%exceptions,
});
=back
=cut
sub stem {
return [] if ($#_ == -1);
my $parm_ref;
if (ref $_[0]) {
$parm_ref = shift;
} else {
$parm_ref = { @_ };
}
my $words = [];
my $locale = 'gl';
my $exceptions = {};
foreach (keys %$parm_ref) {
my $key = lc ($_);
if ($key eq '-words') {
@$words = @{$parm_ref->{$key}};
} elsif ($key eq '-exceptions') {
$exceptions = $parm_ref->{$key};
} elsif ($key eq '-locale') {
$locale = $parm_ref->{$key};
} else {
croak (__PACKAGE__ . "::stem() - Unknown parameter '$key' with value '$parm_ref->{$key}'\n");
}
}
local $_;
foreach (@$words) {
# Check against exceptions list
if (exists $exceptions->{$_}) {
$_ = $exceptions->{$_};
next;
}
# Check against cache of stemmed words
my $original_word = $_;
if ($Stem_Caching && exists $Stem_Cache->{$original_word}) {
$_ = $Stem_Cache->{$original_word};
next;
}
($_) = Lingua::GL::Stemmer::stem("$_");
$Stem_Cache->{$original_word} = $_ if $Stem_Caching;
}
$Stem_Cache = {} if ($Stem_Caching < 2);
return $words;
}
##############################################################
=over 4
=item stem_caching({ -level => 0|1|2 });
Sets the level of stem caching.
'0' means 'no caching'. This is the default level.
'1' means 'cache per run'. This caches stemming results during a single
call to 'stem'.
'2' means 'cache indefinitely'. This caches stemming results until
either the process exits or the 'clear_stem_cache' method is called.
=back
=cut
sub stem_caching {
my $parm_ref;
if (ref $_[0]) {
$parm_ref = shift;
} else {
$parm_ref = { @_ };
}
my $caching_level = $parm_ref->{-level};
if (defined $caching_level) {
if ($caching_level !~ m/^[012]$/) {
croak(__PACKAGE__ . "::stem_caching() - Legal values are '0','1' or '2'. '$caching_level' is not a legal value");
}
$Stem_Caching = $caching_level;
}
return $Stem_Caching;
}
##############################################################
=over 4
=item clear_stem_cache;
Clears the cache of stemmed words
=back
=cut
sub clear_stem_cache {
$Stem_Cache = {};
}
##############################################################
=head1 NOTES
This code is a wrapper around Lingua::Stemmer::GL written by
xern <xern@cpan.org>
=head1 SEE ALSO
Lingua::Stem Lingua::Stemmer::GL;
=head1 AUTHOR
Integration in Lingua::Stem by
Benjamin Franz, FreeRun Technologies,
snowhare@nihongo.org or http://www.nihongo.org/snowhare/
=head1 COPYRIGHT
Benjamin Franz, FreeRun Technologies
This code is freely available under the same terms as Perl.
=head1 BUGS
=head1 TODO
=cut
1;
|