line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XRD::Parser; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
40783
|
use 5.010; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
36
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
33
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
5
|
use Carp 0; |
|
1
|
|
|
|
|
37
|
|
|
1
|
|
|
|
|
126
|
|
7
|
1
|
|
|
1
|
|
2338
|
use Digest::SHA 0 qw(sha1_hex); |
|
1
|
|
|
|
|
9047
|
|
|
1
|
|
|
|
|
146
|
|
8
|
1
|
|
|
1
|
|
2891
|
use Encode 0 qw(encode_utf8); |
|
1
|
|
|
|
|
12458
|
|
|
1
|
|
|
|
|
98
|
|
9
|
1
|
|
|
1
|
|
441
|
use HTTP::Link::Parser 0.102; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use LWP::UserAgent 0; |
11
|
|
|
|
|
|
|
use Object::AUTHORITY 0; |
12
|
|
|
|
|
|
|
use RDF::Trine 0.135; |
13
|
|
|
|
|
|
|
use Scalar::Util 0 qw(blessed); |
14
|
|
|
|
|
|
|
use URI::Escape 0; |
15
|
|
|
|
|
|
|
use URI::URL 0; |
16
|
|
|
|
|
|
|
use XML::LibXML 1.70 qw(:all); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use constant NS_HOSTMETA => 'http://host-meta.net/ns/1.0'; |
19
|
|
|
|
|
|
|
use constant NS_HOSTMETX => 'http://host-meta.net/xrd/1.0'; |
20
|
|
|
|
|
|
|
use constant NS_XML => XML::LibXML::XML_XML_NS; |
21
|
|
|
|
|
|
|
use constant NS_XRD => 'http://docs.oasis-open.org/ns/xri/xrd-1.0'; |
22
|
|
|
|
|
|
|
use constant URI_DCTERMS => 'http://purl.org/dc/terms/'; |
23
|
|
|
|
|
|
|
use constant URI_HOST => 'http://ontologi.es/xrd#host:'; |
24
|
|
|
|
|
|
|
use constant URI_RDF => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; |
25
|
|
|
|
|
|
|
use constant URI_RDFS => 'http://www.w3.org/2000/01/rdf-schema#'; |
26
|
|
|
|
|
|
|
use constant URI_SUBLINK => 'http://ontologi.es/xrd#sublink:'; |
27
|
|
|
|
|
|
|
use constant URI_TYPES => 'http://www.iana.org/assignments/media-types/'; |
28
|
|
|
|
|
|
|
use constant URI_XRD => 'http://ontologi.es/xrd#'; |
29
|
|
|
|
|
|
|
use constant URI_XSD => 'http://www.w3.org/2001/XMLSchema#'; |
30
|
|
|
|
|
|
|
use constant SCHEME_TMPL => 'x-xrd+template+for:'; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
BEGIN { |
33
|
|
|
|
|
|
|
$XRD::Parser::AUTHORITY = 'cpan:TOBYINK'; |
34
|
|
|
|
|
|
|
$XRD::Parser::VERSION = '0.201'; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub new |
38
|
|
|
|
|
|
|
{ |
39
|
|
|
|
|
|
|
my ($class, $content, $baseuri, $options, $store)= @_; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Rationalise $options |
42
|
|
|
|
|
|
|
# ==================== |
43
|
|
|
|
|
|
|
# If $options is undefined, then use the default configuration |
44
|
|
|
|
|
|
|
if (!ref $options) |
45
|
|
|
|
|
|
|
{ $options = {}; } |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# Rationalise $baseuri |
48
|
|
|
|
|
|
|
# ==================== |
49
|
|
|
|
|
|
|
croak "Need a valid base URI.\n" |
50
|
|
|
|
|
|
|
unless $baseuri =~ /^[a-z][a-z0-9\+\-\.]*:/i; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# Rationalise $content and set $domtree |
53
|
|
|
|
|
|
|
# ===================================== |
54
|
|
|
|
|
|
|
croak "Need to provide XML content\n" |
55
|
|
|
|
|
|
|
unless defined $content; |
56
|
|
|
|
|
|
|
my $domtree; |
57
|
|
|
|
|
|
|
if (blessed($content) && $content->isa('XML::LibXML::Document')) |
58
|
|
|
|
|
|
|
{ |
59
|
|
|
|
|
|
|
($domtree, $content) = ($content, $content->toString); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
else |
62
|
|
|
|
|
|
|
{ |
63
|
|
|
|
|
|
|
my $xml_parser = XML::LibXML->new; |
64
|
|
|
|
|
|
|
$domtree = $xml_parser->parse_string($content); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Rationalise $store |
68
|
|
|
|
|
|
|
# ================== |
69
|
|
|
|
|
|
|
$store = RDF::Trine::Store::DBI->temporary_store |
70
|
|
|
|
|
|
|
unless defined $store; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $self = bless { |
73
|
|
|
|
|
|
|
'content' => $content, |
74
|
|
|
|
|
|
|
'baseuri' => $baseuri, |
75
|
|
|
|
|
|
|
'options' => $options, |
76
|
|
|
|
|
|
|
'DOM' => $domtree, |
77
|
|
|
|
|
|
|
'RESULTS' => RDF::Trine::Model->new($store), |
78
|
|
|
|
|
|
|
}, $class; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
return $self; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub new_from_url |
84
|
|
|
|
|
|
|
{ |
85
|
|
|
|
|
|
|
my ($class, $url, $options, $store)= @_; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
if (!ref $options) |
88
|
|
|
|
|
|
|
{ $options = {}; } |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new; |
91
|
|
|
|
|
|
|
$ua->agent(sprintf('%s/%s (%s) ', __PACKAGE__, __PACKAGE__->VERSION, __PACKAGE__->AUTHORITY)); |
92
|
|
|
|
|
|
|
$ua->default_header("Accept" => "application/xrd+xml, application/xml;q=0.1, text/xml;q=0.1"); |
93
|
|
|
|
|
|
|
my $response; |
94
|
|
|
|
|
|
|
my $timeout = $options->{timeout} // 60; |
95
|
|
|
|
|
|
|
eval { |
96
|
|
|
|
|
|
|
local $SIG{ALRM} = sub { die "Request timed out\n"; }; |
97
|
|
|
|
|
|
|
alarm $timeout; |
98
|
|
|
|
|
|
|
$response = $ua->get($url); |
99
|
|
|
|
|
|
|
if ($response->code == 406) |
100
|
|
|
|
|
|
|
{ |
101
|
|
|
|
|
|
|
$response = $ua->get($url, Accept=>'application/xrd+xml, application/x-httpd-php'); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
alarm 0; |
104
|
|
|
|
|
|
|
}; |
105
|
|
|
|
|
|
|
croak $@ if $@; |
106
|
|
|
|
|
|
|
croak "HTTP response not successful\n" |
107
|
|
|
|
|
|
|
unless defined $response && $response->is_success; |
108
|
|
|
|
|
|
|
croak "Non-XRD HTTP response\n" |
109
|
|
|
|
|
|
|
unless $response->content_type =~ m`^(text/xml)|(application/(xrd\+xml|xml))$` |
110
|
|
|
|
|
|
|
|| ($options->{'loose_mime'} && $response->content_type =~ m`^(text/plain)|(text/html)|(application/octet-stream)$`); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
return $class->new( |
113
|
|
|
|
|
|
|
$response->decoded_content, |
114
|
|
|
|
|
|
|
$response->base.'', |
115
|
|
|
|
|
|
|
$options, |
116
|
|
|
|
|
|
|
$store, |
117
|
|
|
|
|
|
|
); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
*new_from_uri = \&new_from_url; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub hostmeta |
123
|
|
|
|
|
|
|
{ |
124
|
|
|
|
|
|
|
my $class = shift; |
125
|
|
|
|
|
|
|
my $host = shift; |
126
|
|
|
|
|
|
|
my $rv; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
my ($https, $http) = hostmeta_location($host); |
129
|
|
|
|
|
|
|
return unless $https; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
eval { $rv = $class->new_from_url($https, {timeout=>10, loose_mime=>1,default_subject=>host_uri($host)}); }; |
132
|
|
|
|
|
|
|
return $rv if $rv; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
eval { $rv = $class->new_from_url($http, {timeout=>15, loose_mime=>1,default_subject=>host_uri($host)}); } ; |
135
|
|
|
|
|
|
|
return $rv if $rv; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
return; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub uri |
141
|
|
|
|
|
|
|
{ |
142
|
|
|
|
|
|
|
my $this = shift; |
143
|
|
|
|
|
|
|
my $param = shift // ''; |
144
|
|
|
|
|
|
|
my $opts = shift // {}; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
if ((ref $opts) =~ /^XML::LibXML/) |
147
|
|
|
|
|
|
|
{ |
148
|
|
|
|
|
|
|
my $x = {'element' => $opts}; |
149
|
|
|
|
|
|
|
$opts = $x; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
if ($param =~ /^([a-z][a-z0-9\+\.\-]*)\:/i) |
153
|
|
|
|
|
|
|
{ |
154
|
|
|
|
|
|
|
# seems to be an absolute URI, so can safely return "as is". |
155
|
|
|
|
|
|
|
return $param; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
elsif ($opts->{'require-absolute'}) |
158
|
|
|
|
|
|
|
{ |
159
|
|
|
|
|
|
|
return undef; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
my $base = $this->{baseuri}; |
163
|
|
|
|
|
|
|
if ($this->{'options'}->{'xml_base'}) |
164
|
|
|
|
|
|
|
{ |
165
|
|
|
|
|
|
|
$base = $opts->{'xml_base'} // $this->{baseuri}; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
my $url = url $param, $base; |
169
|
|
|
|
|
|
|
my $rv = $url->abs->as_string; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# This is needed to pass test case 0114. |
172
|
|
|
|
|
|
|
while ($rv =~ m!^(http://.*)(\.\./|\.)+(\.\.|\.)?$!i) |
173
|
|
|
|
|
|
|
{ |
174
|
|
|
|
|
|
|
$rv = $1; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
return $rv; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub dom |
181
|
|
|
|
|
|
|
{ |
182
|
|
|
|
|
|
|
my $this = shift; |
183
|
|
|
|
|
|
|
return $this->{DOM}; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
sub graph |
187
|
|
|
|
|
|
|
{ |
188
|
|
|
|
|
|
|
my $this = shift; |
189
|
|
|
|
|
|
|
$this->consume; |
190
|
|
|
|
|
|
|
return $this->{RESULTS}; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub graphs |
194
|
|
|
|
|
|
|
{ |
195
|
|
|
|
|
|
|
my $this = shift; |
196
|
|
|
|
|
|
|
$this->consume; |
197
|
|
|
|
|
|
|
return { $this->{'baseuri'} => $this->{RESULTS} }; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub set_callbacks |
201
|
|
|
|
|
|
|
# Set callback functions for handling RDF triples. |
202
|
|
|
|
|
|
|
{ |
203
|
|
|
|
|
|
|
my $this = shift; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
if ('HASH' eq ref $_[0]) |
206
|
|
|
|
|
|
|
{ |
207
|
|
|
|
|
|
|
$this->{'sub'} = $_[0]; |
208
|
|
|
|
|
|
|
$this->{'sub'}->{'pretriple_resource'} = \&_print0 |
209
|
|
|
|
|
|
|
if lc $this->{'sub'}->{'pretriple_resource'} eq 'print'; |
210
|
|
|
|
|
|
|
$this->{'sub'}->{'pretriple_literal'} = \&_print1 |
211
|
|
|
|
|
|
|
if lc $this->{'sub'}->{'pretriple_literal'} eq 'print'; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
elsif (defined $_[0]) |
214
|
|
|
|
|
|
|
{ |
215
|
|
|
|
|
|
|
croak("What kind of callback hashref was that??\n"); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
else |
218
|
|
|
|
|
|
|
{ |
219
|
|
|
|
|
|
|
$this->{'sub'} = undef; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
return $this; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub _print0 |
226
|
|
|
|
|
|
|
# Prints a Turtle triple. |
227
|
|
|
|
|
|
|
{ |
228
|
|
|
|
|
|
|
my $this = shift; |
229
|
|
|
|
|
|
|
my $element = shift; |
230
|
|
|
|
|
|
|
my $subject = shift; |
231
|
|
|
|
|
|
|
my $pred = shift; |
232
|
|
|
|
|
|
|
my $object = shift; |
233
|
|
|
|
|
|
|
my $graph = shift; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
if ($graph) |
236
|
|
|
|
|
|
|
{ |
237
|
|
|
|
|
|
|
print "# GRAPH $graph\n"; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
if ($element) |
240
|
|
|
|
|
|
|
{ |
241
|
|
|
|
|
|
|
printf("# Triple on element %s.\n", $element->nodePath); |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
else |
244
|
|
|
|
|
|
|
{ |
245
|
|
|
|
|
|
|
printf("# Triple.\n"); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
printf("%s %s %s .\n", |
249
|
|
|
|
|
|
|
($subject =~ /^_:/ ? $subject : "<$subject>"), |
250
|
|
|
|
|
|
|
"<$pred>", |
251
|
|
|
|
|
|
|
($object =~ /^_:/ ? $object : "<$object>")); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
return undef; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub _print1 |
257
|
|
|
|
|
|
|
# Prints a Turtle triple. |
258
|
|
|
|
|
|
|
{ |
259
|
|
|
|
|
|
|
my $this = shift; |
260
|
|
|
|
|
|
|
my $element = shift; |
261
|
|
|
|
|
|
|
my $subject = shift; |
262
|
|
|
|
|
|
|
my $pred = shift; |
263
|
|
|
|
|
|
|
my $object = shift; |
264
|
|
|
|
|
|
|
my $dt = shift; |
265
|
|
|
|
|
|
|
my $lang = shift; |
266
|
|
|
|
|
|
|
my $graph = shift; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# Clumsy, but probably works. |
269
|
|
|
|
|
|
|
$object =~ s/\\/\\\\/g; |
270
|
|
|
|
|
|
|
$object =~ s/\n/\\n/g; |
271
|
|
|
|
|
|
|
$object =~ s/\r/\\r/g; |
272
|
|
|
|
|
|
|
$object =~ s/\t/\\t/g; |
273
|
|
|
|
|
|
|
$object =~ s/\"/\\\"/g; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
if ($graph) |
276
|
|
|
|
|
|
|
{ |
277
|
|
|
|
|
|
|
print "# GRAPH $graph\n"; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
if ($element) |
280
|
|
|
|
|
|
|
{ |
281
|
|
|
|
|
|
|
printf("# Triple on element %s.\n", $element->nodePath); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
else |
284
|
|
|
|
|
|
|
{ |
285
|
|
|
|
|
|
|
printf("# Triple.\n"); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
no warnings; |
289
|
|
|
|
|
|
|
printf("%s %s %s%s%s .\n", |
290
|
|
|
|
|
|
|
($subject =~ /^_:/ ? $subject : "<$subject>"), |
291
|
|
|
|
|
|
|
"<$pred>", |
292
|
|
|
|
|
|
|
"\"$object\"", |
293
|
|
|
|
|
|
|
(length $dt ? "^^<$dt>" : ''), |
294
|
|
|
|
|
|
|
((length $lang && !length $dt) ? "\@$lang" : '') |
295
|
|
|
|
|
|
|
); |
296
|
|
|
|
|
|
|
use warnings; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
return undef; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub consume |
302
|
|
|
|
|
|
|
{ |
303
|
|
|
|
|
|
|
my $this = shift; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
return $this if $this->{'consumed'}; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
my @xrds = $this->{'DOM'}->getElementsByTagNameNS(NS_XRD, 'XRD')->get_nodelist; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
my $first = 1; |
310
|
|
|
|
|
|
|
my $only = (scalar @xrds == 1) ? 1 : 0; |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
foreach my $XRD (@xrds) |
313
|
|
|
|
|
|
|
{ |
314
|
|
|
|
|
|
|
$this->_consume_XRD($XRD, $first, $only); |
315
|
|
|
|
|
|
|
$first = 0 |
316
|
|
|
|
|
|
|
if $first; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
$this->{'consumed'}++; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
return $this; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub _consume_XRD |
325
|
|
|
|
|
|
|
{ |
326
|
|
|
|
|
|
|
my $this = shift; |
327
|
|
|
|
|
|
|
my $xrd = shift; |
328
|
|
|
|
|
|
|
my $first = shift // 0; |
329
|
|
|
|
|
|
|
my $only = shift // 0; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my $description_uri; |
332
|
|
|
|
|
|
|
if ($xrd->hasAttributeNS(NS_XML, 'id')) |
333
|
|
|
|
|
|
|
{ |
334
|
|
|
|
|
|
|
$description_uri = $this->uri('#'.$xrd->getAttributeNS(NS_XML, 'id')); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
elsif ($only) |
337
|
|
|
|
|
|
|
{ |
338
|
|
|
|
|
|
|
$description_uri = $this->uri; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
else |
341
|
|
|
|
|
|
|
{ |
342
|
|
|
|
|
|
|
$description_uri = $this->bnode; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
my $subject_node = $xrd->getChildrenByTagNameNS(NS_XRD, 'Subject')->shift; |
346
|
|
|
|
|
|
|
my $subject; |
347
|
|
|
|
|
|
|
my @subjects; |
348
|
|
|
|
|
|
|
$subject = $this->uri( |
349
|
|
|
|
|
|
|
$this->stringify($subject_node), |
350
|
|
|
|
|
|
|
{'require-absolute'=>1}) |
351
|
|
|
|
|
|
|
if $subject_node; |
352
|
|
|
|
|
|
|
push @subjects, $subject |
353
|
|
|
|
|
|
|
if defined $subject; |
354
|
|
|
|
|
|
|
NAMESPACE: foreach my $hostmeta_ns (@{[NS_HOSTMETA, NS_HOSTMETX]}) |
355
|
|
|
|
|
|
|
{ |
356
|
|
|
|
|
|
|
my $host_uri; |
357
|
|
|
|
|
|
|
ELEMENT: foreach my $host_node ($xrd->getChildrenByTagNameNS($hostmeta_ns, 'Host')->get_nodelist) |
358
|
|
|
|
|
|
|
{ |
359
|
|
|
|
|
|
|
$host_uri = host_uri($this->stringify($host_node)); |
360
|
|
|
|
|
|
|
$subject = $host_uri |
361
|
|
|
|
|
|
|
unless defined $subject; |
362
|
|
|
|
|
|
|
push @subjects, $host_uri; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
last NAMESPACE if $host_uri; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
unless (@subjects) |
367
|
|
|
|
|
|
|
{ |
368
|
|
|
|
|
|
|
if ($first && defined $this->{'options'}->{'default_subject'}) |
369
|
|
|
|
|
|
|
{ |
370
|
|
|
|
|
|
|
$subject = $this->{'options'}->{'default_subject'}; |
371
|
|
|
|
|
|
|
push @subjects, $subject; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
unless (@subjects) |
375
|
|
|
|
|
|
|
{ |
376
|
|
|
|
|
|
|
$subject = $this->bnode($xrd); |
377
|
|
|
|
|
|
|
push @subjects, $subject; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
$this->rdf_triple($xrd, $description_uri, URI_XRD.'subject', $subject); |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
foreach my $alias ( $xrd->getChildrenByTagNameNS(NS_XRD, 'Alias')->get_nodelist ) |
383
|
|
|
|
|
|
|
{ |
384
|
|
|
|
|
|
|
my $alias_uri = $this->uri($this->stringify($alias),{'require-absolute'=>1}); |
385
|
|
|
|
|
|
|
$this->rdf_triple($alias, $subject, URI_XRD.'alias', $alias_uri); |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
my $expires_node = $xrd->getChildrenByTagNameNS(NS_XRD, 'Expires')->shift; |
389
|
|
|
|
|
|
|
my $expires = $this->stringify($expires_node) if $expires_node; |
390
|
|
|
|
|
|
|
if (length $expires) |
391
|
|
|
|
|
|
|
{ |
392
|
|
|
|
|
|
|
$this->rdf_triple_literal($expires_node, |
393
|
|
|
|
|
|
|
$description_uri, URI_XRD.'expires', $expires, URI_XSD.'dateTime'); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
foreach my $p ($xrd->getChildrenByTagNameNS(NS_XRD, 'Property')->get_nodelist) |
397
|
|
|
|
|
|
|
{ |
398
|
|
|
|
|
|
|
$this->_consume_Property($p, \@subjects); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
foreach my $l ($xrd->getChildrenByTagNameNS(NS_XRD, 'Link')->get_nodelist) |
402
|
|
|
|
|
|
|
{ |
403
|
|
|
|
|
|
|
$this->_consume_Link($l, \@subjects); |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub _consume_Property |
408
|
|
|
|
|
|
|
{ |
409
|
|
|
|
|
|
|
my $this = shift; |
410
|
|
|
|
|
|
|
my $p = shift; |
411
|
|
|
|
|
|
|
my $S = shift; |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
my $property_uri = $this->uri( |
414
|
|
|
|
|
|
|
$p->getAttribute('type'), {'require-absolute'=>1}); |
415
|
|
|
|
|
|
|
return unless $property_uri; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
my $value = $this->stringify($p); |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
foreach my $subject_uri (@$S) |
420
|
|
|
|
|
|
|
{ |
421
|
|
|
|
|
|
|
$this->rdf_triple_literal( |
422
|
|
|
|
|
|
|
$p, |
423
|
|
|
|
|
|
|
$subject_uri, |
424
|
|
|
|
|
|
|
$property_uri, |
425
|
|
|
|
|
|
|
$value); |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub _consume_Link |
430
|
|
|
|
|
|
|
{ |
431
|
|
|
|
|
|
|
my $this = shift; |
432
|
|
|
|
|
|
|
my $l = shift; |
433
|
|
|
|
|
|
|
my $S = shift; |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
my $property_uri = HTTP::Link::Parser::relationship_uri( |
436
|
|
|
|
|
|
|
$l->getAttribute('rel')); |
437
|
|
|
|
|
|
|
return unless $property_uri; |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
my @value; |
440
|
|
|
|
|
|
|
my $value_type; |
441
|
|
|
|
|
|
|
my ($p1,$p2); |
442
|
|
|
|
|
|
|
if ($l->hasAttribute('href')) |
443
|
|
|
|
|
|
|
{ |
444
|
|
|
|
|
|
|
push @value, $this->uri($l->getAttribute('href')); |
445
|
|
|
|
|
|
|
$value_type = 'href'; |
446
|
|
|
|
|
|
|
($p1,$p2) = ('', $property_uri); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
elsif ($l->hasAttribute('template')) |
449
|
|
|
|
|
|
|
{ |
450
|
|
|
|
|
|
|
push @value, $l->getAttribute('template'); |
451
|
|
|
|
|
|
|
push @value, URI_XRD . 'URITemplate'; |
452
|
|
|
|
|
|
|
$value_type = 'template'; |
453
|
|
|
|
|
|
|
($p1,$p2) = (SCHEME_TMPL, $property_uri); |
454
|
|
|
|
|
|
|
$property_uri = template_uri($property_uri); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
else |
457
|
|
|
|
|
|
|
{ |
458
|
|
|
|
|
|
|
return; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
foreach my $subject_uri (@$S) |
462
|
|
|
|
|
|
|
{ |
463
|
|
|
|
|
|
|
if ($value_type eq 'href') |
464
|
|
|
|
|
|
|
{ |
465
|
|
|
|
|
|
|
$this->rdf_triple( |
466
|
|
|
|
|
|
|
$l, |
467
|
|
|
|
|
|
|
$subject_uri, |
468
|
|
|
|
|
|
|
$property_uri, |
469
|
|
|
|
|
|
|
@value); |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
elsif ($value_type eq 'template') |
472
|
|
|
|
|
|
|
{ |
473
|
|
|
|
|
|
|
$this->rdf_triple_literal( |
474
|
|
|
|
|
|
|
$l, |
475
|
|
|
|
|
|
|
$subject_uri, |
476
|
|
|
|
|
|
|
$property_uri, |
477
|
|
|
|
|
|
|
@value); |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
if ($value_type eq 'href') |
482
|
|
|
|
|
|
|
{ |
483
|
|
|
|
|
|
|
my $type = $l->getAttribute('type'); |
484
|
|
|
|
|
|
|
if (defined $type) |
485
|
|
|
|
|
|
|
{ |
486
|
|
|
|
|
|
|
$this->rdf_triple_literal($l, @value, URI_XRD.'type', $type); |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
foreach my $title ($l->getChildrenByTagName('Title')->get_nodelist) |
490
|
|
|
|
|
|
|
{ |
491
|
|
|
|
|
|
|
my $lang = undef; |
492
|
|
|
|
|
|
|
if ($title->hasAttributeNS(NS_XML, 'lang')) |
493
|
|
|
|
|
|
|
{ |
494
|
|
|
|
|
|
|
$lang = $title->getAttributeNS(NS_XML, 'lang'); |
495
|
|
|
|
|
|
|
$lang = undef unless valid_lang($lang); |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
$this->rdf_triple_literal( |
498
|
|
|
|
|
|
|
$title, |
499
|
|
|
|
|
|
|
@value, |
500
|
|
|
|
|
|
|
URI_XRD.'title', |
501
|
|
|
|
|
|
|
$this->stringify($title), |
502
|
|
|
|
|
|
|
undef, |
503
|
|
|
|
|
|
|
$lang); |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
foreach my $subject_uri (@$S) |
508
|
|
|
|
|
|
|
{ |
509
|
|
|
|
|
|
|
my @link_properties = $l->getChildrenByTagNameNS(NS_XRD, 'Property')->get_nodelist; |
510
|
|
|
|
|
|
|
if (@link_properties) |
511
|
|
|
|
|
|
|
{ |
512
|
|
|
|
|
|
|
if ($this->{'options'}->{'link_prop'} & 1) |
513
|
|
|
|
|
|
|
{ |
514
|
|
|
|
|
|
|
my $reified_statement = $this->bnode($l); |
515
|
|
|
|
|
|
|
$this->rdf_triple($l, $reified_statement, URI_RDF.'type', URI_RDF.'Statement'); |
516
|
|
|
|
|
|
|
$this->rdf_triple($l, $reified_statement, URI_RDF.'subject', $subject_uri); |
517
|
|
|
|
|
|
|
$this->rdf_triple($l, $reified_statement, URI_RDF.'predicate', $property_uri); |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
if ($value_type eq 'href') |
520
|
|
|
|
|
|
|
{ |
521
|
|
|
|
|
|
|
$this->rdf_triple($l, $reified_statement, URI_RDF.'object', @value); |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
else |
524
|
|
|
|
|
|
|
{ |
525
|
|
|
|
|
|
|
$this->rdf_triple_literal($l, $reified_statement, URI_RDF.'object', @value); |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
foreach my $lp (@link_properties) |
529
|
|
|
|
|
|
|
{ |
530
|
|
|
|
|
|
|
$this->_consume_Property($lp, [$reified_statement]); |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
if ($this->{'options'}->{'link_prop'} & 2) |
534
|
|
|
|
|
|
|
{ |
535
|
|
|
|
|
|
|
my $subPropUri = $p1 . URI_SUBLINK . uri_escape($p2); |
536
|
|
|
|
|
|
|
my @modifiers; |
537
|
|
|
|
|
|
|
foreach my $lp (@link_properties) |
538
|
|
|
|
|
|
|
{ |
539
|
|
|
|
|
|
|
my $k = $this->uri($lp->getAttribute('type'), {'require-absolute'=>1}); |
540
|
|
|
|
|
|
|
my $v = $this->stringify($lp); |
541
|
|
|
|
|
|
|
push @modifiers, sprintf('%s=%s', uri_escape($k), uri_escape($v)) |
542
|
|
|
|
|
|
|
if length $k; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
my $supermodifier = join '&', sort @modifiers; |
545
|
|
|
|
|
|
|
$subPropUri .= '/' . sha1_hex($supermodifier); |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
if ($value_type eq 'href') |
548
|
|
|
|
|
|
|
{ |
549
|
|
|
|
|
|
|
$this->rdf_triple($l, $subject_uri, $subPropUri, @value); |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
else |
552
|
|
|
|
|
|
|
{ |
553
|
|
|
|
|
|
|
$this->rdf_triple_literal($l, $subject_uri, $subPropUri, @value); |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
$this->rdf_triple($l, $subPropUri, URI_RDF.'type', URI_RDF.'Property'); |
557
|
|
|
|
|
|
|
$this->rdf_triple($l, $subPropUri, URI_RDFS.'subPropertyOf', $property_uri); |
558
|
|
|
|
|
|
|
foreach my $lp (@link_properties) |
559
|
|
|
|
|
|
|
{ |
560
|
|
|
|
|
|
|
$this->_consume_Property($lp, [$subPropUri]); |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub rdf_triple |
568
|
|
|
|
|
|
|
# Function only used internally. |
569
|
|
|
|
|
|
|
{ |
570
|
|
|
|
|
|
|
my $this = shift; |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
my $suppress_triple = 0; |
573
|
|
|
|
|
|
|
$suppress_triple = $this->{'sub'}->{'pretriple_resource'}($this, @_) |
574
|
|
|
|
|
|
|
if defined $this->{'sub'}->{'pretriple_resource'}; |
575
|
|
|
|
|
|
|
return if $suppress_triple; |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
my $element = shift; # A reference to the XML::LibXML element being parsed |
578
|
|
|
|
|
|
|
my $subject = shift; # Subject URI or bnode |
579
|
|
|
|
|
|
|
my $predicate = shift; # Predicate URI |
580
|
|
|
|
|
|
|
my $object = shift; # Resource URI or bnode |
581
|
|
|
|
|
|
|
my $graph = shift; # Graph URI or bnode (if named graphs feature is enabled) |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# First make sure the object node type is ok. |
584
|
|
|
|
|
|
|
my $to; |
585
|
|
|
|
|
|
|
if ($object =~ m/^_:(.*)/) |
586
|
|
|
|
|
|
|
{ |
587
|
|
|
|
|
|
|
$to = RDF::Trine::Node::Blank->new($1); |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
else |
590
|
|
|
|
|
|
|
{ |
591
|
|
|
|
|
|
|
$to = RDF::Trine::Node::Resource->new($object); |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# Run the common function |
595
|
|
|
|
|
|
|
return $this->rdf_triple_common($element, $subject, $predicate, $to, $graph); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
sub rdf_triple_literal |
599
|
|
|
|
|
|
|
# Function only used internally. |
600
|
|
|
|
|
|
|
{ |
601
|
|
|
|
|
|
|
my $this = shift; |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
my $suppress_triple = 0; |
604
|
|
|
|
|
|
|
$suppress_triple = $this->{'sub'}->{'pretriple_literal'}($this, @_) |
605
|
|
|
|
|
|
|
if defined $this->{'sub'}->{'pretriple_literal'}; |
606
|
|
|
|
|
|
|
return if $suppress_triple; |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
my $element = shift; # A reference to the XML::LibXML element being parsed |
609
|
|
|
|
|
|
|
my $subject = shift; # Subject URI or bnode |
610
|
|
|
|
|
|
|
my $predicate = shift; # Predicate URI |
611
|
|
|
|
|
|
|
my $object = shift; # Resource Literal |
612
|
|
|
|
|
|
|
my $datatype = shift; # Datatype URI (possibly undef or '') |
613
|
|
|
|
|
|
|
my $language = shift; # Language (possibly undef or '') |
614
|
|
|
|
|
|
|
my $graph = shift; # Graph URI or bnode (if named graphs feature is enabled) |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# Now we know there's a literal |
617
|
|
|
|
|
|
|
my $to; |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
# Work around bad Unicode handling in RDF::Trine. |
620
|
|
|
|
|
|
|
$object = encode_utf8($object); |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
if (defined $datatype) |
623
|
|
|
|
|
|
|
{ |
624
|
|
|
|
|
|
|
if ($datatype eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral') |
625
|
|
|
|
|
|
|
{ |
626
|
|
|
|
|
|
|
if ($this->{'options'}->{'use_rtnlx'}) |
627
|
|
|
|
|
|
|
{ |
628
|
|
|
|
|
|
|
eval |
629
|
|
|
|
|
|
|
{ |
630
|
|
|
|
|
|
|
require RDF::Trine::Node::Literal::XML; |
631
|
|
|
|
|
|
|
$to = RDF::Trine::Node::Literal::XML->new($element->childNodes); |
632
|
|
|
|
|
|
|
}; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
if ( $@ || !defined $to) |
636
|
|
|
|
|
|
|
{ |
637
|
|
|
|
|
|
|
my $orig = $RDF::Trine::Node::Literal::USE_XMLLITERALS; |
638
|
|
|
|
|
|
|
$RDF::Trine::Node::Literal::USE_XMLLITERALS = 0; |
639
|
|
|
|
|
|
|
$to = RDF::Trine::Node::Literal->new($object, undef, $datatype); |
640
|
|
|
|
|
|
|
$RDF::Trine::Node::Literal::USE_XMLLITERALS = $orig; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
else |
644
|
|
|
|
|
|
|
{ |
645
|
|
|
|
|
|
|
$to = RDF::Trine::Node::Literal->new($object, undef, $datatype); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
else |
649
|
|
|
|
|
|
|
{ |
650
|
|
|
|
|
|
|
$to = RDF::Trine::Node::Literal->new($object, $language, undef); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
# Run the common function |
654
|
|
|
|
|
|
|
$this->rdf_triple_common($element, $subject, $predicate, $to, $graph); |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
sub rdf_triple_common |
658
|
|
|
|
|
|
|
# Function only used internally. |
659
|
|
|
|
|
|
|
{ |
660
|
|
|
|
|
|
|
my $this = shift; # A reference to the RDF::RDFa::Parser object |
661
|
|
|
|
|
|
|
my $element = shift; # A reference to the XML::LibXML element being parsed |
662
|
|
|
|
|
|
|
my $subject = shift; # Subject URI or bnode |
663
|
|
|
|
|
|
|
my $predicate = shift; # Predicate URI |
664
|
|
|
|
|
|
|
my $to = shift; # RDF::Trine::Node Resource URI or bnode |
665
|
|
|
|
|
|
|
my $graph = shift; # Graph URI or bnode (if named graphs feature is enabled) |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# First, make sure subject and predicates are the right kind of nodes |
668
|
|
|
|
|
|
|
my $tp = RDF::Trine::Node::Resource->new($predicate); |
669
|
|
|
|
|
|
|
my $ts; |
670
|
|
|
|
|
|
|
if ($subject =~ m/^_:(.*)/) |
671
|
|
|
|
|
|
|
{ |
672
|
|
|
|
|
|
|
$ts = RDF::Trine::Node::Blank->new($1); |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
else |
675
|
|
|
|
|
|
|
{ |
676
|
|
|
|
|
|
|
$ts = RDF::Trine::Node::Resource->new($subject); |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
my $statement; |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
# If we are configured for it, and graph name can be found, add it. |
682
|
|
|
|
|
|
|
if (ref($this->{'options'}->{'named_graphs'}) && ($graph)) |
683
|
|
|
|
|
|
|
{ |
684
|
|
|
|
|
|
|
$this->{Graphs}->{$graph}++; |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
my $tg; |
687
|
|
|
|
|
|
|
if ($graph =~ m/^_:(.*)/) |
688
|
|
|
|
|
|
|
{ |
689
|
|
|
|
|
|
|
$tg = RDF::Trine::Node::Blank->new($1); |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
else |
692
|
|
|
|
|
|
|
{ |
693
|
|
|
|
|
|
|
$tg = RDF::Trine::Node::Resource->new($graph); |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
$statement = RDF::Trine::Statement::Quad->new($ts, $tp, $to, $tg); |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
else |
699
|
|
|
|
|
|
|
{ |
700
|
|
|
|
|
|
|
$statement = RDF::Trine::Statement->new($ts, $tp, $to); |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
my $suppress_triple = 0; |
704
|
|
|
|
|
|
|
$suppress_triple = $this->{'sub'}->{'ontriple'}($this, $element, $statement) |
705
|
|
|
|
|
|
|
if ($this->{'sub'}->{'ontriple'}); |
706
|
|
|
|
|
|
|
return if $suppress_triple; |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
$this->{RESULTS}->add_statement($statement); |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
sub stringify |
712
|
|
|
|
|
|
|
# Function only used internally. |
713
|
|
|
|
|
|
|
{ |
714
|
|
|
|
|
|
|
my $this = shift; |
715
|
|
|
|
|
|
|
my $dom = shift; |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
if ($dom->nodeType == XML_TEXT_NODE) |
718
|
|
|
|
|
|
|
{ |
719
|
|
|
|
|
|
|
return $dom->getData; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
elsif ($dom->nodeType == XML_ELEMENT_NODE) |
722
|
|
|
|
|
|
|
{ |
723
|
|
|
|
|
|
|
my $rv = ''; |
724
|
|
|
|
|
|
|
foreach my $kid ($dom->childNodes) |
725
|
|
|
|
|
|
|
{ $rv .= $this->stringify($kid); } |
726
|
|
|
|
|
|
|
return $rv; |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
return ''; |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
sub xmlify |
733
|
|
|
|
|
|
|
# Function only used internally. |
734
|
|
|
|
|
|
|
{ |
735
|
|
|
|
|
|
|
my $this = shift; |
736
|
|
|
|
|
|
|
my $dom = shift; |
737
|
|
|
|
|
|
|
my $lang = shift; |
738
|
|
|
|
|
|
|
my $rv; |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
foreach my $kid ($dom->childNodes) |
741
|
|
|
|
|
|
|
{ |
742
|
|
|
|
|
|
|
my $fakelang = 0; |
743
|
|
|
|
|
|
|
if (($kid->nodeType == XML_ELEMENT_NODE) && defined $lang) |
744
|
|
|
|
|
|
|
{ |
745
|
|
|
|
|
|
|
unless ($kid->hasAttributeNS(NS_XML, 'lang')) |
746
|
|
|
|
|
|
|
{ |
747
|
|
|
|
|
|
|
$kid->setAttributeNS(NS_XML, 'lang', $lang); |
748
|
|
|
|
|
|
|
$fakelang++; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
$rv .= $kid->toStringEC14N(1); |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
if ($fakelang) |
755
|
|
|
|
|
|
|
{ |
756
|
|
|
|
|
|
|
$kid->removeAttributeNS(NS_XML, 'lang'); |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
return $rv; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
sub bnode |
764
|
|
|
|
|
|
|
# Function only used internally. |
765
|
|
|
|
|
|
|
{ |
766
|
|
|
|
|
|
|
my $this = shift; |
767
|
|
|
|
|
|
|
my $element = shift; |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
return sprintf('http://thing-described-by.org/?%s#%s', |
770
|
|
|
|
|
|
|
$this->uri, |
771
|
|
|
|
|
|
|
$element->getAttributeNS(NS_XML, 'id')) |
772
|
|
|
|
|
|
|
if ($this->{options}->{tdb_service} && $element && length $element->getAttributeNS(NS_XML, 'id')); |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
$this->{bnode_prefix} //= do { |
775
|
|
|
|
|
|
|
my $uuid = Data::UUID->new->create_str; |
776
|
|
|
|
|
|
|
$uuid =~ s/[^A-Za-z0-9]//g; |
777
|
|
|
|
|
|
|
$uuid; |
778
|
|
|
|
|
|
|
}; |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
return sprintf('_:x%sx%03d', $this->{bnode_prefix}, $this->{bnodes}++); |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
sub valid_lang |
784
|
|
|
|
|
|
|
{ |
785
|
|
|
|
|
|
|
my $value_to_test = shift; |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
return 1 if (defined $value_to_test) && ($value_to_test eq ''); |
788
|
|
|
|
|
|
|
return 0 unless defined $value_to_test; |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
# Regex for recognizing RFC 4646 well-formed tags |
791
|
|
|
|
|
|
|
# http://www.rfc-editor.org/rfc/rfc4646.txt |
792
|
|
|
|
|
|
|
# http://tools.ietf.org/html/draft-ietf-ltru-4646bis-21 |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
# The structure requires no forward references, so it reverses the order. |
795
|
|
|
|
|
|
|
# It uses Java/Perl syntax instead of the old ABNF |
796
|
|
|
|
|
|
|
# The uppercase comments are fragments copied from RFC 4646 |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
# Note: the tool requires that any real "=" or "#" or ";" in the regex be escaped. |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
my $alpha = '[a-z]'; # ALPHA |
801
|
|
|
|
|
|
|
my $digit = '[0-9]'; # DIGIT |
802
|
|
|
|
|
|
|
my $alphanum = '[a-z0-9]'; # ALPHA / DIGIT |
803
|
|
|
|
|
|
|
my $x = 'x'; # private use singleton |
804
|
|
|
|
|
|
|
my $singleton = '[a-wyz]'; # other singleton |
805
|
|
|
|
|
|
|
my $s = '[_-]'; # separator -- lenient parsers will use [_-] -- strict will use [-] |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
# Now do the components. The structure is slightly different to allow for capturing the right components. |
808
|
|
|
|
|
|
|
# The notation (?:....) is a non-capturing version of (...): so the "?:" can be deleted if someone doesn't care about capturing. |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
my $language = '([a-z]{2,8}) | ([a-z]{2,3} $s [a-z]{3})'; |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
# ABNF (2*3ALPHA) / 4ALPHA / 5*8ALPHA --- note: because of how | works in regex, don't use $alpha{2,3} | $alpha{4,8} |
813
|
|
|
|
|
|
|
# We don't have to have the general case of extlang, because there can be only one extlang (except for zh-min-nan). |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
# Note: extlang invalid in Unicode language tags |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
my $script = '[a-z]{4}' ; # 4ALPHA |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
my $region = '(?: [a-z]{2}|[0-9]{3})' ; # 2ALPHA / 3DIGIT |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
my $variant = '(?: [a-z0-9]{5,8} | [0-9] [a-z0-9]{3} )' ; # 5*8alphanum / (DIGIT 3alphanum) |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
my $extension = '(?: [a-wyz] (?: [_-] [a-z0-9]{2,8} )+ )' ; # singleton 1*("-" (2*8alphanum)) |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
my $privateUse = '(?: x (?: [_-] [a-z0-9]{1,8} )+ )' ; # "x" 1*("-" (1*8alphanum)) |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
# Define certain grandfathered codes, since otherwise the regex is pretty useless. |
828
|
|
|
|
|
|
|
# Since these are limited, this is safe even later changes to the registry -- |
829
|
|
|
|
|
|
|
# the only oddity is that it might change the type of the tag, and thus |
830
|
|
|
|
|
|
|
# the results from the capturing groups. |
831
|
|
|
|
|
|
|
# http://www.iana.org/assignments/language-subtag-registry |
832
|
|
|
|
|
|
|
# Note that these have to be compared case insensitively, requiring (?i) below. |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
my $grandfathered = '(?: |
835
|
|
|
|
|
|
|
(en [_-] GB [_-] oed) |
836
|
|
|
|
|
|
|
| (i [_-] (?: ami | bnn | default | enochian | hak | klingon | lux | mingo | navajo | pwn | tao | tay | tsu )) |
837
|
|
|
|
|
|
|
| (no [_-] (?: bok | nyn )) |
838
|
|
|
|
|
|
|
| (sgn [_-] (?: BE [_-] (?: fr | nl) | CH [_-] de )) |
839
|
|
|
|
|
|
|
| (zh [_-] min [_-] nan) |
840
|
|
|
|
|
|
|
)'; |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
# old: | zh $s (?: cmn (?: $s Hans | $s Hant )? | gan | min (?: $s nan)? | wuu | yue ); |
843
|
|
|
|
|
|
|
# For well-formedness, we don't need the ones that would otherwise pass. |
844
|
|
|
|
|
|
|
# For validity, they need to be checked. |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
# $grandfatheredWellFormed = (?: |
847
|
|
|
|
|
|
|
# art $s lojban |
848
|
|
|
|
|
|
|
# | cel $s gaulish |
849
|
|
|
|
|
|
|
# | zh $s (?: guoyu | hakka | xiang ) |
850
|
|
|
|
|
|
|
# ); |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
# Unicode locales: but we are shifting to a compatible form |
853
|
|
|
|
|
|
|
# $keyvalue = (?: $alphanum+ \= $alphanum+); |
854
|
|
|
|
|
|
|
# $keywords = ($keyvalue (?: \; $keyvalue)*); |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
# We separate items that we want to capture as a single group |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
my $variantList = $variant . '(?:' . $s . $variant . ')*' ; # special for multiples |
859
|
|
|
|
|
|
|
my $extensionList = $extension . '(?:' . $s . $extension . ')*' ; # special for multiples |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
my $langtag = " |
862
|
|
|
|
|
|
|
($language) |
863
|
|
|
|
|
|
|
($s ( $script ) )? |
864
|
|
|
|
|
|
|
($s ( $region ) )? |
865
|
|
|
|
|
|
|
($s ( $variantList ) )? |
866
|
|
|
|
|
|
|
($s ( $extensionList ) )? |
867
|
|
|
|
|
|
|
($s ( $privateUse ) )? |
868
|
|
|
|
|
|
|
"; |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
# Here is the final breakdown, with capturing groups for each of these components |
871
|
|
|
|
|
|
|
# The variants, extensions, grandfathered, and private-use may have interior '-' |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
my $r = ($value_to_test =~ |
874
|
|
|
|
|
|
|
/^( |
875
|
|
|
|
|
|
|
($langtag) |
876
|
|
|
|
|
|
|
| ($privateUse) |
877
|
|
|
|
|
|
|
| ($grandfathered) |
878
|
|
|
|
|
|
|
)$/xi); |
879
|
|
|
|
|
|
|
return $r; |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
sub host_uri |
883
|
|
|
|
|
|
|
{ |
884
|
|
|
|
|
|
|
my $uri = shift; |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
if ($uri =~ /:/) |
887
|
|
|
|
|
|
|
{ |
888
|
|
|
|
|
|
|
my $tmpuri = URI->new($uri); |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
if ($tmpuri->can('host')) |
891
|
|
|
|
|
|
|
{ |
892
|
|
|
|
|
|
|
return URI_HOST . $tmpuri->host; |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
elsif($tmpuri->can('authority') && $tmpuri->authority =~ /\@/) |
895
|
|
|
|
|
|
|
{ |
896
|
|
|
|
|
|
|
(undef, my $host) = split /\@/, $tmpuri->authority; |
897
|
|
|
|
|
|
|
return URI_HOST . $host; |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
elsif($tmpuri->can('opaque') && $tmpuri->opaque =~ /\@/) |
900
|
|
|
|
|
|
|
{ |
901
|
|
|
|
|
|
|
(undef, my $host) = split /\@/, $tmpuri->opaque; |
902
|
|
|
|
|
|
|
return URI_HOST . $host; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
else |
906
|
|
|
|
|
|
|
{ |
907
|
|
|
|
|
|
|
return URI_HOST . $uri; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
return undef; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
sub template_uri |
914
|
|
|
|
|
|
|
{ |
915
|
|
|
|
|
|
|
my $uri = shift; |
916
|
|
|
|
|
|
|
return SCHEME_TMPL . $uri; |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
sub hostmeta_location |
921
|
|
|
|
|
|
|
{ |
922
|
|
|
|
|
|
|
my $host = shift; |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
if ($host =~ /:/) |
925
|
|
|
|
|
|
|
{ |
926
|
|
|
|
|
|
|
my $u = url $host; |
927
|
|
|
|
|
|
|
if ($u->can('host')) |
928
|
|
|
|
|
|
|
{ |
929
|
|
|
|
|
|
|
$host = $u->host; |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
elsif ($u->can('authority') && $u->authority =~ /\@/) |
932
|
|
|
|
|
|
|
{ |
933
|
|
|
|
|
|
|
(undef, $host) = split /\@/, $u->authority; |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
elsif ($u->can('opaque') && $u->opaque =~ /\@/) |
936
|
|
|
|
|
|
|
{ |
937
|
|
|
|
|
|
|
(undef, $host) = split /\@/, $u->opaque; |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
} |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
if (wantarray) |
942
|
|
|
|
|
|
|
{ |
943
|
|
|
|
|
|
|
return ("https://$host/.well-known/host-meta", "http://$host/.well-known/host-meta"); |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
else |
946
|
|
|
|
|
|
|
{ |
947
|
|
|
|
|
|
|
return "http://$host/.well-known/host-meta"; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
} |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
1; |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
__END__ |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=head1 NAME |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
XRD::Parser - parse XRD and host-meta files into RDF::Trine models |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=head1 SYNOPSIS |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
use RDF::Query; |
962
|
|
|
|
|
|
|
use XRD::Parser; |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
my $parser = XRD::Parser->new(undef, "http://example.com/foo.xrd"); |
965
|
|
|
|
|
|
|
my $results = RDF::Query->new( |
966
|
|
|
|
|
|
|
"SELECT * WHERE {?who <http://spec.example.net/auth/1.0> ?auth.}") |
967
|
|
|
|
|
|
|
->execute($parser->graph); |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
while (my $result = $results->next) |
970
|
|
|
|
|
|
|
{ |
971
|
|
|
|
|
|
|
print $result->{'auth'}->uri . "\n"; |
972
|
|
|
|
|
|
|
} |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
or maybe: |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
my $data = XRD::Parser->hostmeta('gmail.com') |
977
|
|
|
|
|
|
|
->graph |
978
|
|
|
|
|
|
|
->as_hashref; |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=head1 DESCRIPTION |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
While XRD has a rather different history, it turns out it can mostly |
983
|
|
|
|
|
|
|
be thought of as a serialisation format for a limited subset of |
984
|
|
|
|
|
|
|
RDF. |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
This package ignores the order of <Link> elements, as RDF is a graph |
987
|
|
|
|
|
|
|
format with no concept of statements coming in an "order". The XRD spec |
988
|
|
|
|
|
|
|
says that grokking the order of <Link> elements is only a SHOULD. That |
989
|
|
|
|
|
|
|
said, if you're concerned about the order of <Link> elements, the |
990
|
|
|
|
|
|
|
callback routines allowed by this package may be of use. |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
This package aims to be roughly compatible with RDF::RDFa::Parser's |
993
|
|
|
|
|
|
|
interface. |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
=head2 Constructors |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=over 4 |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=item C<< $p = XRD::Parser->new($content, $uri, [\%options], [$store]) >> |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
This method creates a new XRD::Parser object and returns it. |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
The $content variable may contain an XML string, or a XML::LibXML::Document. |
1004
|
|
|
|
|
|
|
If a string, the document is parsed using XML::LibXML::Parser, which may throw an |
1005
|
|
|
|
|
|
|
exception. XRD::Parser does not catch the exception. |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
$uri the base URI of the content; it is used to resolve any relative URIs found |
1008
|
|
|
|
|
|
|
in the XRD document. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
Options [default in brackets]: |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
=over 8 |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
=item * B<default_subject> - If no <Subject> element. [undef] |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
=item * B<link_prop> - How to handle <Property> in <Link>? |
1017
|
|
|
|
|
|
|
0=skip, 1=reify, 2=subproperty, 3=both. [0] |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=item * B<loose_mime> - Accept text/plain, text/html and |
1020
|
|
|
|
|
|
|
application/octet-stream media types. [0] |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
=item * B<tdb_service> - Use thing-described-by.org when possible. [0] |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
=back |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
$storage is an RDF::Trine::Storage object. If undef, then a new |
1027
|
|
|
|
|
|
|
temporary store is created. |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
=item C<< $p = XRD::Parser->new_from_url($url, [\%options], [$storage]) >> |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
$url is a URL to fetch and parse. |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
This function can also be called as C<new_from_uri>. Same thing. |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=item C<< $p = XRD::Parser->hostmeta($uri) >> |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
This method creates a new XRD::Parser object and returns it. |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
The parameter may be a URI (from which the hostname will be extracted) or |
1040
|
|
|
|
|
|
|
just a bare host name (e.g. "example.com"). The resource |
1041
|
|
|
|
|
|
|
"/.well-known/host-meta" will then be fetched from that host using an |
1042
|
|
|
|
|
|
|
appropriate HTTP Accept header, and the parser object returned. |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
=back |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
=head2 Public Methods |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
=over 4 |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=item C<< $p->uri($uri) >> |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Returns the base URI of the document being parsed. This will usually be the |
1053
|
|
|
|
|
|
|
same as the base URI provided to the constructor. |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
Optionally it may be passed a parameter - an absolute or relative URI - in |
1056
|
|
|
|
|
|
|
which case it returns the same URI which it was passed as a parameter, but |
1057
|
|
|
|
|
|
|
as an absolute URI, resolved relative to the document's base URI. |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
This seems like two unrelated functions, but if you consider the consequence |
1060
|
|
|
|
|
|
|
of passing a relative URI consisting of a zero-length string, it in fact makes |
1061
|
|
|
|
|
|
|
sense. |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
=item C<< $p->dom >> |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
Returns the parsed XML::LibXML::Document. |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
=item C<< $p->graph >> |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
This method will return an RDF::Trine::Model object with all |
1070
|
|
|
|
|
|
|
statements of the full graph. |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
This method will automatically call C<consume> first, if it has not |
1073
|
|
|
|
|
|
|
already been called. |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=item $p->set_callbacks(\%callbacks) |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
Set callback functions for the parser to call on certain events. These are only necessary if |
1078
|
|
|
|
|
|
|
you want to do something especially unusual. |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
$p->set_callbacks({ |
1081
|
|
|
|
|
|
|
'pretriple_resource' => sub { ... } , |
1082
|
|
|
|
|
|
|
'pretriple_literal' => sub { ... } , |
1083
|
|
|
|
|
|
|
'ontriple' => undef , |
1084
|
|
|
|
|
|
|
}); |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
Either of the two pretriple callbacks can be set to the string 'print' instead of a coderef. |
1087
|
|
|
|
|
|
|
This enables built-in callbacks for printing Turtle to STDOUT. |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
For details of the callback functions, see the section CALLBACKS. C<set_callbacks> must |
1090
|
|
|
|
|
|
|
be used I<before> C<consume>. C<set_callbacks> itself returns a reference to the parser |
1091
|
|
|
|
|
|
|
object itself. |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
I<NOTE:> the behaviour of this function was changed in version 0.05. |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
=item C<< $p->consume >> |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
This method processes the input DOM and sends the resulting triples to |
1098
|
|
|
|
|
|
|
the callback functions (if any). |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
It called again, does nothing. |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
Returns the parser object itself. |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
=back |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
=head2 Utility Functions |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=over 4 |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=item C<< $host_uri = XRD::Parser::host_uri($uri) >> |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
Returns a URI representing the host. These crop up often in graphs gleaned |
1113
|
|
|
|
|
|
|
from host-meta files. |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
$uri can be an absolute URI like 'http://example.net/foo#bar' or a host |
1116
|
|
|
|
|
|
|
name like 'example.com'. |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=item C<< $uri = XRD::Parser::template_uri($relationship_uri) >> |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
Returns a URI representing not a normal relationship, but the |
1121
|
|
|
|
|
|
|
relationship between a host and a template URI literal. |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=item C<< $hostmeta_uri = XRD::Parser::hostmeta_location($host) >> |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
The parameter may be a URI (from which the hostname will be extracted) or |
1126
|
|
|
|
|
|
|
just a bare host name (e.g. "example.com"). The location for a host-meta file |
1127
|
|
|
|
|
|
|
relevant to the host of that URI will be calculated. |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
If called in list context, returns an 'https' URI and an 'http' URI as a list. |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
=back |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
=head1 CALLBACKS |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
Several callback functions are provided. These may be set using the C<set_callbacks> function, |
1136
|
|
|
|
|
|
|
which taskes a hashref of keys pointing to coderefs. The keys are named for the event to fire the |
1137
|
|
|
|
|
|
|
callback on. |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
=head2 pretriple_resource |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
This is called when a triple has been found, but before preparing the triple for |
1142
|
|
|
|
|
|
|
adding to the model. It is only called for triples with a non-literal object value. |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
The parameters passed to the callback function are: |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
=over 4 |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=item * A reference to the C<XRD::Parser> object |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
=item * A reference to the C<XML::LibXML::Element> being parsed |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=item * Subject URI or bnode (string) |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
=item * Predicate URI (string) |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=item * Object URI or bnode (string) |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=back |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
The callback should return 1 to tell the parser to skip this triple (not add it to |
1161
|
|
|
|
|
|
|
the graph); return 0 otherwise. |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
=head2 pretriple_literal |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
This is the equivalent of pretriple_resource, but is only called for triples with a |
1166
|
|
|
|
|
|
|
literal object value. |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
The parameters passed to the callback function are: |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=over 4 |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=item * A reference to the C<XRD::Parser> object |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
=item * A reference to the C<XML::LibXML::Element> being parsed |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=item * Subject URI or bnode (string) |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=item * Predicate URI (string) |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=item * Object literal (string) |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
=item * Datatype URI (string or undef) |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
=item * Language (string or undef) |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
=back |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
The callback should return 1 to tell the parser to skip this triple (not add it to |
1189
|
|
|
|
|
|
|
the graph); return 0 otherwise. |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
=head2 ontriple |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
This is called once a triple is ready to be added to the graph. (After the pretriple |
1194
|
|
|
|
|
|
|
callbacks.) The parameters passed to the callback function are: |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=over 4 |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
=item * A reference to the C<XRD::Parser> object |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
=item * A reference to the C<XML::LibXML::Element> being parsed |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
=item * An RDF::Trine::Statement object. |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
=back |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
The callback should return 1 to tell the parser to skip this triple (not add it to |
1207
|
|
|
|
|
|
|
the graph); return 0 otherwise. The callback may modify the RDF::Trine::Statement |
1208
|
|
|
|
|
|
|
object. |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=head1 WHY RDF? |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
It abstracts away the structure of the XRD file, exposing just the meaning |
1213
|
|
|
|
|
|
|
of its contents. Two XRD files with the same meaning should end up producing |
1214
|
|
|
|
|
|
|
more or less the same RDF data, even if they differ significantly at the |
1215
|
|
|
|
|
|
|
syntactic level. |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
If you care about the syntax of an XRD file, then use L<XML::LibXML>. |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
=head1 SEE ALSO |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
L<RDF::Trine>, L<RDF::Query>, L<RDF::RDFa::Parser>. |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
L<http://www.perlrdf.org/>. |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
=head1 AUTHOR |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
Toby Inkster, E<lt>tobyink@cpan.orgE<gt> |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENCE |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
Copyright (C) 2009-2012 by Toby Inkster |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
1234
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTIES |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED |
1239
|
|
|
|
|
|
|
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF |
1240
|
|
|
|
|
|
|
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
=cut |