File Coverage

blib/lib/Search/Tools/Tokenizer.pm
Criterion Covered Total %
statement 44 46 95.6
branch 16 18 88.8
condition 3 3 100.0
subroutine 8 8 100.0
pod 2 2 100.0
total 73 77 94.8


line stmt bran cond sub pod time code
1             package Search::Tools::Tokenizer;
2 32     32   22588 use Moo;
  32         48103  
  32         210  
3             extends 'Search::Tools::Object';
4 32     32   13578 use Search::Tools; # XS package required
  32         43  
  32         510  
5 32     32   10274 use Search::Tools::Token;
  32         52  
  32         557  
6 32     32   10227 use Search::Tools::TokenList;
  32         50  
  32         840  
7 32     32   2717 use Search::Tools::UTF8;
  32         47  
  32         2539  
8 32     32   127 use Carp;
  32         34  
  32         10970  
9              
10             our $VERSION = '1.004';
11              
12             has 're' => ( is => 'rw', default => sub {qr/\w+(?:[\'\-\.]\w+)*/} );
13              
14             sub BUILD {
15 65     65 1 773 my $self = shift;
16 65 50       972 if ( $self->debug ) {
17 0         0 $self->set_debug( $self->debug - 1 ); # XS debug a level higher
18             }
19 65         3025 return $self;
20             }
21              
22             sub tokenize_pp {
23 7     7 1 1545 require Search::Tools::TokenPP;
24 7         825 require Search::Tools::TokenListPP;
25              
26 7         12 my $self = shift;
27 7 50       27 if ( !defined $_[0] ) {
28 0         0 croak "str required";
29             }
30              
31             # XS modifies the original arg, so we do too.
32             # this is same slight optimization XS does. ~5%
33 7 100       56 if ( !is_ascii( $_[0] ) ) {
34 2         11 $_[0] = to_utf8( $_[0] );
35             }
36 7         14 my $heat_seeker = $_[1];
37              
38             # match_num ($_[2]) not supported in PP
39              
40 7         14 my @heat = ();
41 7         9 my @tokens = ();
42 7         6 my $i = 0;
43 7         19 my $re = $self->{re};
44 7 100 100     44 my $heat_seeker_is_coderef
45             = ( defined $heat_seeker and ref($heat_seeker) eq 'CODE' ) ? 1 : 0;
46              
47             # TODO is_sentence_* logic
48 7         272 for ( split( m/($re)/, $_[0] ) ) {
49 343 100       558 next unless length($_);
50 326         986 my $tok = bless(
51             { 'pos' => $i++,
52             str => $_,
53             is_hot => 0,
54             is_match => 0,
55             len => byte_length($_),
56             u8len => length($_),
57             },
58             'Search::Tools::TokenPP'
59             );
60 326 100       1130 if ( $_ =~ m/^$re$/ ) {
61 170         208 $tok->{is_match} = 1;
62 170 100       271 if ($heat_seeker_is_coderef) {
    100          
63 13         27 $heat_seeker->($tok);
64             }
65             elsif ( defined $heat_seeker ) {
66 69         138 $tok->{is_hot} = $_ =~ m/$heat_seeker/;
67             }
68             }
69 326 100       2439 push( @heat, $tok->{pos} ) if $tok->{is_hot};
70 326         428 push @tokens, $tok;
71             }
72 7         108 return bless(
73             { tokens => \@tokens,
74             num => $i,
75             'pos' => 0,
76             heat => \@heat,
77             },
78             'Search::Tools::TokenListPP'
79             );
80             }
81              
82             1;
83              
84             __END__