File Coverage

blib/lib/HTML/ListScraper/Foam.pm
Criterion Covered Total %
statement 46 47 97.8
branch 14 16 87.5
condition n/a
subroutine 8 8 100.0
pod 0 4 0.0
total 68 75 90.6


line stmt bran cond sub pod time code
1             package HTML::ListScraper::Foam;
2              
3 4     4   21 use warnings;
  4         6  
  4         121  
4 4     4   21 use strict;
  4         30  
  4         2218  
5              
6             my $epsilon = 0.0001;
7              
8             sub new {
9 8     8 0 17 my ($class, $book) = @_;
10 8         29 my $self = { book => $book, map => { } };
11 8         18 bless $self, $class;
12              
13 8         29 return $self;
14             }
15              
16             sub get_sequences {
17 8     8 0 17 my $self = shift;
18              
19 8         23 my $os = $self->{max_log_score};
20             return grep {
21 8         33 $self->{map}->{$_}->log_score + $epsilon >= $os;
22 8         15 } keys %{$self->{map}};
  8         25  
23             }
24              
25             sub get_occurence {
26 8     8 0 15 my ($self, $seq) = @_;
27              
28 8         33 return $self->{map}->{$seq};
29             }
30              
31             sub store {
32 2542     2542 0 4479 my ($self, $seq, $occ) = @_;
33              
34 2542 50       6392 if (exists($self->{map}->{$seq})) {
35 0         0 die "duplicated sequence";
36             }
37              
38 2542 100       6342 if (!exists($self->{max_log_score})) {
39 8         28 $self->_cond_store($seq, $occ);
40 8         44 return 1;
41             }
42              
43 2534         7381 my $s = $occ->log_score;
44 2534         4586 my $os = $self->{max_log_score};
45 2534 100       6625 if ($s + $epsilon < $os) {
46 571         2394 return 0;
47             }
48              
49 1963 100       4169 if ($s > $os) {
50 1777 100       3630 if ($self->_cond_store($seq, $occ)) {
51 43 50       121 if ($s > $os + $epsilon) {
52 43         112 $self->_prune_map;
53             }
54             }
55             } else {
56 186         367 $self->_cond_store($seq, $occ);
57             }
58              
59 1963         9766 return 1;
60             }
61              
62             sub _cond_store {
63 1971     1971   2929 my ($self, $seq, $occ) = @_;
64              
65 1971 100       5996 if (!$self->{book}->is_presentable($occ->first_pos, $occ->len)) {
66 1919         6031 return 0;
67             }
68              
69 52         169 $self->{max_log_score} = $occ->log_score;
70 52         150 $self->{map}->{$seq} = $occ;
71 52         157 return 1;
72             }
73              
74             sub _prune_map {
75 43     43   64 my $self = shift;
76              
77 43         82 my $os = $self->{max_log_score};
78 43         66 my @seq = keys %{$self->{map}};
  43         158  
79 43         112 foreach my $seq (@seq) {
80 87         310 my $s = $self->{map}->{$seq}->log_score;
81 87 100       321 if ($s + $epsilon < $os) {
82 44         226 delete $self->{map}->{$seq};
83             }
84             }
85             }
86              
87             1;