line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Liberal::Remedy::TrailingElements; |
2
|
2
|
|
|
2
|
|
1093
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
414
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
sub apply { |
5
|
0
|
|
|
0
|
0
|
|
my $class = shift; |
6
|
0
|
|
|
|
|
|
my($driver, $error, $xml_ref) = @_; |
7
|
|
|
|
|
|
|
|
8
|
0
|
0
|
|
|
|
|
return 0 if $error->message !~ |
9
|
|
|
|
|
|
|
/^parser error : Extra content at the end of the document/; |
10
|
|
|
|
|
|
|
|
11
|
0
|
|
|
|
|
|
my $pos = $error->location; |
12
|
0
|
|
|
|
|
|
pos($$xml_ref) = $pos; |
13
|
0
|
0
|
|
|
|
|
return 0 if $$xml_ref !~ /\G <[-:\w]+ (?:[>\s]|\z)/xms; |
14
|
|
|
|
|
|
|
|
15
|
0
|
|
|
|
|
|
while ($pos > 0) { |
16
|
0
|
|
|
|
|
|
pos($$xml_ref) = $pos--; |
17
|
0
|
0
|
|
|
|
|
return 1 if $$xml_ref =~ s{\G ([^\s<>/]+ \s*>) (.*)}{$2$1}xms; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
0
|
|
|
|
|
|
return 0; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
1; |