line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Algorithm::AhoCorasick::SearchMachine; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
30071
|
use strict; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
130
|
|
4
|
4
|
|
|
4
|
|
21
|
use warnings; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
2667
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
sub new { |
7
|
24
|
|
|
24
|
1
|
3638
|
my $class = shift; |
8
|
|
|
|
|
|
|
|
9
|
24
|
100
|
|
|
|
70
|
if (!@_) { |
10
|
4
|
|
|
|
|
31
|
die "no keywords"; |
11
|
|
|
|
|
|
|
} |
12
|
|
|
|
|
|
|
|
13
|
20
|
|
|
|
|
28
|
my %keywords; |
14
|
20
|
|
|
|
|
48
|
foreach (@_) { |
15
|
33
|
100
|
66
|
|
|
179
|
if (!defined($_) || ($_ eq '')) { |
16
|
2
|
|
|
|
|
21
|
die "empty keyword"; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
31
|
|
|
|
|
101
|
$keywords{$_} = 1; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
18
|
|
|
|
|
83
|
my $self = { keywords => [ keys %keywords ] }; |
23
|
18
|
|
|
|
|
64
|
bless $self, $class; |
24
|
18
|
|
|
|
|
45
|
$self->_build_tree(); |
25
|
18
|
|
|
|
|
66
|
return $self; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _build_tree { |
29
|
18
|
|
|
18
|
|
30
|
my $self = shift; |
30
|
|
|
|
|
|
|
|
31
|
18
|
|
|
|
|
65
|
$self->{root} = Algorithm::AhoCorasick::Node->new(); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# build transition links |
34
|
18
|
|
|
|
|
29
|
foreach my $p (@{$self->{keywords}}) { |
|
18
|
|
|
|
|
44
|
|
35
|
27
|
|
|
|
|
46
|
my $nd = $self->{root}; |
36
|
27
|
|
|
|
|
77
|
foreach my $c (split //, $p) { |
37
|
57
|
|
|
|
|
121
|
my $ndNew = $nd->get_transition($c); |
38
|
57
|
100
|
|
|
|
156
|
if (!$ndNew) { |
39
|
47
|
|
|
|
|
128
|
$ndNew = Algorithm::AhoCorasick::Node->new(parent => $nd, char => $c); |
40
|
47
|
|
|
|
|
103
|
$nd->add_transition($ndNew); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
57
|
|
|
|
|
138
|
$nd = $ndNew; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
27
|
|
|
|
|
72
|
$nd->add_result($p); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# build failure links |
50
|
18
|
|
|
|
|
30
|
my @nodes; |
51
|
18
|
|
|
|
|
50
|
foreach my $nd ($self->{root}->transitions) { |
52
|
18
|
|
|
|
|
69
|
$nd->failure($self->{root}); |
53
|
18
|
|
|
|
|
36
|
push @nodes, $nd->transitions; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
18
|
|
|
|
|
51
|
while (@nodes) { |
57
|
21
|
|
|
|
|
24
|
my @newNodes; |
58
|
|
|
|
|
|
|
|
59
|
21
|
|
|
|
|
37
|
foreach my $nd (@nodes) { |
60
|
29
|
|
|
|
|
558
|
my $r = $nd->parent->failure; |
61
|
29
|
|
|
|
|
67
|
my $c = $nd->char; |
62
|
|
|
|
|
|
|
|
63
|
29
|
|
66
|
|
|
108
|
while ($r && !($r->get_transition($c))) { |
64
|
29
|
|
|
|
|
59
|
$r = $r->failure; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
29
|
50
|
|
|
|
60
|
if (!$r) { |
68
|
29
|
|
|
|
|
64
|
$nd->failure($self->{root}); |
69
|
|
|
|
|
|
|
} else { |
70
|
0
|
|
|
|
|
0
|
my $tc = $r->get_transition($c); |
71
|
0
|
|
|
|
|
0
|
$nd->failure($tc); |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
0
|
foreach my $result ($tc->results) { |
74
|
0
|
|
|
|
|
0
|
$nd->add_result($result); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
29
|
|
|
|
|
54
|
push @newNodes, $nd->transitions; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
21
|
|
|
|
|
78
|
@nodes = @newNodes; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
18
|
|
|
|
|
48
|
$self->{root}->failure($self->{root}); |
85
|
18
|
|
|
|
|
46
|
$self->{state} = $self->{root}; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub feed { |
89
|
20
|
|
|
20
|
1
|
842
|
my ($self, $text, $callback) = @_; |
90
|
|
|
|
|
|
|
|
91
|
20
|
|
|
|
|
27
|
my $index = 0; |
92
|
20
|
|
|
|
|
33
|
my $l = length($text); |
93
|
20
|
|
|
|
|
47
|
while ($index < $l) { |
94
|
382
|
|
|
|
|
427
|
my $trans = undef; |
95
|
382
|
|
|
|
|
386
|
while (1) { |
96
|
420
|
|
|
|
|
1055
|
$trans = $self->{state}->get_transition(substr($text, $index, 1)); |
97
|
420
|
100
|
100
|
|
|
1631
|
last if ($self->{state} == $self->{root}) || $trans; |
98
|
38
|
|
|
|
|
85
|
$self->{state} = $self->{state}->failure; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
382
|
100
|
|
|
|
727
|
if ($trans) { |
102
|
88
|
|
|
|
|
129
|
$self->{state} = $trans; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
382
|
|
|
|
|
737
|
foreach my $found ($self->{state}->results) { |
106
|
30
|
|
|
|
|
105
|
my $rv = &$callback($index - length($found) + 1, $found); |
107
|
30
|
100
|
|
|
|
8054
|
if ($rv) { |
108
|
6
|
|
|
|
|
145
|
return $rv; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
376
|
|
|
|
|
964
|
++$index; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
14
|
|
|
|
|
38
|
return undef; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
package Algorithm::AhoCorasick::Node; |
119
|
|
|
|
|
|
|
|
120
|
4
|
|
|
4
|
|
24
|
use strict; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
133
|
|
121
|
4
|
|
|
4
|
|
19
|
use warnings; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
110
|
|
122
|
4
|
|
|
4
|
|
20
|
use Scalar::Util qw(weaken); |
|
4
|
|
|
|
|
16
|
|
|
4
|
|
|
|
|
1833
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub new { |
125
|
65
|
|
|
65
|
|
88
|
my $class = shift; |
126
|
|
|
|
|
|
|
|
127
|
65
|
|
|
|
|
167
|
my $self = { @_ }; |
128
|
65
|
|
|
|
|
129
|
$self->{results} = { }; |
129
|
65
|
|
|
|
|
103
|
$self->{transitions} = { }; |
130
|
65
|
100
|
|
|
|
272
|
weaken $self->{parent} if $self->{parent}; |
131
|
65
|
|
|
|
|
231
|
return bless $self, $class; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub char { |
135
|
76
|
|
|
76
|
|
93
|
my $self = shift; |
136
|
|
|
|
|
|
|
|
137
|
76
|
50
|
|
|
|
180
|
if (!exists($self->{char})) { |
138
|
0
|
|
|
|
|
0
|
die "root node has no character"; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
76
|
|
|
|
|
235
|
return $self->{char}; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub parent { |
145
|
29
|
|
|
29
|
|
41
|
my $self = shift; |
146
|
|
|
|
|
|
|
|
147
|
29
|
50
|
|
|
|
75
|
if (!exists($self->{parent})) { |
148
|
0
|
|
|
|
|
0
|
die "root node has no parent"; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
29
|
|
|
|
|
94
|
return $self->{parent}; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub failure { |
155
|
161
|
|
|
161
|
|
206
|
my $self = shift; |
156
|
|
|
|
|
|
|
|
157
|
161
|
100
|
|
|
|
331
|
if (@_) { |
158
|
65
|
|
|
|
|
1042
|
$self->{failure} = $_[0]; |
159
|
65
|
|
|
|
|
165
|
weaken $self->{failure}; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
161
|
|
|
|
|
360
|
return $self->{failure}; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Returns transition to the specified character, or undef. |
166
|
|
|
|
|
|
|
sub get_transition { |
167
|
506
|
|
|
506
|
|
880
|
my ($self, $c) = @_; |
168
|
|
|
|
|
|
|
|
169
|
506
|
|
|
|
|
1159
|
return $self->{transitions}->{$c}; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# Returns a list of descendant nodes. |
173
|
|
|
|
|
|
|
sub transitions { |
174
|
65
|
|
|
65
|
|
80
|
my $self = shift; |
175
|
|
|
|
|
|
|
|
176
|
65
|
|
|
|
|
75
|
return values %{$self->{transitions}}; |
|
65
|
|
|
|
|
261
|
|
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Returns a list of patterns ending in this node. |
180
|
|
|
|
|
|
|
sub results { |
181
|
382
|
|
|
382
|
|
459
|
my $self = shift; |
182
|
|
|
|
|
|
|
|
183
|
382
|
|
|
|
|
386
|
return keys %{$self->{results}}; |
|
382
|
|
|
|
|
1260
|
|
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Adds pattern ending in this node. |
187
|
|
|
|
|
|
|
sub add_result { |
188
|
27
|
|
|
27
|
|
41
|
my ($self, $res) = @_; |
189
|
|
|
|
|
|
|
|
190
|
27
|
|
|
|
|
94
|
$self->{results}->{$res} = 1; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# Adds transition node. |
194
|
|
|
|
|
|
|
sub add_transition { |
195
|
47
|
|
|
47
|
|
63
|
my ($self, $node) = @_; |
196
|
|
|
|
|
|
|
|
197
|
47
|
|
|
|
|
96
|
$self->{transitions}->{$node->char} = $node; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
1; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
__END__ |