File Coverage

blib/lib/String/Normal/Type/Title.pm
Criterion Covered Total %
statement 35 35 100.0
branch 5 6 83.3
condition 4 5 80.0
subroutine 7 7 100.0
pod 2 2 100.0
total 53 55 96.3


line stmt bran cond sub pod time code
1             package String::Normal::Type::Title;
2 9     9   31 use strict;
  9         9  
  9         181  
3 9     9   26 use warnings;
  9         8  
  9         141  
4 9     9   26 use String::Normal::Type;
  9         6  
  9         106  
5 9     9   23 use String::Normal::Config;
  9         11  
  9         122  
6              
7 9     9   24 use Lingua::Stem;
  9         6  
  9         3059  
8             our $STEM;
9             our $title_stem;
10             our $title_stop;
11              
12             sub transform {
13 6     6 1 7 my ($self,$value) = @_;
14              
15 6 50       21 $value =~ s/\([^)]*\)/ /g if $value =~ /^[^(]|[^)]$/;
16              
17 6         13 $value = String::Normal::Type::_scrub_value( $value );
18              
19             # tokenize and stem
20 6         7 my @tokens = ();
21 6         16 for my $token (split ' ', $value) {
22             #$token = defined( $title_stem->{$token} ) ? $title_stem->{$token} : $token;
23 24         24 push @tokens, $token;
24             }
25              
26             # Remove all middle stop words that are safe to remove, based on the number of
27             # tokens, of course.
28             my @filtered = map {
29 6   100     9 my $count = $title_stop->{middle}{$_} || '';
  24         52  
30 24 100 66     72 (length $count and @tokens >= $count) ? () : $_;
31             } @tokens;
32              
33             # stem, but override if Stemmer "blanks out" token
34 6         9 my @copy = @filtered;
35 6         17 $STEM->stem_in_place( @copy );
36 6         2845 for my $i (0 .. $#copy) {
37 13 100       34 $filtered[$i] = $copy[$i] unless $filtered[$i] =~ /\d/;
38             }
39              
40 6         51 return join ' ', @filtered;
41             }
42              
43             sub new {
44 1     1 1 1 my $self = shift;
45 1         4 $title_stem = String::Normal::Config::TitleStem::_data( @_ );
46 1         5 $title_stop = String::Normal::Config::TitleStop::_data( @_ );
47 1         7 $STEM = Lingua::Stem->new;
48 1         38 $STEM->add_exceptions( $title_stem );
49 1         51 return bless {@_}, $self;
50             }
51              
52              
53             1;
54              
55             __END__