blib/lib/HTML/ExtractContent/Util.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 46 | 55 | 83.6 |
branch | 1 | 6 | 16.6 |
condition | 1 | 2 | 50.0 |
subroutine | 17 | 19 | 89.4 |
pod | 0 | 13 | 0.0 |
total | 65 | 95 | 68.4 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package HTML::ExtractContent::Util; | ||||||
2 | 3 | 3 | 24646 | use strict; | |||
3 | 5 | ||||||
3 | 74 | ||||||
3 | 3 | 3 | 14 | use warnings; | |||
3 | 6 | ||||||
3 | 73 | ||||||
4 | 3 | 3 | 905 | use utf8; | |||
3 | 14 | ||||||
3 | 16 | ||||||
5 | |||||||
6 | # cpan | ||||||
7 | 3 | 3 | 2262 | use Exporter::Lite; | |||
3 | 2016 | ||||||
3 | 26 | ||||||
8 | 3 | 3 | 2444 | use HTML::Entities qw(decode_entities); | |||
3 | 25643 | ||||||
3 | 282 | ||||||
9 | 3 | 3 | 3080 | use HTML::Strip (); | |||
3 | 18499 | ||||||
3 | 3034 | ||||||
10 | |||||||
11 | sub strip { | ||||||
12 | 113 | 113 | 0 | 351 | my $str = shift; | ||
13 | 113 | 920 | $str =~ s/(^\s+|\s+$)//gs; | ||||
14 | 113 | 466 | return $str; | ||||
15 | } | ||||||
16 | |||||||
17 | sub strip_tags { | ||||||
18 | 67 | 67 | 0 | 805 | my $page = shift; | ||
19 | 67 | 207 | my $hs = HTML::Strip->new; | ||||
20 | 67 | 3917 | return $hs->parse($page); | ||||
21 | } | ||||||
22 | |||||||
23 | sub eliminate_tags { | ||||||
24 | 30 | 30 | 0 | 741 | my ($page, $tag) = @_; | ||
25 | 30 | 714 | $page =~ s/<$tag[\s>].*?<\/$tag\s*>//igs; | ||||
26 | 30 | 111 | return $page; | ||||
27 | } | ||||||
28 | |||||||
29 | sub eliminate_links { | ||||||
30 | 15 | 15 | 0 | 37 | return eliminate_tags shift, 'a'; | ||
31 | } | ||||||
32 | |||||||
33 | sub eliminate_forms { | ||||||
34 | 13 | 13 | 0 | 26 | return eliminate_tags shift, 'form'; | ||
35 | } | ||||||
36 | |||||||
37 | sub eliminate_br { | ||||||
38 | 59 | 59 | 0 | 90 | my $page = shift; | ||
39 | 59 | 104 | $page =~ s/ ]*>/ /igs; |
||||
40 | 59 | 123 | return $page; | ||||
41 | } | ||||||
42 | |||||||
43 | sub eliminate_invisible { | ||||||
44 | 0 | 0 | 0 | 0 | my $page = shift; | ||
45 | 0 | 0 | my $patterns = [ | ||||
46 | qr//is, | ||||||
47 | qr/<(script|style|select|noscript)[^>]*>.*?<\/\1\s*>/is, | ||||||
48 | qr/ ]*(id|class)\s*=\s*['"]?\S*(more|menu|side|navi)\S*["']?[^>]*>/is, |
||||||
49 | ]; | ||||||
50 | 0 | 0 | for my $pat (@$patterns) { | ||||
51 | 0 | 0 | $page =~ s/$pat//igs; | ||||
52 | } | ||||||
53 | 0 | 0 | return $page; | ||||
54 | } | ||||||
55 | |||||||
56 | sub extract_alt { | ||||||
57 | 0 | 0 | 0 | 0 | my $page = shift; | ||
58 | 0 | 0 | $page =~ s{ | ||||
59 | # no backgrack or otherwise the time complexity will become O(n^2) | ||||||
60 | ]* \b alt \s* = \s* (?> | ||||||
61 | " ([^"]*) " | ' ([^']*) ' | ([^\s"'<>]+) | ||||||
62 | ) [^>]* > | ||||||
63 | }{ | ||||||
64 | 0 | 0 | 0 | defined $1 ? $1 : defined $2 ? $2 : $3 | |||
0 | |||||||
65 | }xigse; | ||||||
66 | 0 | 0 | return $page; | ||||
67 | } | ||||||
68 | |||||||
69 | sub unescape { | ||||||
70 | 59 | 59 | 0 | 1416 | my $page = shift; | ||
71 | 59 | 244 | decode_entities($page); | ||||
72 | } | ||||||
73 | |||||||
74 | sub reduce_ws { | ||||||
75 | 59 | 59 | 0 | 89 | my $page = shift; | ||
76 | 59 | 296 | $page =~ s/[ \t]+/ /g; | ||||
77 | 59 | 147 | $page =~ s/\n\s*/\n/gs; | ||||
78 | 59 | 141 | return $page; | ||||
79 | } | ||||||
80 | |||||||
81 | sub decode { | ||||||
82 | 59 | 59 | 0 | 113 | return strip (reduce_ws (unescape (strip_tags (eliminate_br shift)))); | ||
83 | } | ||||||
84 | |||||||
85 | sub to_text { | ||||||
86 | 15 | 15 | 0 | 30 | my ($html, $opts) = @_; | ||
87 | 15 | 50 | 65 | $opts ||= {}; | |||
88 | 15 | 50 | 39 | $html = extract_alt $html if $opts->{with_alt}; | |||
89 | 15 | 27 | return decode $html; | ||||
90 | } | ||||||
91 | |||||||
92 | sub match_count { | ||||||
93 | 40 | 40 | 0 | 145 | my ($str, $exp) = @_; | ||
94 | 40 | 281 | my @list = ($str =~ $exp); | ||||
95 | 40 | 139 | return $#list + 1; | ||||
96 | } | ||||||
97 | |||||||
98 | our @EXPORT = qw/strip strip_tags eliminate_tags eliminate_links eliminate_forms eliminate_br eliminate_invisible extract_alt unescape reduce_ws decode to_text match_count/; | ||||||
99 | |||||||
100 | 1; |