File Coverage

blib/lib/XML/Liberal/Remedy/HTMLEntity.pm
Criterion Covered Total %
statement 11 11 100.0
branch 3 4 75.0
condition 2 3 66.6
subroutine 3 3 100.0
pod 0 1 0.0
total 19 22 86.3


line stmt bran cond sub pod time code
1             package XML::Liberal::Remedy::HTMLEntity;
2 5     5   2146 use strict;
  5         10  
  5         109  
3              
4 5     5   92 use HTML::Entities ();
  5         8  
  5         1221  
5              
6             my %DECODE = map {
7             (my $name = $_) =~ s{\;\z}{};
8             $name => sprintf '&#x%x;', ord $HTML::Entities::entity2char{$_}
9             } keys %HTML::Entities::entity2char;
10              
11             # optimized to fix all errors in one apply() call
12             sub apply {
13 127     127 0 183 my $class = shift;
14 127         214 my($driver, $error, $xml_ref) = @_;
15              
16 127 100       216 return 0 if $error->message !~ /^parser error : Entity '.*' not defined/;
17              
18             # Note that we can't tell whether "É" is meant to be "é"
19             # or "É", so we arbitrarily choose "é". Fortunately, the
20             # only HTML entities whose names aren't all-lower-case are the
21             # upper-case equivalents of all-lower-case ones, so this doesn't
22             # introduce any ambiguity that didn't exist in the source document.
23 21         271 return scalar $$xml_ref =~ s{&([a-zA-Z0-9]+);}{
24 21 50 66     174 $DECODE{$1} || $DECODE{lc $1}
25             || Carp::carp("Can't find named HTML entity $1, error was: ",
26             $error->summary)
27             }ge;
28             }
29              
30             1;