# RDF::Trine::Iterator # ----------------------------------------------------------------------------- =head1 NAME RDF::Trine::Iterator - Iterator class for SPARQL query results =head1 VERSION This document describes RDF::Trine::Iterator version 1.000. =head1 SYNOPSIS use RDF::Trine::Iterator; my $iterator = RDF::Trine::Iterator->new( \&data, 'bindings', \@names ); while (my $row = $iterator->next) { my @vars = keys %$row; # do something with @vars } =head1 METHODS =over 4 =cut package RDF::Trine::Iterator; use strict; use warnings; no warnings 'redefine'; use Data::Dumper; use Log::Log4perl; use Carp qw(carp); use Scalar::Util qw(blessed reftype refaddr); use XML::SAX; use RDF::Trine::Node; use RDF::Trine::Iterator::SAXHandler; use RDF::Trine::Iterator::JSONHandler; our ($VERSION, @ISA, @EXPORT_OK); BEGIN { $VERSION = '1.000'; require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(sgrep smap swatch); use overload 'bool' => sub { $_[0] }; use overload '&{}' => sub { my $self = shift; return sub { return $self->next; }; }; } use RDF::Trine::Iterator::Bindings; use RDF::Trine::Iterator::Boolean; use RDF::Trine::Iterator::Graph; =item C =item C Returns a new SPARQL Result interator object. Results must be either an reference to an array containing results or a CODE reference that acts as an iterator, returning successive items when called, and returning undef when the iterator is exhausted. $type should be one of: bindings, boolean, graph. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $stream = shift || sub { undef }; my $type = shift || 'bindings'; my $names = shift || []; my %args = @_; if (ref($stream) and ref($stream) eq 'ARRAY') { my $array = $stream; $stream = sub { return shift(@$array); } } my $open = 0; my $finished = 0; my $row; my $data = { _open => 0, _finished => 0, _type => $type, _names => $names, _stream => $stream, _args => \%args, _count => 0, _row => undef, _peek => [], # _source => Carp::longmess(), }; my $self = bless($data, $class); return $self; } =item C Returns the underlying result type (boolean, graph, bindings). =cut sub type { my $self = shift; return $self->{_type}; } =item C Returns true if the underlying result is a boolean value. =item C Returns true if the underlying result is a set of variable bindings. =item C Returns true if the underlying result is an RDF graph. =cut sub is_boolean { 0 } sub is_bindings { 0 } sub is_graph { 0 } =item C Returns a string representation of the stream data in the specified C<$format>. If C<$format> is missing, defaults to XML serialization. Other options are: http://www.w3.org/2001/sw/DataAccess/json-sparql/ =cut sub to_string { my $self = shift; my $format = shift || 'http://www.w3.org/2005/sparql-results#'; if (ref($format) and $format->isa('RDF::Redland::URI')) { $format = $format->as_string; } if ($format eq 'http://www.w3.org/2001/sw/DataAccess/json-sparql/') { return $self->as_json; } else { return $self->as_xml; } } =item C<< from_string ( $xml ) >> Returns a new iterator using the supplied XML in the SPARQL XML Results format. =cut sub from_string { my $class = shift; my $string = shift; unless (ref($string)) { my $data = $string; open( my $fh, '<', \$data ); $string = $fh; } my $handler = RDF::Trine::Iterator::SAXHandler->new(); my $p = XML::SAX::ParserFactory->parser(Handler => $handler); $p->parse_file( $string ); my $iter = $handler->iterator; return $iter; } =item C<< from_json ( $json ) >> =cut sub from_json { my $class = shift; my $json = shift; my $p = RDF::Trine::Iterator::JSONHandler->new( @_ ); return $p->parse( $json ); } =item C<< next_result >> =item C<< next >> Returns the next item in the stream. =cut sub next_result { $_[0]->next } sub next { my $self = shift; return if ($self->{_finished}); if (scalar(@{ $self->{_peek} })) { return shift(@{ $self->{_peek} }); } my $stream = $self->{_stream}; my $value = $stream->(); unless (defined($value)) { $self->{_finished} = 1; } $self->{_open} = 1; $self->{_row} = $value; $self->{_count}++ if defined($value); return $value; } =item C<< peek >> Returns the next value from the iterator without consuming it. The value will remain in queue until the next call to C<< next >>. =cut sub peek { my $self = shift; return if ($self->{_finished}); my $value = $self->next; push( @{ $self->{_peek} }, $value ); return $value; } =item C<< current >> Returns the current item in the stream. =cut sub current { my $self = shift; if ($self->open) { return $self->_row; } else { return $self->next; } } =item C<< end >> =item C<< finished >> Returns true if the end of the stream has been reached, false otherwise. =cut sub end { $_[0]->finished } sub finished { my $self = shift; my $v = $self->peek; return 0 if (defined($v)); return $self->{_finished}; } =item C<< open >> Returns true if the first element of the stream has been retrieved, false otherwise. =cut sub open { my $self = shift; return $self->{_open}; } =item C<< close >> Closes the stream. Future attempts to retrieve data from the stream will act as if the stream had been exhausted. =cut sub close { my $self = shift; $self->{_finished} = 1; undef( $self->{ _stream } ); return; } =item C<< concat ( $stream ) >> Returns a new stream resulting from the concatenation of the referant and the argument streams. The new stream uses the stream type, and optional binding names and C<<%args>> from the referant stream. =cut sub concat { my $self = shift; my $stream = shift; my @args = $stream->construct_args(); my $class = ref($self); my @streams = ($self, $stream); my $next = sub { while (@streams) { my $data = $streams[0]->next; unless (defined($data)) { shift(@streams); next; } return $data; } return; }; my $s = $stream->_new( $next, @args ); return $s; } =item C<< seen_count >> Returns the count of elements that have been returned by this iterator at the point of invocation. =cut sub seen_count { my $self = shift; return $self->{_count}; } =item C Returns the boolean value of the first item in the stream. =cut sub get_boolean { my $self = shift; my $data = $self->next; return +$data; } =item C Returns an array containing all the items in the stream. =cut sub get_all { my $self = shift; my @data; while (my $data = $self->next) { push(@data, $data); } return @data; } =begin private =item C Returns a string representation of C<$node> for use in an XML serialization. =end private =cut sub format_node_xml ($$$$) { my $self = shift; # my $bridge = shift; # return undef unless ($bridge); my $node = shift; my $name = shift; my $node_label; if(!defined $node) { return ''; } elsif ($node->is_resource) { $node_label = $node->uri_value; $node_label =~ s/&/&/g; $node_label =~ s/${node_label}); } elsif ($node->isa('RDF::Trine::Node::Literal')) { $node_label = $node->literal_value; $node_label =~ s/&/&/g; $node_label =~ s/has_language) { my $lang = $node->literal_value_language; $node_label = qq(${node_label}); } elsif ($node->has_datatype) { my $dt = $node->literal_datatype; $node_label = qq(${node_label}); } else { $node_label = qq(${node_label}); } } elsif ($node->isa('RDF::Trine::Node::Blank')) { $node_label = $node->blank_identifier; $node_label =~ s/&/&/g; $node_label =~ s/${node_label}); } else { $node_label = ""; } return qq(${node_label}); } =item C<< construct_args >> Returns the arguments necessary to pass to a stream constructor to re-create this stream (assuming the same closure as the first argument). =cut sub construct_args { my $self = shift; my $type = $self->type; my $args = $self->_args || {}; return ($type, [], %$args); } =item C<< each ( \&callback ) >> Calls the callback function once for each item in the iterator, passing the item as an argument to the function. Any arguments to C<< each >> beyond the callback function will be passed as supplemental arguments to the callback function. =cut sub each { my ($self, $coderef) = (shift, shift); while (my $row = $self->next) { $coderef->($row, @_); } } =begin private =item C<< debug >> Prints debugging information about the stream. =end private =cut sub debug { my $self = shift; my $stream = $self->{_stream}; RDF::Query::_debug_closure( $stream ); } sub _args { my $self = shift; return $self->{_args}; } sub _row { my $self = shift; return $self->{_row}; } sub _names { my $self = shift; return $self->{_names}; } sub _stream { my $self = shift; return $self->{_stream}; } =back =head1 FUNCTIONS =over 4 =item C =cut sub sgrep (&$) { my $block = shift; my $stream = shift; my @args = $stream->construct_args(); my $class = ref($stream); my $open = 1; my $next; $next = sub { return undef unless ($open); my $data = $stream->next; unless ($data) { $open = 0; return undef; } local($_) = $data; my $bool = $block->( $data ); if ($bool) { # warn "[SGREP] TRUE with: " . $data->as_string; if (@_ and $_[0]) { $stream->close; $open = 0; } return $data; } else { # warn "[SGREP] FALSE with: " . $data->as_string; goto &$next; } }; Carp::confess "not a stream: " . Dumper($stream) unless (blessed($stream)); Carp::confess unless ($stream->can('_new')); my $s = $stream->_new( $next, @args ); return $s; } =item C =cut sub smap (&$;$$$) { my $block = shift; my $stream = shift; my @args = $stream->construct_args(); foreach my $i (0 .. $#args) { last unless (scalar(@_)); my $new = shift; if (defined($new)) { $args[ $i ] = $new; } } my $class = ref($stream); my $open = 1; my $next = sub { return undef unless ($open); if (@_ and $_[0]) { $stream->close; $open = 0; } my $data = $stream->next; unless ($data) { $open = 0; return undef; } local($_) = $data; my ($item) = $block->( $data ); return $item; }; return $stream->_new( $next, @args ); } =item C =cut sub swatch (&$) { my $block = shift; my $stream = shift; my @args = $stream->construct_args(); my $class = ref($stream); my $open = 1; my $next = sub { return undef unless ($open); if (@_ and $_[0]) { $stream->close; $open = 0; } my $data = $stream->next; unless ($data) { $open = 0; return undef; } local($_) = $data; $block->( $data ); return $data; }; my $s = $stream->_new( $next, @args ); return $s; } 1; __END__ =back =head1 DEPENDENCIES L L L =head1 BUGS Please report any bugs or feature requests to through the GitHub web interface at L. =head1 AUTHOR Gregory Todd Williams C<< >> =head1 COPYRIGHT Copyright (c) 2006-2012 Gregory Todd Williams. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut