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