File Coverage

blib/lib/Plucene/Search/PhraseScorer/Sloppy.pm
Criterion Covered Total %
statement 41 41 100.0
branch 4 4 100.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 50 50 100.0


line stmt bran cond sub pod time code
1             package Plucene::Search::PhraseScorer::Sloppy;
2              
3             =head1 NAME
4              
5             Plucene::Search::PhraseScorer::Sloppy - sloppy phrase scorer
6              
7             =head1 SYNOPSIS
8              
9             # isa Plucene::Search::PhraseScorer
10              
11             =head1 DESCRIPTION
12              
13             This is a sloppy phrase scorer
14              
15             =head1 METHODS
16              
17             =cut
18              
19 4     4   668 use strict;
  4         9  
  4         143  
20 4     4   20 use warnings;
  4         10  
  4         128  
21              
22 4     4   24 use List::Util qw(max);
  4         8  
  4         307  
23              
24 4     4   22 use base 'Plucene::Search::PhraseScorer';
  4         10  
  4         1622  
25              
26             __PACKAGE__->mk_accessors(q{slop});
27              
28             sub _phrase_freq {
29 10     10   17 my $self = shift;
30 10         17 my $end = 0;
31 10         14 $#{ $self->{pq} } = -1;
  10         57  
32 10         80 my $pp = $self->first;
33 10         57 while ($pp) {
34 20         105 $pp->first_position;
35 20         182 $end = max($end, $pp->position);
36 20         104 push @{ $self->{pq} }, $pp;
  20         67  
37 20         399 $pp = $pp->next_in_list;
38             }
39              
40 10         62 my $freq = 0;
41 10         15 my $done = 0;
42 10         14 do {
43 31         495 my $pp = shift @{ $self->{pq} };
  31         95  
44 31         171 my $start = $pp->position;
45 31         203 my $next = $self->{pq}->[0]->position;
46 31         261 for (my $pos = $start ; $pos <= $next ; $pos = $pp->position) {
47 59         4817 $start = $pos;
48 59 100       339 if (!$pp->next_position) {
49 10         17 $done = 1;
50 10         16 last;
51             }
52             }
53              
54 31         299 my $length = $end - $start;
55 31 100       90 $freq += 1 / ($length + 1) if $length <= $self->slop;
56 31         213 $end = max($end, $pp->position);
57 31         136 push @{ $self->{pq} }, $pp;
  31         94  
58             } while (!$done);
59 10         249 return $freq;
60             }
61              
62             1;