line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Liberal::Remedy::UndeclaredNS; |
2
|
2
|
|
|
2
|
|
980
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
520
|
|
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; |