1# RDF::Trine::Model::Dataset
2# -----------------------------------------------------------------------------
3
4=head1 NAME
5
6RDF::Trine::Model::Dataset - Model for SPARQL datasets
7
8=head1 VERSION
9
10This document describes RDF::Trine::Model::Dataset version 1.019
11
12=head1 STATUS
13
14This module's API and functionality should be considered unstable.
15In the future, this module may change in backwards-incompatible ways,
16or be removed entirely. If you need functionality that this module provides,
17please L<get in touch|http://www.perlrdf.org/>.
18
19=head1 METHODS
20
21Beyond the methods documented below, this class inherits methods from the
22L<RDF::Trine::Model> class.
23
24=over 4
25
26=cut
27
28package RDF::Trine::Model::Dataset;
29
30use strict;
31use warnings;
32no warnings 'redefine';
33use base qw(RDF::Trine::Model);
34use Scalar::Util qw(blessed);
35
36use RDF::Trine::Model;
37
38our ($VERSION);
39BEGIN {
40	$VERSION	= '1.019';
41}
42
43################################################################################
44
45=item C<< new ( $model ) >>
46
47Returns a new dataset-model over the supplied model.
48
49=cut
50
51sub new {
52	my $class	= shift;
53	my $model	= shift;
54	my $self	= bless({ model => $model, stack => [] }, $class);
55}
56
57=item C<< push_dataset ( default => \@graphs, named => \@graphs ) >>
58
59Creates a new dataset view over the underlying model.
60
61=cut
62
63sub push_dataset {
64	my $self	= shift;
65	my %dataset	= @_;
66
67	my @dgraphs	= @{ $dataset{ default } || [] };
68	unshift(@{ $self->{ stack } }, { default => {}, named => {} });
69	foreach my $graph (@dgraphs) {
70		my $name	= blessed($graph) ? $graph->uri_value : $graph;
71		$graph		= blessed($graph) ? $graph : RDF::Trine::Node::Resource->new( $graph );
72		$self->{stack}[0]{default}{$name}	= $graph;
73	}
74
75	my @ngraphs	= @{ $dataset{ named } || [] };
76	foreach my $graph (@ngraphs) {
77		my $name	= blessed($graph) ? $graph->uri_value : $graph;
78		$graph		= blessed($graph) ? $graph : RDF::Trine::Node::Resource->new( $graph );
79		$self->{stack}[0]{named}{$name}	= $graph;
80	}
81
82	return 1;
83}
84
85=item C<< pop_dataset >>
86
87Removes the last pushed dataset view.
88
89=cut
90
91sub pop_dataset {
92	my $self	= shift;
93	shift(@{ $self->{ stack } });
94	return 1;
95}
96
97=item C<< temporary_model >>
98
99Returns a new temporary (non-persistent) model.
100
101=cut
102
103sub temporary_model {
104	my $class	= shift;
105	my $model	= RDF::Trine::Model->temporary_model;
106	return $class->new( $model );
107}
108
109=item C<< add_hashref ( $hashref [, $context] ) >>
110
111Add triples represented in an RDF/JSON-like manner to the model.
112
113=cut
114
115sub add_hashref {
116	my $self	= shift;
117	return $self->model->add_hashref( @_ );
118}
119
120=item C<< size >>
121
122Returns the number of statements in the model.
123
124=cut
125
126sub size {
127	my $self	= shift;
128	return $self->count_statements( undef, undef, undef, undef );
129}
130
131=item C<< supports ( [ $feature ] ) >>
132
133If C<< $feature >> is specified, returns true if the feature is supported by the
134underlying store, false otherwise. If C<< $feature >> is not specified, returns
135a list of supported features.
136
137=cut
138
139sub supports {
140	my $self	= shift;
141	my $store	= $self->_store;
142	if ($store) {
143		return $store->supports( @_ );
144	}
145	return;
146}
147
148=item C<< count_statements ( $subject, $predicate, $object ) >>
149
150Returns a count of all the statements matching the specified subject,
151predicate and objects. Any of the arguments may be undef to match any value.
152
153=cut
154
155sub count_statements {
156	my $self	= shift;
157	return $self->model->count_statements( @_ ) unless (scalar(@{ $self->{stack} }));
158	my $use_quad	= (scalar(@_) >= 4);
159	if ($use_quad) {
160# 		warn "counting quads with dataset";
161		my $quad	= $_[3];
162		if (blessed($quad) and $quad->isa('RDF::Trine::Node::Nil')) {
163# 			warn "- default graph query";
164# 			warn "- " . join(', ', keys %{ $self->{stack}[0] });
165			my $count	= 0;
166			foreach my $g (values %{ $self->{stack}[0]{default} }) {
167				$count	+= $self->model->count_statements( @_[0..2], $g );
168# 				warn "$count statments in graph " . $g->uri_value;
169			}
170			return $count;
171		} elsif (not(defined($quad)) or (blessed($quad) and $quad->isa('RDF::Trine::Node::Variable'))) {
172			my $iter	= $self->get_contexts;
173			my $count	= 0;
174			while (my $g = $iter->next) {
175				$count	+= $self->model->count_statements( @_[0..2], $g );
176			}
177			return $count;
178		} else {
179			my $name	= blessed($quad) ? $quad->uri_value : $quad;
180			if ($self->{stack}[0]{named}{ $name }) {
181				return $self->model->count_statements( @_[0..2], $quad );
182			} else {
183				return 0;
184			}
185		}
186	} else {
187		my %seen;
188		my $count	= 0;
189		my $iter	= $self->get_statements( @_[0..2], undef );
190		while (my $st = $iter->next) {
191			warn 'counting triples in dataset: ' . $st->as_string;
192			$count++ unless ($seen{ join(' ', map { $_->as_string } (map { $st->$_() } qw(subject predicate object)) ) }++);
193		}
194		return $count;
195	}
196}
197
198=item C<< add_statement ( $statement [, $context] ) >>
199
200Adds the specified C<< $statement >> to the rdf store.
201
202=cut
203
204sub add_statement {
205	my $self	= shift;
206	return $self->model->add_statement( @_ );
207}
208
209=item C<< remove_statement ( $statement [, $context]) >>
210
211Removes the specified C<< $statement >> from the rdf store.
212
213=cut
214
215sub remove_statement {
216	my $self	= shift;
217	return $self->model->remove_statement( @_ );
218}
219
220=item C<< remove_statements ( $subject, $predicate, $object [, $context] ) >>
221
222Removes all statements matching the supplied C<< $statement >> pattern from the rdf store.
223
224=cut
225
226sub remove_statements {
227	my $self	= shift;
228	return $self->model->remove_statements( @_ );
229}
230
231=item C<< get_statements ($subject, $predicate, $object [, $context] ) >>
232
233Returns an iterator of all statements matching the specified subject,
234predicate and objects from the rdf store. Any of the arguments may be undef to
235match any value.
236
237If three or fewer arguments are given, the statements returned will be matched
238based on triple semantics (the graph union of triples from all the named
239graphs). If four arguments are given (even if C<< $context >> is undef),
240statements will be matched based on quad semantics (the union of all quads in
241the underlying store).
242
243=cut
244
245sub get_statements {
246	my $self		= shift;
247	return $self->model->get_statements( @_ ) unless (scalar(@{ $self->{stack} }));
248	my $bound		= 0;
249	my $use_quad	= (scalar(@_) >= 4);
250	my $nil			= RDF::Trine::Node::Nil->new();
251	if ($use_quad) {
252		my $quad	= $_[3];
253		if (blessed($quad) and not($quad->isa('RDF::Trine::Node::Variable')) and not($quad->isa('RDF::Trine::Node::Nil'))) {
254			if (exists($self->{stack}[0]{named}{$quad->uri_value})) {
255				return $self->model->get_statements( @_ );
256			} else {
257				return RDF::Trine::Iterator::Graph->new([]);
258			}
259		} else {
260			my @iters;
261			foreach my $g (values %{ $self->{stack}[0]{default} }) {
262				my $iter	= $self->model->get_statements( @_[0..2], $g );
263				my $code	= sub {
264					my $st	= $iter->next;
265					return unless $st;
266					my @nodes	= $st->nodes;
267					$nodes[3]	= $nil;
268					my $quad	= RDF::Trine::Statement::Quad->new( @nodes );
269					return $quad;
270				};
271				push(@iters, RDF::Trine::Iterator::Graph->new( $code ));
272			}
273			if (not(defined($quad)) or $quad->isa('RDF::Trine::Node::Variable')) {
274				my $graphs	= $self->get_contexts;
275				while (my $g = $graphs->next) {
276					next if ($g->isa('RDF::Trine::Node::Nil'));
277					push(@iters, $self->model->get_statements( @_[0..2], $g ));
278				}
279			}
280			my %seen;
281			my $code	= sub {
282				while (1) {
283					return unless scalar(@iters);
284					my $st	= $iters[0]->next;
285					if ($st) {
286						if ($seen{ $st->as_string }++) {
287							next;
288						}
289						return $st;
290					} else {
291						shift(@iters);
292					}
293				}
294			};
295			my $iter	= RDF::Trine::Iterator::Graph->new( $code );
296			return $iter;
297		}
298	} else {
299		my %seen;
300		my @iters;
301		my $iter	= $self->get_statements( @_[0..2], $nil );
302		push(@iters, $iter);
303		my $giter	= $self->get_contexts;
304		while (my $g = $giter->next) {
305			my $iter	= $self->get_statements( @_[0..2], $g );
306			push(@iters, $iter);
307		}
308
309		my $code	= sub {
310			while (1) {
311				return unless scalar(@iters);
312				my $st	= $iters[0]->next;
313				if ($st) {
314					my @nodes	= (map { $st->$_() } qw(subject predicate object));
315					next if ($seen{ join(' ', map { $_->as_string } @nodes ) }++);
316					return RDF::Trine::Statement->new( @nodes );
317				} else {
318					shift(@iters);
319				}
320			}
321		};
322		return RDF::Trine::Iterator::Graph->new( $code );
323	}
324}
325
326=item C<< get_pattern ( $bgp [, $context] [, %args ] ) >>
327
328Returns a stream object of all bindings matching the specified graph pattern.
329
330=cut
331
332sub get_pattern {
333	my $self	= shift;
334	return $self->model->get_pattern( @_ ) unless (scalar(@{ $self->{stack} }));
335	my $use_quad	= (scalar(@_) >= 4);
336	if ($use_quad) {
337		my $quad	= $_[3];
338		if (blessed($quad) and not($quad->isa('RDF::Trine::Node::Variable')) and not($quad->isa('RDF::Trine::Node::Nil'))) {
339			return $self->model->get_pattern( @_ );
340		} else {
341			return $self->SUPER::get_pattern( @_ );
342		}
343	} else {
344		return $self->model->get_pattern( @_ );
345	}
346}
347
348=item C<< get_sparql ( $sparql ) >>
349
350Returns a stream object of all bindings matching the specified graph pattern.
351
352=cut
353
354sub get_sparql {
355	my $self	= shift;
356	return $self->model->get_sparql( @_ ) unless (scalar(@{ $self->{stack} }));
357	throw RDF::Trine::Error::UnimplementedError -text => "Cannot execute SPARQL queries against a complex dataset model";
358}
359
360=item C<< get_graphs >>
361
362=item C<< get_contexts >>
363
364Returns an iterator containing the nodes representing the named graphs in the
365model.
366
367=cut
368
369sub get_contexts {
370	my $self	= shift;
371	return $self->model->get_contexts unless (scalar(@{ $self->{stack} }));
372	my @nodes	= values %{ $self->{stack}[0]{named} };
373	if (wantarray) {
374		return @nodes;
375	} else {
376		return RDF::Trine::Iterator->new( \@nodes );
377	}
378}
379*get_graphs = \&get_contexts;
380
381=item C<< model >>
382
383Returns the underlying model object.
384
385=cut
386
387sub model {
388	my $self	= shift;
389	return $self->{model};
390}
391
392sub _store {
393	my $self	= shift;
394	return $self->model->_store;
395}
396
3971;
398
399__END__
400
401=back
402
403=head1 BUGS
404
405Please report any bugs or feature requests to through the GitHub web interface
406at L<https://github.com/kasei/perlrdf/issues>.
407
408=head1 AUTHOR
409
410Gregory Todd Williams  C<< <gwilliams@cpan.org> >>
411
412=head1 COPYRIGHT
413
414Copyright (c) 2006-2012 Gregory Todd Williams. This
415program is free software; you can redistribute it and/or modify it under
416the same terms as Perl itself.
417
418=cut
419