line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Liberal::Remedy::InvalidEncoding; |
2
|
5
|
|
|
5
|
|
2047
|
use strict; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
111
|
|
3
|
|
|
|
|
|
|
|
4
|
5
|
|
|
5
|
|
793
|
use Encode; |
|
5
|
|
|
|
|
14300
|
|
|
5
|
|
|
|
|
291
|
|
5
|
5
|
|
|
5
|
|
1861
|
use Encode::Guess; |
|
5
|
|
|
|
|
14829
|
|
|
5
|
|
|
|
|
14
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
my $RX = qr/^(<\?xml\s+version\s*=\s*["']1\.[01]["']\s+encoding\s*=\s*["'])([^"']+)/; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub apply { |
10
|
106
|
|
|
106
|
0
|
166
|
my $class = shift; |
11
|
106
|
|
|
|
|
195
|
my($driver, $error, $xml_ref) = @_; |
12
|
|
|
|
|
|
|
|
13
|
106
|
100
|
|
|
|
204
|
return 0 if $error->message !~ |
14
|
|
|
|
|
|
|
/^\s*(?:(?:i18n |encoding )?error : )?input conversion failed due to input error/; |
15
|
|
|
|
|
|
|
|
16
|
5
|
|
|
|
|
83
|
my (undef, $encoding) = $$xml_ref =~ $RX; |
17
|
5
|
50
|
|
|
|
17
|
unless ($encoding) { |
18
|
0
|
0
|
|
|
|
0
|
my @suspects = @{ $driver->guess_encodings || [ qw(euc-jp shift_jis utf-8) ] }; |
|
0
|
|
|
|
|
0
|
|
19
|
0
|
|
|
|
|
0
|
my $enc = guess_encoding($$xml_ref, @suspects); |
20
|
0
|
|
|
|
|
0
|
$encoding = $enc->name; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
5
|
50
|
|
|
|
12
|
if ($encoding) { |
24
|
5
|
50
|
|
|
|
91
|
Encode::from_to($$xml_ref, $encoding, "UTF-8"), return 1 |
25
|
|
|
|
|
|
|
if $$xml_ref =~ s/$RX/$1utf-8/; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
Carp::carp("Can't find encoding from XML declaration: ", substr($$xml_ref, 0, 128)); |
29
|
0
|
|
|
|
|
|
return 0; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
1; |