File Coverage

blib/lib/XML/Liberal/Remedy/UndeclaredNS.pm
Criterion Covered Total %
statement 3 11 27.2
branch 0 4 0.0
condition 0 3 0.0
subroutine 1 2 50.0
pod 0 1 0.0
total 4 21 19.0


line stmt bran cond sub pod time code
1             package XML::Liberal::Remedy::UndeclaredNS;
2 2     2   1470 use strict;
  2         5  
  2         1122  
3              
4             our %namespaces = (
5             rdf => "http://www.w3.org/1999/02/22-rdf-syntax-ns#",
6             dc => "http://purl.org/dc/elements/1.1/",
7             syn => "http://purl.org/rss/1.0/modules/syndication/",
8             sy => "http://purl.org/rss/1.0/modules/syndication/",
9             admin => "http://webns.net/mvcb/",
10             content => "http://purl.org/rss/1.0/modules/content/",
11             cc => "http://web.resource.org/cc/",
12             taxo => "http://purl.org/rss/1.0/modules/taxonomy/",
13             rss20 => "http://backend.userland.com/rss2", # really a dummy
14             rss10 => "http://purl.org/rss/1.0/",
15             rss09 => "http://my.netscape.com/rdf/simple/0.9/",
16             ag => "http://purl.org/rss/modules/aggregation/",
17             wfw => "http://wellformedweb.org/CommentAPI/",
18             trackback => "http://madskills.com/public/xml/rss/module/trackback/",
19             nf => "http://purl.org/atompub/nofollow/1.0",
20             slash => "http://purl.org/rss/1.0/modules/slash/",
21             thr => "http://purl.org/syndication/thread/1.0",
22             rdfs => "http://www.w3.org/2000/01/rdf-schema#",
23             dcterms => "http://purl.org/dc/terms/",
24             xhtml => "http://www.w3.org/1999/xhtml",
25             atom => "http://www.w3.org/2005/Atom",
26             media => "http://search.yahoo.com/mrss",
27             hatena => "http://www.hatena.ne.jp/info/xmlns#",
28             'apple-wallpapers' => "http://www.apple.com/ilife/wallpapers",
29             itunes => "http://www.itunes.com/dtds/podcast-1.0.dtd",
30             );
31              
32             sub apply {
33 0     0 0   my $class = shift;
34 0           my($driver, $error, $xml_ref) = @_;
35              
36 0 0         my ($prefix) = $error->message =~
37             /^namespace error : Namespace prefix (\S+)(?: for \S+)? on \S+ is not defined/
38             or return 0;
39              
40             # If $prefix happens to have the internal SvUTF8 flag, and $$xml_ref
41             # doesn't, but $$xml_ref looks like the bytes of a UTF-8 representation,
42             # then the substitution below will effectively toggle the SvUTF8 flag on
43             # $$xml_ref, at least in some versions of Perl. So ensure the prefix
44             # has SvUTF8 only if that's needed to represent it.
45 0           utf8::downgrade($prefix, 1);
46              
47 0   0       my $ns = $namespaces{$prefix} || "http://example.org/unknown/$prefix#";
48              
49 0 0         return 1 if $$xml_ref =~ s{^(<\?xml\s[^>]*?\?>\s*(?:<[!?][^>]+>\s*)*<[^\s/>]+)}
50             {$1 xmlns:$prefix="$ns"};
51              
52 0           Carp::carp("Can't find root element, error was: ", $error->summary);
53 0           return 0;
54             }
55              
56             1;