File Coverage

blib/lib/Lingua/EN/Keywords.pm

Criterion	Covered	Total	%
statement	20	23	86.9
branch	1	6	16.6
condition	1	3	33.3
subroutine	7	7	100.0
pod	0	2	0.0
total	29	41	70.7

package My::Tagger;
@My::Tagger::ISA=qw(Lingua::EN::Tagger);
my %known_stems;
sub stem {
    my ( $self, $word ) = @_;
    return $word unless $self->{'stem'};
    return $known_stems{ $word } if exists $known_stems{$word};
    my $stemref = Lingua::Stem::En::stem( -words => [ $word ] );

    $known_stems{ $word } = $stemref->[0] if exists $stemref->[0];
}

sub stems { reverse %known_stems; }

# To test:
package Lingua::EN::Keywords;
use Lingua::EN::Tagger;
require 5.005_62;
use strict;
use warnings;

my $t = My::Tagger->new(longest_noun_phrase => 5,weight_noun_phrases=>0);

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw( keywords);
our $VERSION = '2.0';
sub keywords {
    my %wl = $t->get_words(shift);
    my %newwl;
    $newwl{unstem($_)} += $wl{$_} for keys %wl;
    return (sort { $newwl{$b} <=> $newwl{$a} } keys %newwl)[0..5];
}
sub unstem {
    my %cache = $t->stems;
    my $word = shift;
    return $cache{$word} || $word;
}
#undef $/;
#my $in = ;
#print ((join " ", ((),keywords($in))),"\n");
1;
__END__