File Coverage

blib/lib/AtteanX/Parser/RDFXML.pm
Criterion Covered Total %
statement 335 490 68.3
branch 80 162 49.3
condition 18 48 37.5
subroutine 58 60 96.6
pod 5 5 100.0
total 496 765 64.8


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             AtteanX::Parser::RDFXML - RDF/XML Parser
4              
5             =head1 VERSION
6              
7             This document describes AtteanX::Parser::RDFXML version 0.032
8              
9             =head1 SYNOPSIS
10              
11             use Attean;
12             my $parser = Attean->get_parser('RDFXML')->new(base => $base_iri);
13              
14             use AtteanX::Parser::Turtle;
15             my $parser = AtteanX::Parser::Turtle->new( handler => sub {...}, base => $base_iri );
16            
17             # Parse data from a file-handle and handle triples in the 'handler' callback
18             $parser->parse_cb_from_io( $fh );
19            
20             # Parse the given byte-string, and return an iterator of triples
21             my $iter = $parser->parse_iter_from_bytes('<rdf:RDF>...</rdf:RDF>');
22             while (my $triple = $iter->next) {
23             print $triple->as_string;
24             }
25              
26             =head1 DESCRIPTION
27              
28             This module implements a parser for the RDF/XML format.
29              
30             =head1 ROLES
31              
32             This class consumes L<Attean::API::Parser>, L<Attean::API::PushParser>,
33             <Attean::API::AbbreviatingParser>, and <Attean::API::TripleParser>.
34              
35             =head1 ATTRIBUTES
36              
37             =over 4
38              
39             =item C<< canonical_media_type >>
40              
41             =item C<< media_types >>
42              
43             =item C<< file_extensions >>
44              
45             =item C<< bnode_prefix >>
46              
47             A string prefix for identifiers generated for blank nodes.
48              
49             =back
50              
51             =head1 METHODS
52              
53             =over 4
54              
55             =cut
56              
57 4     4   37622 use v5.14;
  4         16  
58 4     4   25 use warnings;
  4         12  
  4         155  
59              
60             use Moo;
61 4     4   23 use Types::Standard qw(Str Object);
  4         6  
  4         23  
62 4     4   1222 use Attean;
  4         9  
  4         49  
63 4     4   2701 use Attean::RDF;
  4         9  
  4         33  
64 4     4   22
  4         9  
  4         33  
65             use Carp;
66 4     4   3054 use Encode;
  4         13  
  4         186  
67 4     4   22 use XML::SAX;
  4         10  
  4         251  
68 4     4   1746 use Data::Dumper;
  4         14084  
  4         148  
69 4     4   27 use Scalar::Util qw(blessed);
  4         9  
  4         156  
70 4     4   22 use Module::Load::Conditional qw[can_load];
  4         9  
  4         149  
71 4     4   25  
  4         8  
  4         1644  
72             =item C<< canonical_media_type >>
73              
74             Returns the canonical media type for SPARQL XML: application/sparql-results+json.
75              
76             =cut
77              
78              
79 1     1 1 641 =item C<< media_types >>
80              
81             Returns a list of media types that may be parsed with the SPARQL XML parser:
82             application/sparql-results+json.
83              
84             =cut
85              
86            
87             =item C<< file_extensions >>
88 4     4 1 14  
89             Returns a list of file extensions that may be parsed with the parser.
90              
91             =cut
92              
93              
94             with 'Attean::API::TripleParser', 'Attean::API::AbbreviatingParser', 'Attean::API::Parser';
95             with 'Attean::API::PushParser';
96 10     10 1 42  
97             has 'bnode_prefix' => (is => 'ro', isa => Str, default => '');
98            
99             =item C<< parse_cb_from_io( $fh ) >>
100              
101             Calls the C<< $parser->handler >> function once for each
102             L<Attean::API::Binding> object that result from parsing
103             the data read from the L<IO::Handle> object C<< $fh >>.
104              
105             =cut
106              
107             my $self = shift;
108             $self->_parse(@_);
109             }
110            
111             =item C<< parse_cb_from_bytes( $data ) >>
112 0     0 1 0  
113 0         0 Calls the C<< $parser->handler >> function once for each
114             L<Attean::API::Binding> object that result from parsing
115             the data read from the UTF-8 encoded byte string C<< $data >>.
116              
117             =cut
118              
119             my $self = shift;
120             $self->_parse(@_);
121             }
122              
123             my $self = shift;
124             my $data = shift;
125 5     5 1 10  
126 5         16 my @args;
127             if (my $map = $self->namespaces) {
128             push(@args, namespaces => $map);
129             }
130 5     5   9
131 5         10 if ($self->has_base) {
132             push(@args, base => $self->base);
133 5         12 }
134 5 100       28 my $new_iri = sub { $self->new_iri(@_) };
135 1         3 my $saxhandler = AtteanX::Parser::RDFXML::SAXHandler->new( bnode_prefix => $self->bnode_prefix, handler => $self->handler, new_iri => $new_iri, @args );
136             my $p = XML::SAX::ParserFactory->parser(Handler => $saxhandler);
137             $saxhandler->push_base( $self->base ) if ($self->has_base);
138 5 100       21 eval {
139 1         18 if (ref($data)) {
140             $p->parse_file($data);
141 5     10   32 } else {
  10         38  
142 5         84 if (length($data) > 0) {
143 5         46 $p->parse_string($data);
144 5 100       34125 }
145 5         11 }
146 5 50       14 };
147 0         0
148             if ($@) {
149 5 100       20 if ($@ =~ /no element found at line 1, column 0, byte/) {
150 4         20 # silence XML::Parser output on empty input
151             } else {
152             die $@;
153             }
154             }
155 5 100       2079 my $nodes = $saxhandler->{nodes};
156 1 50       33 if ($nodes and scalar(@$nodes)) {
157             die "RDFXML parser node stack isn't empty after parse: " . Dumper($nodes);
158             }
159 1         36 my $expect = $saxhandler->{expect};
160             if ($expect and scalar(@$expect) > 2) {
161             die "RDFXML parser expect stack isn't empty after parse:" . Dumper($expect);
162 4         13 }
163 4 50 50     27 }
164 0         0 }
165              
166 4         11  
167 4 50 33     107 use v5.14;
168 0         0 use warnings;
169             use base qw(XML::SAX::Base);
170             use List::Util qw(first);
171             use Module::Load::Conditional qw[can_load];
172              
173             use Attean::RDF;
174             use Data::Dumper;
175 4     4   45 use Scalar::Util qw(blessed);
  4         22  
176 4     4   30  
  4         8  
  4         134  
177 4     4   25 use constant NIL => 0x00;
  4         16  
  4         3244  
178 4     4   63017 use constant SUBJECT => 0x01;
  4         10  
  4         235  
179 4     4   24 use constant PREDICATE => 0x02;
  4         10  
  4         127  
180             use constant OBJECT => 0x04;
181 4     4   21 use constant LITERAL => 0x08;
  4         10  
  4         25  
182 4     4   2775 use constant COLLECTION => 0x16;
  4         9  
  4         139  
183 4     4   20  
  4         10  
  4         144  
184             my $HAS_XML_LIBXML = can_load( modules => { 'XML::LibXML' => 1.70, } );
185 4     4   22  
  4         8  
  4         204  
186 4     4   23 my $class = shift;
  4         6  
  4         178  
187 4     4   23 my %args = @_;
  4         9  
  4         188  
188 4     4   26 my $prefix = $args{ bnode_prefix } // '';
  4         11  
  4         168  
189 4     4   23 my $self = bless( {
  4         13  
  4         163  
190 4     4   24 expect => [ SUBJECT, NIL ],
  4         9  
  4         14747  
191             base => [],
192             depth => 0,
193             characters => '',
194             prefix => $prefix,
195 5     5   60 counter => 0,
196 5         23 nodes => [],
197 5   50     21 chars_ok => 0,
198             sthandler => $args{handler},
199             new_iri => $args{new_iri},
200             named_bnodes => {},
201             }, $class );
202             if (my $ns = $args{ namespaces }) {
203             $self->{namespaces} = $ns;
204             }
205             if (my $base = $args{ base }) {
206             $self->push_base( $base );
207             }
208             return $self;
209 5         56 }
210              
211 5 100       17 my $self = shift;
212 1         5 unshift( @{ $self->{expect} }, shift );
213             }
214 5 100       22  
215 1         5 shift( @{ shift->{expect} } );
216             }
217 5         12  
218             return shift->{expect}[0];
219             }
220              
221 5     5   21 return shift->{expect}[1];
222 5         9 }
  5         16  
223              
224              
225             my $self = shift;
226 8     8   13 my $el = shift;
  8         17  
227              
228             $self->{depth}++;
229             $self->handle_scoped_values( $el ) unless ($self->expect == LITERAL);
230 47     47   133 if ($self->{depth} == 1 and $el->{NamespaceURI} eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#' and $el->{LocalName} eq 'RDF') {
231             # ignore the wrapping rdf:RDF element
232             } else {
233             my $prefix = $el->{Prefix};
234 3     3   20 my $expect = $self->expect;
235             $self->new_expect( $expect = SUBJECT ) if ($expect == NIL);
236            
237             if ($expect == SUBJECT or $expect == OBJECT) {
238             my $ns = $self->get_namespace( $prefix );
239 8     8   6547 my $local = $el->{LocalName};
240 8         18 my $uri = join('', $ns, $local);
241             my $node = $self->new_resource( $uri );
242 8         16 if ($self->expect == OBJECT) {
243 8 50       18 if (defined($self->{characters}) and length(my $string = $self->{characters})) {
244 8 100 66     53 die "character data found before object element" if ($string =~ /\S/);
      66        
245             }
246             delete($self->{characters}); # get rid of any whitespace we saw before the element
247 5         9 }
248 5         10 my $node_id = $self->node_id( $el );
249 5 50       12
250             if ($self->peek_expect == COLLECTION) {
251 5 100 66     23 my $list = $self->new_bnode;
    50          
    50          
    0          
252 3         12 if (my $last = $self->{ collection_last }[0]) {
253 3         11 my $st = Attean::Triple->new( $last, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"), $list );
254 3         10 $self->assert( $st );
255 3         11 }
256 3 50       643 $self->{ collection_last }[0] = $list;
257 0 0 0     0 my $st = Attean::Triple->new( $list, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#first"), $node_id );
258 0 0       0 $self->assert( $st );
259             $self->{ collection_head }[0] ||= $list;
260 0         0 } elsif ($self->expect == OBJECT) {
261             my $nodes = $self->{nodes};
262 3         13 my $st = Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $node_id );
263             $self->assert( $st );
264 3 50       378 }
    50          
265 0         0
266 0 0       0 if ($uri ne 'http://www.w3.org/1999/02/22-rdf-syntax-ns#Description') {
267 0         0 my $type = $node;
268 0         0 $self->assert( Attean::Triple->new( $node_id, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), $node ) );
269             }
270 0         0 push( @{ $self->{nodes} }, $node_id );
271 0         0
272 0         0 $self->parse_literal_property_attributes( $el, $node_id );
273 0   0     0 $self->new_expect( PREDICATE );
274             unshift(@{ $self->{seqs} }, 0);
275 0         0 } elsif ($self->expect == COLLECTION) {
276 0         0 } elsif ($self->expect == PREDICATE) {
  0         0  
  0         0  
  0         0  
277 0         0 my $ns = $self->get_namespace( $prefix );
278             my $local = $el->{LocalName};
279             my $uri = join('', $ns, $local);
280 3 50       9 my $node = $self->new_resource( $uri );
281 0         0
282 0         0 if ($node->value eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#li') {
283             my $id = ++(${ $self }{seqs}[0]);
284 3         5 $node = $self->new_resource( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#_' . $id );
  3         10  
285             }
286 3         12
287 3         11 push( @{ $self->{nodes} }, $node );
288 3         6 if (my $data = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}datatype'}) {
  3         26  
289             $self->{datatype} = $data->{Value};
290             }
291 2         6
292 2         7 if (my $data = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}ID'}) {
293 2         7 my $id = $data->{Value};
294 2         7 unshift(@{ $self->{reify_id} }, $id);
295             } else {
296 2 50       317 unshift(@{ $self->{reify_id} }, undef);
297 0         0 }
  0         0  
298 0         0
299             if (my $pt = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}parseType'}) {
300             if ($pt->{Value} eq 'Resource') {
301 2         6 # fake an enclosing object scope
  2         7  
302 2 50       9 my $node = $self->new_bnode;
303 0         0 my $nodes = $self->{nodes};
304             push( @$nodes, $node );
305             $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 2 .. $#{$nodes} ] ) );
306 2 50       9
307 0         0 $self->new_expect( PREDICATE );
308 0         0 } elsif ($pt->{Value} eq 'Literal') {
  0         0  
309             $self->{datatype} = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral';
310 2         4 my $depth = $self->{depth};
  2         6  
311             $self->{literal_depth} = $depth - 1;
312             $self->new_expect( LITERAL );
313 2 50       13 } elsif ($pt->{Value} eq 'Collection') {
    100          
    50          
    50          
314 0 0       0 my $depth = $self->{depth};
    0          
    0          
315             unshift( @{ $self->{ collection_head } }, undef );
316 0         0 unshift( @{ $self->{ collection_last } }, undef );
317 0         0 $self->new_expect( COLLECTION );
318 0         0 $self->new_expect( OBJECT );
319 0         0 }
  0         0  
  0         0  
  0         0  
320             } elsif (my $data = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}resource'}) {
321 0         0 # stash the uri away so that we can use it when we get the end_element call for this predicate
322             my $uri = $self->new_resource( $data->{Value} );
323 0         0 $self->parse_literal_property_attributes( $el, $uri );
324 0         0 $self->{'rdf:resource'} = $uri;
325 0         0 $self->new_expect( OBJECT );
326 0         0 $self->{chars_ok} = 1;
327             } elsif (my $ndata = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}) {
328 0         0 my $node_name = $ndata->{Value};
329 0         0 # stash the bnode away so that we can use it when we get the end_element call for this predicate
  0         0  
330 0         0 my $bnode = $self->get_named_bnode( $node_name );
  0         0  
331 0         0 $self->parse_literal_property_attributes( $el, $uri );
332 0         0 $self->{'rdf:resource'} = $bnode; # the key 'rdf:resource' is a bit misused here, but both rdf:resource and rdf:nodeID use it for the same purpose, so...
333             $self->new_expect( OBJECT );
334             $self->{chars_ok} = 1;
335             } elsif (my $node = $self->parse_literal_property_attributes( $el )) {
336 1         5 # fake an enclosing object scope
337 1         160 my $nodes = $self->{nodes};
338 1         5 push( @$nodes, $node );
339 1         3 $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 2 .. $#{$nodes} ] ) );
340 1         4 $self->new_expect( PREDICATE );
341             } else {
342 0         0 $self->new_expect( OBJECT );
343             $self->{chars_ok} = 1;
344 0         0 }
345 0         0 } elsif ($self->expect == LITERAL) {
346 0         0 my $tag;
347 0         0 if ($el->{Prefix}) {
348 0         0 $tag = join(':', @{ $el }{qw(Prefix LocalName)});
349             } else {
350             $tag = $el->{LocalName};
351 0         0 }
352 0         0 $self->{characters} .= '<' . $tag;
353 0         0 my $attr = $el->{Attributes};
  0         0  
  0         0  
  0         0  
354 0         0
355             if (my $ns = $el->{NamespaceURI}) {
356 1         5 my $abbr = $el->{Prefix};
357 1         5 unless ($self->{defined_literal_namespaces}{$abbr}{$ns}) {
358             $self->{characters} .= ' xmlns';
359             if (length($abbr)) {
360 0         0 $self->{characters} .= ':' . $abbr;
361 0 0       0 }
362 0         0 $self->{characters} .= '="' . $ns . '"';
  0         0  
363             $self->{defined_literal_namespaces}{$abbr}{$ns}++;
364 0         0 }
365             }
366 0         0 if (%$attr) {
367 0         0 foreach my $k (keys %$attr) {
368             $self->{characters} .= ' ';
369 0 0       0 my $el = $attr->{ $k };
370 0         0 my $prop;
371 0 0       0 if ($el->{Prefix}) {
372 0         0 $prop = join(':', @{ $el }{qw(Prefix LocalName)});
373 0 0       0 } else {
374 0         0 $prop = $el->{LocalName};
375             }
376 0         0 $self->{characters} .= $prop . '="' . $el->{Value} . '"';
377 0         0 }
378             }
379             $self->{characters} .= '>';
380 0 0       0 } else {
381 0         0 die "not sure what type of token is expected";
382 0         0 }
383 0         0 }
384 0         0 }
385 0 0       0  
386 0         0 my $self = shift;
  0         0  
387             my $el = shift;
388 0         0 $self->{depth}--;
389              
390 0         0 my $cleanup = 0;
391             my $expect = $self->expect;
392             if ($expect == SUBJECT) {
393 0         0 $self->old_expect;
394             $cleanup = 1;
395 0         0 $self->{chars_ok} = 0;
396             shift(@{ $self->{reify_id} });
397             } elsif ($expect == PREDICATE) {
398             $self->old_expect;
399             if ($self->expect == PREDICATE) {
400             # we're closing a parseType=Resource block, so take off the extra implicit node.
401 8     8   818 pop( @{ $self->{nodes} } );
402 8         11 } else {
403 8         14 shift(@{ $self->{seqs} });
404             }
405 8         12 $cleanup = 1;
406 8         15 $self->{chars_ok} = 0;
407 8 100 0     36 } elsif ($expect == OBJECT or ($expect == LITERAL and $self->{literal_depth} == $self->{depth})) {
    100 33        
    50          
    0          
    0          
408 3         10 if (exists $self->{'rdf:resource'}) {
409 3         6 my $uri = delete $self->{'rdf:resource'};
410 3         6 my $nodes = $self->{nodes};
411 3         5 delete $self->{characters};
  3         6  
412             $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $uri ) );
413 3         17 }
414 3 50       8 $self->old_expect;
415             if (defined($self->{characters})) {
416 0         0 my $string = $self->{characters};
  0         0  
417             my $literal = $self->new_literal( $string );
418 3         6 my $nodes = $self->{nodes};
  3         6  
419             $self->assert( Attean::Triple->new( @{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $literal ) );
420 3         6 delete($self->{characters});
421 3         7 delete $self->{datatype};
422             delete $self->{defined_literal_namespaces};
423 2 100       8 }
424 1         4
425 1         2 if ($self->expect == COLLECTION) {
426 1         2 # We were expecting an object, but got an end_element instead.
427 1         2 # after poping the OBJECT expectation, we see we were expecting objects in a COLLECTION.
  1         26  
  1         3  
  1         2  
428             # so we're ending the COLLECTION here:
429 2         7 $self->old_expect;
430 2 100       7 my $nodes = $self->{nodes};
431 1         3 my $head = $self->{ collection_head }[0] || iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#nil");
432 1         3 my @nodes = (@{ $nodes }[ $#{$nodes} - 1, $#{$nodes} ], $head);
433 1         3 my $st = Attean::Triple->new( @nodes );
434 1         3 $self->assert( $st );
  1         21  
  1         3  
  1         3  
435 1         3
436 1         2 if (my $last = $self->{ collection_last }[0]) {
437 1         3 my @nodes = ( $last, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"), iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#nil") );
438             my $st = Attean::Triple->new( @nodes );
439             $self->assert( $st );
440 2 50       6 }
441            
442             shift( @{ $self->{ collection_last } } );
443             shift( @{ $self->{ collection_head } } );
444 0         0 }
445 0         0
446 0   0     0 $cleanup = 1;
447 0         0 $self->{chars_ok} = 0;
  0         0  
  0         0  
  0         0  
448 0         0 shift(@{ $self->{reify_id} });
449 0         0 } elsif ($expect == COLLECTION) {
450             shift( @{ $self->{collections} } );
451 0 0       0 $self->old_expect;
452 0         0 } elsif ($expect == LITERAL) {
453 0         0 my $tag;
454 0         0 if ($el->{Prefix}) {
455             $tag = join(':', @{ $el }{qw(Prefix LocalName)});
456             } else {
457 0         0 $tag = $el->{LocalName};
  0         0  
458 0         0 }
  0         0  
459             $self->{characters} .= '</' . $tag . '>';
460             $cleanup = 0;
461 2         5 } else {
462 2         4 die "how did we get here?";
463 2         5 }
  2         5  
464              
465 0         0 if ($cleanup) {
  0         0  
466 0         0 pop( @{ $self->{nodes} } );
467             $self->pop_namespace_pad();
468 0         0 $self->pop_language();
469 0 0       0 $self->pop_base();
470 0         0 }
  0         0  
471             }
472 0         0  
473             my $self = shift;
474 0         0 my $data = shift;
475 0         0 my $expect = $self->expect;
476             if ($expect == LITERAL or ($expect == OBJECT and $self->{chars_ok})) {
477 0         0 my $chars = $data->{Data};
478             $self->{characters} .= $chars;
479             }
480 8 50       21 }
481 8         13  
  8         14  
482 8         22 my $self = shift;
483 8         28 my $el = shift;
484 8         20 my $node_id = shift || $self->new_bnode;
485             my @keys = grep { not(m<[{][}](xmlns|about)>) }
486             grep { not(m<[{]http://www.w3.org/1999/02/22-rdf-syntax-ns#[}](resource|about|ID|datatype|nodeID)>) }
487             grep { not(m<[{]http://www.w3.org/XML/1998/namespace[}](base|lang)>) }
488             keys %{ $el->{Attributes} };
489 11     11   729 my $asserted = 0;
490 11         16  
491 11         23 unshift(@{ $self->{reify_id} }, undef); # don't reify any of these triples
492 11 50 66     52 foreach my $k (@keys) {
      66        
493 1         3 my $data = $el->{Attributes}{ $k };
494 1         5 my $ns = $data->{NamespaceURI};
495             unless ($ns) {
496             my $prefix = $data->{Prefix};
497             next unless (length($ns));
498             $ns = $self->get_namespace( $prefix );
499 5     5   11 }
500 5         6 next if ($ns eq 'http://www.w3.org/XML/1998/namespace');
501 5   66     16 next if ($ns eq 'http://www.w3.org/2000/xmlns/');
502 1         6 my $local = $data->{LocalName};
503 4         52 my $uri = join('', $ns, $local);
504 4         15 my $value = $data->{Value};
505 5         55 my $pred = $self->new_resource( $uri );
  5         14  
506 5         13 my $term = ($uri eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type') ? $self->new_resource( $value ) : $self->new_literal( $value );
507             $self->assert( Attean::Triple->new( $node_id, $pred, $term ) );
508 5         7 $asserted++;
  5         15  
509 5         14 }
510 1         3 shift(@{ $self->{reify_id} });
511 1         2 return ($asserted ? $node_id : 0);
512 1 50       4 }
513 0         0  
514 0 0       0 my $self = shift;
515 0         0 my $st = shift;
516              
517 1 50       3 if ($self->{sthandler}) {
518 1 50       2 $self->{sthandler}->( $st );
519 1         3 if (defined(my $id = $self->{reify_id}[0])) {
520 1         3 my $stid = $self->new_resource( "#$id" );
521 1         3
522 1         3 my $tst = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement") );
523 1 50       155 my $sst = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#subject"), $st->subject );
524 1         11 my $pst = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate"), $st->predicate );
525 1         2 my $ost = Attean::Triple->new( $stid, iri("http://www.w3.org/1999/02/22-rdf-syntax-ns#object"), $st->object );
526             foreach ($tst, $sst, $pst, $ost) {
527 5         7 $self->{sthandler}->( $_ );
  5         10  
528 5 100       24 }
529             $self->{reify_id}[0] = undef; # now that we've used this reify ID, get rid of it (because we don't want it used again)
530             }
531             }
532 3     3   79 }
533 3         3  
534             my $self = shift;
535 3 50       10 my $el = shift;
536 3         13  
537 3 50       12 if ($el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}about'}) {
538 0         0 my $uri = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}about'}{Value};
539             return $self->new_resource( $uri );
540 0         0 } elsif ($el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}ID'}) {
541 0         0 my $uri = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}ID'}{Value};
542 0         0 return $self->new_resource( '#' . $uri );
543 0         0 } elsif ($el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}) {
544 0         0 my $name = $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}{Value};
545 0         0 return $self->get_named_bnode( $name );
546             } else {
547 0         0 return $self->new_bnode;
548             }
549             }
550              
551             my $self = shift;
552             my $el = shift;
553 3     3   6 my %new;
554 3         5  
555             {
556 3 50       17 # xml:base
    100          
    50          
557 0         0 my $base = '';
558 0         0 if (exists($el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}base'})) {
559             my $uri = $el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}base'}{Value};
560 2         6 $base = $self->new_resource( $uri );
561 2         9 }
562             $self->push_base( $base );
563 0         0 }
564 0         0  
565             {
566 1         4 # language
567             my $lang = '';
568             if (exists($el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}lang'})) {
569             $lang = $el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}lang'}{Value};
570             }
571 8     8   11 $self->push_language( $lang );
572 8         10 }
573 8         16  
574             {
575             # namespaces
576             my @ns = grep { m<^[{]http://www.w3.org/2000/xmlns/[}]> } (keys %{ $el->{Attributes} });
577 8         13 foreach my $n (@ns) {
578 8 100       21 my ($prefix) = substr($n, 31);
579 1         3 my $value = $el->{Attributes}{$n}{Value};
580 1         4 $new{ $prefix } = $value;
581             if (blessed(my $ns = $self->{namespaces})) {
582 8         257 unless ($ns->namespace_uri($prefix)) {
583             $ns->add_mapping( $prefix => $value );
584             }
585             }
586             }
587 8         11
  8         13  
588 8 50       20 if (exists($el->{Attributes}{'{}xmlns'})) {
589 0         0 my $value = $el->{Attributes}{'{}xmlns'}{Value};
590             $new{ '' } = $value;
591 8         23 }
592            
593             $self->push_namespace_pad( \%new );
594             }
595             }
596 8         13  
  8         12  
  8         13  
  11         47  
  8         23  
597 8         22 my $self = shift;
598 6         7629 my $base = shift;
599 6         16 if ($base) {
600 6         14 my $uri = (blessed($base) and $base->isa('URI')) ? $base : URI->new($base->value );
601 6 100       25 $uri->fragment( undef );
602 2 50       7 $base = iri( "$uri" );
603 2         17 }
604             unshift( @{ $self->{base} }, $base );
605             }
606              
607             my $self = shift;
608 8 50       677 shift( @{ $self->{base} } );
609 0         0 }
610 0         0  
611             my $self = shift;
612             return first { length($_) } @{ $self->{base} };
613 8         21 }
614              
615             my $self = shift;
616             my $lang = shift;
617             unshift( @{ $self->{language} }, $lang );
618 10     10   25 }
619 10         12  
620 10 100       23 my $self = shift;
621 3 50 33     52 shift( @{ $self->{language} } );
622 3         3153 }
623 3         86  
624             my $self = shift;
625 10         494 my $lang = first { length($_) } @{ $self->{language} };
  10         38  
626             return $lang // '';
627             }
628              
629 8     8   12 my $self = shift;
630 8         9 my $pad = shift;
  8         23  
631             unshift( @{ $self->{_namespaces} }, $pad );
632             }
633              
634 10     10   15 my $self = shift;
635 10     25   32 shift( @{ $self->{_namespaces} } );
  25         48  
  10         33  
636             }
637              
638             my $self = shift;
639 8     8   13 my $prefix = shift;
640 8         14 foreach my $level (0 .. $#{ $self->{_namespaces} }) {
641 8         12 my $pad = $self->{_namespaces}[ $level ];
  8         24  
642             if (exists($pad->{ $prefix })) {
643             my $uri = $pad->{ $prefix };
644             return $uri;
645 8     8   11 }
646 8         10 }
  8         13  
647             die "Unknown namespace: $prefix";
648             }
649              
650 2     2   4 my $self = shift;
651 2     5   8 if (my $prefix = $self->{prefix}) {
  5         9  
  2         9  
652 2   50     19 my $id = $prefix . ++$self->{counter};
653             return Attean::Blank->new( $id );
654             } else {
655             return Attean::Blank->new();
656 8     8   13 }
657 8         12 }
658 8         10  
  8         25  
659             my $self = shift;
660             my $string = shift;
661             my %args;
662 8     8   11 if (my $dt = $self->{datatype}) { # datatype
663 8         12 $args{datatype} = $dt;
  8         16  
664             if ($dt eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral') {
665             if ($HAS_XML_LIBXML) {
666             eval {
667 5     5   8 if ($string =~ m/^</) {
668 5         6 my $doc = XML::LibXML->load_xml(string => $string);
669 5         9 my $canon = $doc->toStringEC14N(1);
  5         17  
670 12         16 $string = $canon;
671 12 100       26 }
672 5         8 };
673 5         11 if ($@) {
674             warn "Cannot canonicalize XMLLiteral: $@" . Dumper($string);
675             }
676 0         0 }
677             }
678             } elsif (my $lang = $self->get_language) {
679             $args{language} = $lang;
680 2     2   4 }
681 2 50       6 my $literal = Attean::Literal->new( value => $string, %args );
682 2         7 }
683 2         27  
684             my $self = shift;
685 0         0 my $uri = shift;
686             my ($base) = $self->get_base;
687             return $self->{new_iri}->( value => $uri, $base ? (base => $base) : () );
688             }
689              
690 2     2   4 my $self = shift;
691 2         4 my $name = shift;
692 2         4 return ($self->{named_bnodes}{ $name } ||= $self->new_bnode);
693 2 50       10 }
    50          
694 0         0  
695 0 0       0 1;
696 0 0       0  
697 0         0  
698 0 0       0 =back
699 0         0  
700 0         0 =head1 BUGS
701 0         0  
702             Please report any bugs or feature requests to through the GitHub web interface
703             at L<https://github.com/kasei/perlrdf/issues>.
704 0 0       0  
705 0         0 =head1 AUTHOR
706              
707             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
708              
709             =head1 COPYRIGHT
710 0         0  
711             Copyright (c) 2014--2022 Gregory Todd Williams. This
712 2         36 program is free software; you can redistribute it and/or modify it under
713             the same terms as Perl itself.
714              
715             =cut