File Coverage

blib/lib/RDF/Trine/Iterator.pm
Criterion Covered Total %
statement 232 284 81.6
branch 39 64 60.9
condition 14 28 50.0
subroutine 48 60 80.0
pod 28 28 100.0
total 361 464 77.8


line stmt bran cond sub pod time code
1             # RDF::Trine::Iterator
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Trine::Iterator - Iterator class for SPARQL query results
7              
8             =head1 VERSION
9              
10             This document describes RDF::Trine::Iterator version 1.018.
11              
12             =head1 SYNOPSIS
13              
14             use RDF::Trine::Iterator;
15             my $iterator = RDF::Trine::Iterator->new( \&data, 'bindings', \@names );
16             while (my $row = $iterator->next) {
17             my @vars = keys %$row;
18             # do something with @vars
19             }
20              
21             =head1 METHODS
22              
23             =over 4
24              
25             =cut
26              
27             package RDF::Trine::Iterator;
28              
29 68     68   381 use strict;
  68         144  
  68         1531  
30 68     68   309 use warnings;
  68         137  
  68         1425  
31 68     68   295 no warnings 'redefine';
  68         137  
  68         1637  
32              
33 68     68   345 use Encode;
  68         132  
  68         4458  
34 68     68   364 use Data::Dumper;
  68         145  
  68         2269  
35 68     68   355 use Log::Log4perl;
  68         191  
  68         408  
36 68     68   3524 use Carp qw(carp);
  68         146  
  68         2568  
37 68     68   360 use Scalar::Util qw(blessed reftype refaddr);
  68         146  
  68         2855  
38              
39 68     68   26506 use XML::SAX;
  68         207931  
  68         2570  
40 68     68   505 use RDF::Trine::Node;
  68         148  
  68         1983  
41 68     68   24612 use RDF::Trine::Iterator::SAXHandler;
  68         189  
  68         2098  
42 68     68   23249 use RDF::Trine::Iterator::JSONHandler;
  68         198  
  68         6110  
43              
44             our ($VERSION, @ISA, @EXPORT_OK);
45 0         0 BEGIN {
46 68     68   3467 $VERSION = '1.018';
47            
48 68         280 require Exporter;
49 68         543 @ISA = qw(Exporter);
50 68         1209 @EXPORT_OK = qw(sgrep smap swatch);
51 68     68   439 use overload 'bool' => sub { $_[0] };
  68     0   144  
  68         599  
  0         0  
52             use overload '&{}' => sub {
53 2     2   37 my $self = shift;
54             return sub {
55 2     2   8 return $self->next;
56 2         9 };
57 68     68   6908 };
  68         152  
  68         351  
58             }
59              
60 68     68   25986 use RDF::Trine::Iterator::Bindings;
  68         200  
  68         3259  
61 68     68   26258 use RDF::Trine::Iterator::Boolean;
  68         174  
  68         3030  
62 68     68   23780 use RDF::Trine::Iterator::Graph;
  68         184  
  68         114540  
63              
64             =item C<new ( \@results, $type, \@names, %args )>
65              
66             =item C<new ( \&results, $type, \@names, %args )>
67              
68             Returns a new SPARQL Result interator object. Results must be either
69             an reference to an array containing results or a CODE reference that
70             acts as an iterator, returning successive items when called, and
71             returning undef when the iterator is exhausted.
72              
73             $type should be one of: bindings, boolean, graph.
74              
75             =cut
76              
77             sub new {
78 6237     6237 1 12851 my $proto = shift;
79 6237   66     23296 my $class = ref($proto) || $proto;
80 6237   50 0   14592 my $stream = shift || sub { undef };
  0         0  
81 6237   100     14428 my $type = shift || 'bindings';
82 6237   100     13653 my $names = shift || [];
83 6237         12107 my %args = @_;
84            
85 6237 100 66     27504 if (ref($stream) and ref($stream) eq 'ARRAY') {
86 1002         1784 my $array = $stream;
87             $stream = sub {
88 2818     2818   5048 return shift(@$array);
89             }
90 1002         3918 }
91            
92 6237         9848 my $open = 0;
93 6237         9358 my $finished = 0;
94 6237         8618 my $row;
95            
96 6237         34969 my $data = {
97             _open => 0,
98             _finished => 0,
99             _type => $type,
100             _names => $names,
101             _stream => $stream,
102             _args => \%args,
103             _count => 0,
104             _row => undef,
105             _peek => [],
106             # _source => Carp::longmess(),
107             };
108            
109 6237         13234 my $self = bless($data, $class);
110 6237         26712 return $self;
111             }
112              
113             =item C<type>
114              
115             Returns the underlying result type (boolean, graph, bindings).
116              
117             =cut
118              
119             sub type {
120 47     47 1 103 my $self = shift;
121 47         344 return $self->{_type};
122             }
123              
124             =item C<is_boolean>
125              
126             Returns true if the underlying result is a boolean value.
127              
128             =item C<is_bindings>
129              
130             Returns true if the underlying result is a set of variable bindings.
131              
132             =item C<is_graph>
133              
134             Returns true if the underlying result is an RDF graph.
135              
136             =cut
137              
138 2     2 1 9 sub is_boolean { 0 }
139 0     0 1 0 sub is_bindings { 0 }
140 2     2 1 7 sub is_graph { 0 }
141              
142              
143              
144             =item C<to_string ( $format )>
145              
146             Returns a string representation of the stream data in the specified
147             C<$format>. If C<$format> is missing, defaults to XML serialization.
148             Other options are:
149              
150             http://www.w3.org/2001/sw/DataAccess/json-sparql/
151              
152             =cut
153              
154             sub to_string {
155 4     4 1 17 my $self = shift;
156 4   50     17 my $format = shift || 'http://www.w3.org/2005/sparql-results#';
157 4 50 33     15 if (ref($format) and $format->isa('RDF::Redland::URI')) {
158 0         0 $format = $format->as_string;
159             }
160            
161 4 50       12 if ($format eq 'http://www.w3.org/2001/sw/DataAccess/json-sparql/') {
162 0         0 return $self->as_json;
163             } else {
164 4         15 return $self->as_xml;
165             }
166             }
167              
168             =item C<< from_string ( $xml ) >>
169              
170             Returns a new iterator using the supplied XML string in the SPARQL XML Results format.
171              
172             =cut
173              
174             sub from_string {
175 3     3 1 605 my $class = shift;
176 3         6 my $string = shift;
177 3         18 my $bytes = encode('UTF-8', $string);
178 3         451 return $class->from_bytes($bytes);
179             }
180              
181             =item C<< from_bytes ( $xml ) >>
182              
183             Returns a new iterator using the supplied XML byte sequence (note: not character data)
184             in the SPARQL XML Results format.
185              
186             =cut
187              
188             sub from_bytes {
189 3     3 1 8 my $class = shift;
190 3         6 my $string = shift;
191 3 50       11 unless (ref($string)) {
192 3         6 my $data = $string;
193 3     1   63 open( my $fh, '<', \$data );
  1         6  
  1         2  
  1         5  
194 3         655 $string = $fh;
195             }
196 3         23 my $handler = RDF::Trine::Iterator::SAXHandler->new();
197 3         19 my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
198 3         52196 $p->parse_file( $string );
199 3         690 my $iter = $handler->iterator;
200 3         57 return $iter;
201             }
202              
203             =item C<< from_json ( $json ) >>
204              
205             =cut
206              
207             sub from_json {
208 0     0 1 0 my $class = shift;
209 0         0 my $json = shift;
210 0         0 my $p = RDF::Trine::Iterator::JSONHandler->new( @_ );
211 0         0 return $p->parse( $json );
212             }
213              
214              
215             =item C<< next_result >>
216              
217             =item C<< next >>
218              
219             Returns the next item in the stream.
220              
221             =cut
222              
223 2     2 1 13 sub next_result { $_[0]->next }
224             sub next {
225 17224     17224 1 76186 my $self = shift;
226 17224 100       43059 return if ($self->{_finished});
227            
228 17205 100       24364 if (scalar(@{ $self->{_peek} })) {
  17205         38950  
229 13         24 return shift(@{ $self->{_peek} });
  13         70  
230             }
231            
232 17192         27089 my $stream = $self->{_stream};
233 17192         39221 my $value = $stream->();
234 17192 100       39495 unless (defined($value)) {
235 6162         10601 $self->{_finished} = 1;
236             }
237              
238 17192         28716 $self->{_open} = 1;
239 17192         27002 $self->{_row} = $value;
240 17192 100       40457 $self->{_count}++ if defined($value);
241 17192         48510 return $value;
242             }
243              
244             =item C<< peek >>
245              
246             Returns the next value from the iterator without consuming it. The value will
247             remain in queue until the next call to C<< next >>.
248              
249             =cut
250              
251             sub peek {
252 17     17 1 34 my $self = shift;
253 17 50       141 return if ($self->{_finished});
254 17         52 my $value = $self->next;
255 17         28 push( @{ $self->{_peek} }, $value );
  17         45  
256 17         46 return $value;
257             }
258              
259             =item C<< current >>
260              
261             Returns the current item in the stream.
262              
263             =cut
264              
265             sub current {
266 6     6 1 8 my $self = shift;
267 6 50       13 if ($self->open) {
268 6         16 return $self->_row;
269             } else {
270 0         0 return $self->next;
271             }
272             }
273              
274             =item C<< end >>
275              
276             =item C<< finished >>
277              
278             Returns true if the end of the stream has been reached, false otherwise.
279              
280             =cut
281              
282 0     0 1 0 sub end { $_[0]->finished }
283             sub finished {
284 9     9 1 18 my $self = shift;
285 9         29 my $v = $self->peek;
286 9 100       35 return 0 if (defined($v));
287 3         14 return $self->{_finished};
288             }
289              
290             =item C<< open >>
291              
292             Returns true if the first element of the stream has been retrieved, false otherwise.
293              
294             =cut
295              
296             sub open {
297 14     14 1 22 my $self = shift;
298 14         56 return $self->{_open};
299             }
300              
301             =item C<< close >>
302              
303             Closes the stream. Future attempts to retrieve data from the stream will act as
304             if the stream had been exhausted.
305              
306             =cut
307              
308             sub close {
309 0     0 1 0 my $self = shift;
310 0         0 $self->{_finished} = 1;
311 0         0 undef( $self->{ _stream } );
312 0         0 return;
313             }
314              
315             =item C<< concat ( $stream ) >>
316              
317             Returns a new stream resulting from the concatenation of the referant and the
318             argument streams. The new stream uses the stream type, and optional binding
319             names and C<<%args>> from the referant stream.
320              
321             =cut
322              
323             sub concat {
324 7     7 1 27 my $self = shift;
325 7         12 my $stream = shift;
326 7         25 my @args = $stream->construct_args();
327 7         14 my $class = ref($self);
328 7         18 my @streams = ($self, $stream);
329             my $next = sub {
330 22     22   51 while (@streams) {
331 29         64 my $data = $streams[0]->next;
332 29 100       66 unless (defined($data)) {
333 14         22 shift(@streams);
334 14         80 next;
335             }
336 15         27 return $data;
337             }
338 7         14 return;
339 7         24 };
340 7         23 my $s = $stream->_new( $next, @args );
341 7         34 return $s;
342             }
343              
344             =item C<< seen_count >>
345              
346             Returns the count of elements that have been returned by this iterator at the
347             point of invocation.
348              
349             =cut
350              
351             sub seen_count {
352 0     0 1 0 my $self = shift;
353 0         0 return $self->{_count};
354             }
355              
356             =item C<get_boolean>
357              
358             Returns the boolean value of the first item in the stream.
359              
360             =cut
361              
362             sub get_boolean {
363 7     7 1 459 my $self = shift;
364 7         27 my $data = $self->next;
365 7         29 return +$data;
366             }
367              
368             =item C<get_all>
369              
370             Returns an array containing all the items in the stream.
371              
372             =cut
373              
374             sub get_all {
375 952     952 1 5733 my $self = shift;
376            
377 952         1462 my @data;
378 952         2557 while (my $data = $self->next) {
379 1792         6035 push(@data, $data);
380             }
381 952         3015 return @data;
382             }
383              
384             =begin private
385              
386             =item C<format_node_xml ( $node, $name )>
387              
388             Returns a string representation of C<$node> for use in an XML serialization.
389              
390             =end private
391              
392             =cut
393              
394             sub format_node_xml {
395 6     6 1 11 my $self = shift;
396             # my $bridge = shift;
397             # return unless ($bridge);
398            
399 6         10 my $node = shift;
400 6         9 my $name = shift;
401 6         8 my $node_label;
402            
403 6 50       28 if (!defined $node) {
    100          
    50          
    0          
404 0         0 return '';
405             } elsif ($node->is_resource) {
406 2         7 $node_label = $node->uri_value;
407 2         7 $node_label =~ s/&/&amp;/g;
408 2         5 $node_label =~ s/</&lt;/g;
409 2         5 $node_label =~ s/"/&quot;/g;
410 2         5 $node_label = qq(<uri>${node_label}</uri>);
411             } elsif ($node->isa('RDF::Trine::Node::Literal')) {
412 4         12 $node_label = $node->literal_value;
413 4         10 $node_label =~ s/&/&amp;/g;
414 4         18 $node_label =~ s/</&lt;/g;
415 4         6 $node_label =~ s/"/&quot;/g;
416 4 50       11 if ($node->has_language) {
    50          
417 0         0 my $lang = $node->literal_value_language;
418 0         0 $node_label = qq(<literal xml:lang="${lang}">${node_label}</literal>);
419             } elsif ($node->has_datatype) {
420 0         0 my $dt = $node->literal_datatype;
421 0         0 $node_label = qq(<literal datatype="${dt}">${node_label}</literal>);
422             } else {
423 4         9 $node_label = qq(<literal>${node_label}</literal>);
424             }
425             } elsif ($node->isa('RDF::Trine::Node::Blank')) {
426 0         0 $node_label = $node->blank_identifier;
427 0         0 $node_label =~ s/&/&amp;/g;
428 0         0 $node_label =~ s/</&lt;/g;
429 0         0 $node_label =~ s/"/&quot;/g;
430 0         0 $node_label = qq(<bnode>${node_label}</bnode>);
431             } else {
432 0         0 $node_label = "<unbound/>";
433             }
434 6         36 return qq(<binding name="${name}">${node_label}</binding>);
435             }
436              
437             =item C<< construct_args >>
438              
439             Returns the arguments necessary to pass to a stream constructor
440             to re-create this stream (assuming the same closure as the first
441             argument).
442              
443             =cut
444              
445             sub construct_args {
446 0     0 1 0 my $self = shift;
447 0         0 my $type = $self->type;
448 0   0     0 my $args = $self->_args || {};
449 0         0 return ($type, [], %$args);
450             }
451              
452             =item C<< each ( \&callback ) >>
453              
454             Calls the callback function once for each item in the iterator, passing the
455             item as an argument to the function. Any arguments to C<< each >> beyond the
456             callback function will be passed as supplemental arguments to the callback
457             function.
458              
459             =cut
460              
461             sub each {
462 0     0 1 0 my ($self, $coderef) = (shift, shift);
463 0         0 while (my $row = $self->next) {
464 0         0 $coderef->($row, @_);
465             }
466             }
467              
468             =begin private
469              
470             =item C<< debug >>
471              
472             Prints debugging information about the stream.
473              
474             =end private
475              
476             =cut
477              
478             sub debug {
479 0     0 1 0 my $self = shift;
480 0         0 my $stream = $self->{_stream};
481 0         0 RDF::Query::_debug_closure( $stream );
482             }
483              
484             sub _args {
485 60     60   107 my $self = shift;
486 60         207 return $self->{_args};
487             }
488              
489             sub _row {
490 6     6   8 my $self = shift;
491 6         18 return $self->{_row};
492             }
493              
494             sub _names {
495 0     0   0 my $self = shift;
496 0         0 return $self->{_names};
497             }
498              
499             sub _stream {
500 0     0   0 my $self = shift;
501 0         0 return $self->{_stream};
502             }
503              
504              
505             =back
506              
507             =head1 FUNCTIONS
508              
509             =over 4
510              
511             =item C<sgrep { COND } $stream>
512              
513             =cut
514              
515             sub sgrep (&$) { ## no critic (ProhibitSubroutinePrototypes)
516 32     32 1 78 my $block = shift;
517 32         65 my $stream = shift;
518 32         133 my @args = $stream->construct_args();
519 32         82 my $class = ref($stream);
520            
521 32         58 my $open = 1;
522 32         61 my $next;
523            
524             $next = sub {
525 135 50   135   336 return unless ($open);
526 135         322 my $data = $stream->next;
527 135 100       320 unless ($data) {
528 30         59 $open = 0;
529 30         65 return;
530             }
531            
532 105         199 local($_) = $data;
533 105         294 my $bool = $block->( $data );
534 105 100       252 if ($bool) {
535             # warn "[SGREP] TRUE with: " . $data->as_string;
536 59 0 33     169 if (@_ and $_[0]) {
537 0         0 $stream->close;
538 0         0 $open = 0;
539             }
540 59         137 return $data;
541             } else {
542             # warn "[SGREP] FALSE with: " . $data->as_string;
543 46         128 goto &$next;
544             }
545 32         166 };
546            
547 32 50       180 Carp::confess "not a stream: " . Dumper($stream) unless (blessed($stream));
548 32 50       186 Carp::confess unless ($stream->can('_new'));
549 32         118 my $s = $stream->_new( $next, @args );
550 32         146 return $s;
551             }
552              
553             =item C<smap { EXPR } $stream>
554              
555             =cut
556              
557             sub smap (&$;$$$) { ## no critic (ProhibitSubroutinePrototypes)
558 1     1 1 3 my $block = shift;
559 1         3 my $stream = shift;
560 1         4 my @args = $stream->construct_args();
561 1         5 foreach my $i (0 .. $#args) {
562 1 50       6 last unless (scalar(@_));
563 0         0 my $new = shift;
564 0 0       0 if (defined($new)) {
565 0         0 $args[ $i ] = $new;
566             }
567             }
568 1         2 my $class = ref($stream);
569            
570 1         2 my $open = 1;
571             my $next = sub {
572 4 50   4   10 return unless ($open);
573 4 0 33     10 if (@_ and $_[0]) {
574 0         0 $stream->close;
575 0         0 $open = 0;
576             }
577 4         8 my $data = $stream->next;
578 4 100       10 unless ($data) {
579 1         2 $open = 0;
580 1         3 return;
581             }
582            
583 3         7 local($_) = $data;
584 3         6 my ($item) = $block->( $data );
585 3         14 return $item;
586 1         4 };
587            
588 1         4 return $stream->_new( $next, @args );
589             }
590              
591             =item C<swatch { EXPR } $stream>
592              
593             =cut
594              
595             sub swatch (&$) { ## no critic (ProhibitSubroutinePrototypes)
596 1     1 1 2 my $block = shift;
597 1         2 my $stream = shift;
598 1         4 my @args = $stream->construct_args();
599 1         4 my $class = ref($stream);
600            
601 1         2 my $open = 1;
602             my $next = sub {
603 2 50   2   7 return unless ($open);
604 2 0 33     7 if (@_ and $_[0]) {
605 0         0 $stream->close;
606 0         0 $open = 0;
607             }
608 2         5 my $data = $stream->next;
609 2 100       7 unless ($data) {
610 1         2 $open = 0;
611 1         3 return;
612             }
613            
614 1         2 local($_) = $data;
615 1         3 $block->( $data );
616 1         4 return $data;
617 1         4 };
618            
619 1         4 my $s = $stream->_new( $next, @args );
620 1         3 return $s;
621             }
622              
623             1;
624              
625             __END__
626              
627             =back
628              
629             =head1 DEPENDENCIES
630              
631             L<JSON|JSON>
632              
633             L<Scalar::Util|Scalar::Util>
634              
635             L<XML::SAX|XML::SAX>
636              
637             =head1 BUGS
638              
639             Please report any bugs or feature requests to through the GitHub web interface
640             at L<https://github.com/kasei/perlrdf/issues>.
641              
642             =head1 AUTHOR
643              
644             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
645              
646             =head1 COPYRIGHT
647              
648             Copyright (c) 2006-2012 Gregory Todd Williams. This
649             program is free software; you can redistribute it and/or modify it under
650             the same terms as Perl itself.
651              
652             =cut