| 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 | |
||||||
| 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; |