File Coverage

blib/lib/RDF/Query.pm
Criterion Covered Total %
statement 471 628 75.0
branch 146 240 60.8
condition 39 76 51.3
subroutine 59 72 81.9
pod 43 43 100.0
total 758 1059 71.5


line stmt bran cond sub pod time code
1             # RDF::Query
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query - A complete SPARQL 1.1 Query and Update implementation for use with RDF::Trine.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query version 2.916.
11              
12             =head1 SYNOPSIS
13              
14             # SPARQL SELECT Query
15             my $query = RDF::Query->new( 'SELECT * WHERE ...' );
16             my $iterator = $query->execute( $model );
17             while (my $row = $iterator->next) {
18             # $row is a HASHref containing variable name -> RDF Term bindings
19             print $row->{ 'var' }->as_string;
20             }
21            
22             # SPARQL CONSTRUCT/DESCRIBE Query
23             my $query = RDF::Query->new( 'CONSTRUCT { ... } WHERE ...' );
24             my $iterator = $query->execute( $model );
25             while (my $st = $iterator->next) {
26             # $st is a RDF::Trine::Statement object representing an RDF triple
27             print $st->as_string;
28             }
29            
30             # SPARQL ASK Query
31             my $query = RDF::Query->new( 'ASK WHERE ...' );
32             my $iterator = $query->execute( $model );
33             my $bool = $iterator->get_boolean;
34             if ($bool) {
35             print "Yes!\n";
36             }
37            
38             # RDQL Query
39             my $query = new RDF::Query ( $rdql, { lang => 'rdql' } );
40             my @rows = $query->execute( $model ); # in list context, returns all results
41              
42             =head1 DESCRIPTION
43              
44             RDF::Query allows SPARQL and RDQL queries to be run against an RDF model,
45             returning rows of matching results.
46              
47             See L<http://www.w3.org/TR/rdf-sparql-query/> for more information on SPARQL.
48              
49             See L<http://www.w3.org/Submission/2004/SUBM-RDQL-20040109/> for more
50             information on RDQL.
51              
52             =head1 CHANGES IN VERSION 2.900
53              
54             The 2.9xx versions of RDF::Query introduce some significant changes that will
55             lead to a stable 3.000 release supporting SPARQL 1.1. Version 2.902 introduces
56             the SPARQL 1.1 features up to date with the SPARQL 1.1 working drafts as of its
57             release date. Version 2.902 also is the first version to require use of
58             RDF::Trine for the underlying RDF store. This change means that RDF::Core is
59             no longer supported, and while Redland is still supported, its handling of
60             "contexts" (named graphs) means that existing RDF triples stored in Redland
61             without associated contexts will not be accessible from RDF::Query.
62             See L<RDF::Trine::Store> for more information on supported backend stores.
63              
64             =head1 CHANGES IN VERSION 2.000
65              
66             There are many changes in the code between the 1.x and 2.x releases. Most of
67             these changes will only affect queries that should have raised errors in the
68             first place (SPARQL parsing, queries that use undefined namespaces, etc.).
69             Beyond these changes, however, there are some significant API changes that will
70             affect all users:
71              
72             =over 4
73              
74             =item Use of RDF::Trine objects
75              
76             All nodes and statements returned by RDF::Query are now RDF::Trine objects
77             (more specifically, RDF::Trine::Node and RDF::Trine::Statement objects). This
78             differes from RDF::Query 1.x where nodes and statements were of the same type
79             as the underlying model (Redland nodes from a Redland model and RDF::Core nodes
80             from an RDF::Core model).
81              
82             In the past, it was possible to execute a query and not know what type of nodes
83             were going to be returned, leading to overly verbose code that required
84             examining all nodes and statements with the bridge object. This new API brings
85             consistency to both the execution model and client code, greatly simplifying
86             interaction with query results.
87              
88             =item Binding Result Values
89              
90             Binding result values returned by calling C<< $iterator->next >> are now HASH
91             references (instead of ARRAY references), keyed by variable name. Where prior
92             code might use this code (modulo model definition and namespace declarations):
93              
94             my $sparql = 'SELECT ?name ?homepage WHERE { [ foaf:name ?name ; foaf:homepage ?homepage ] }';
95             my $query = RDF::Query->new( $sparql );
96             my $iterator = $query->execute( $model );
97             while (my $row = $iterator->()) {
98             my ($name, $homepage) = @$row;
99             # ...
100             }
101              
102             New code using RDF::Query 2.000 and later should instead use:
103              
104             my $sparql = 'SELECT ?name ?homepage WHERE { [ foaf:name ?name ; foaf:homepage ?homepage ] }';
105             my $query = RDF::Query->new( $sparql );
106             my $iterator = $query->execute( $model );
107             while (my $row = $iterator->next) {
108             my $name = $row->{ name };
109             my $homepage = $row->{ homepage };
110             # ...
111             }
112              
113             (Also notice the new method calling syntax for retrieving rows.)
114              
115             =back
116              
117             =cut
118              
119             package RDF::Query;
120              
121 35     35   1983701 use strict;
  35         74  
  35         868  
122 35     35   170 use warnings;
  35         60  
  35         903  
123 35     35   167 no warnings 'redefine';
  35         77  
  35         1185  
124 35     35   188 use Carp qw(carp croak confess);
  35         67  
  35         2404  
125              
126 35     35   32263 use Data::Dumper;
  35         302082  
  35         2277  
127 35     35   33126 use LWP::UserAgent;
  35         1530011  
  35         1317  
128 35     35   31292 use I18N::LangTags;
  35         106997  
  35         2116  
129 35     35   227 use List::Util qw(first);
  35         72  
  35         3701  
130 35     35   192 use Scalar::Util qw(blessed reftype looks_like_number);
  35         79  
  35         2822  
131 35     35   26746 use DateTime::Format::W3CDTF;
  35         5310104  
  35         1377  
132              
133 35     35   43236 use Log::Log4perl qw(:easy);
  35         1798055  
  35         209  
134             if (! Log::Log4perl::initialized()) {
135             Log::Log4perl->easy_init($ERROR);
136             }
137              
138 35     35   21079 no warnings 'numeric';
  35         141  
  35         1324  
139 35     35   26885 use RDF::Trine 1.004;
  35         41371825  
  35         2330  
140             require RDF::Query::Functions; # (needs to happen at runtime because some of the functions rely on RDF::Query being fully loaded (to call add_hook(), for example))
141             # all the built-in functions including:
142             # datatype casting, language ops, logical ops,
143             # numeric ops, datetime ops, and node type testing
144             # also, custom functions including:
145             # jena:sha1sum, jena:now, jena:langeq, jena:listMember
146             # ldodds:Distance, kasei:warn
147 35     35   20912 use RDF::Query::Expression;
  35         161  
  35         1628  
148 35     35   212 use RDF::Query::Algebra;
  35         70  
  35         1433  
149 35     35   20308 use RDF::Query::Node qw(iri);
  35         152  
  35         2102  
150 35     35   26627 use RDF::Query::Parser::RDQL;
  35         154  
  35         1205  
151 35     35   224 use RDF::Query::Parser::SPARQL;
  35         96  
  35         886  
152 35     35   43364 use RDF::Query::Parser::SPARQL11;
  35         163  
  35         1593  
153 35     35   31111 use RDF::Query::Compiler::SQL;
  35         128  
  35         1413  
154 35     35   229 use RDF::Query::Error qw(:try);
  35         78  
  35         214  
155 35     35   33313 use RDF::Query::Plan;
  35         157  
  35         2314  
156              
157             ######################################################################
158              
159             our ($VERSION, $DEFAULT_PARSER);
160             BEGIN {
161 35     35   101 $VERSION = '2.916';
162 35         4444 $DEFAULT_PARSER = 'sparql11';
163             }
164              
165              
166             ######################################################################
167              
168             =head1 METHODS
169              
170             =over 4
171              
172             =item C<< new ( $query, \%options ) >>
173              
174             Returns a new RDF::Query object for the specified C<$query>.
175             The query language defaults to SPARQL 1.1, but may be set specifically
176             with the appropriate C<< %options >> value. Valid C<< %options >> are:
177              
178             * lang
179              
180             Specifies the query language. Acceptable values are 'sparql11', 'sparql', or 'rdql'.
181              
182             * base_uri
183              
184             Specifies the base URI used in parsing the query.
185              
186             * update
187              
188             A boolean value indicating whether update operations are allowed during query execution.
189              
190             * load_data
191              
192             A boolean value indicating whether URIs used in SPARQL FROM and FROM NAMED clauses
193             should be dereferenced and the resulting RDF content used to construct the dataset
194             against which the query is run.
195              
196             =cut
197              
198             sub new {
199 207     207 1 11127764 my $class = shift;
200 207         514 my $query = shift;
201              
202 207         498 my ($base_uri, $languri, $lang, %options);
203 207 100 100     1977 if (@_ and ref($_[0])) {
204 43         93 %options = %{ shift() };
  43         213  
205 43         145 $lang = delete $options{ lang };
206 43   33     246 $base_uri = $options{ base_uri } || $options{ base } ;
207 43         97 delete $options{ base_uri };
208 43         105 delete $options{ base };
209             } else {
210 164         647 ($base_uri, $languri, $lang, %options) = @_;
211             }
212 207         1226 $class->clear_error;
213            
214 207         1342 my $l = Log::Log4perl->get_logger("rdf.query");
215 35     35   318 no warnings 'uninitialized';
  35         79  
  35         153891  
216            
217 207         17216 my %names = (
218             rdql => 'RDF::Query::Parser::RDQL',
219             sparql => 'RDF::Query::Parser::SPARQL',
220             sparql11 => 'RDF::Query::Parser::SPARQL11',
221             );
222 207         2171 my %uris = (
223             'http://jena.hpl.hp.com/2003/07/query/RDQL' => 'RDF::Query::Parser::RDQL',
224             'http://www.w3.org/TR/rdf-sparql-query/' => 'RDF::Query::Parser::SPARQL',
225             'http://www.w3.org/ns/sparql-service-description#SPARQL10Query' => 'RDF::Query::Parser::SPARQL',
226             'http://www.w3.org/ns/sparql-service-description#SPARQL11Query' => 'RDF::Query::Parser::SPARQL11',
227             'http://www.w3.org/ns/sparql-service-description#SPARQL11Update' => 'RDF::Query::Parser::SPARQL11',
228             );
229            
230 207 50       764 if ($base_uri) {
231 0         0 $base_uri = RDF::Query::Node::Resource->new( $base_uri );
232             }
233            
234 207         426 my %pargs;
235 207 50       956 if ($options{canonicalize}) {
236 0         0 $pargs{canonicalize} = 1;
237             }
238 207 100       845 my $update = ((delete $options{update}) ? 1 : 0);
239 207   66     1193 my $pclass = $names{ $lang } || $uris{ $languri } || $names{ $DEFAULT_PARSER };
240 207         1876 my $parser = $pclass->new( %pargs );
241 207         520 my $parsed;
242            
243 207 50 33     1221 if (ref($query) and $query->isa('RDF::Query::Algebra')) {
244 0         0 my $method = 'SELECT';
245 0 0       0 $method = 'ASK' if ($query->isa('RDF::Query::Algebra::Ask'));
246 0 0       0 $method = 'CONSTRUCT' if ($query->isa('RDF::Query::Algebra::Construct'));
247 0         0 my @vars = map { RDF::Query::Node::Variable->new($_) } _uniq($query->potentially_bound);
  0         0  
248 0 0       0 if ($method eq 'SELECT') {
249 0 0       0 unless ($query->isa('RDF::Query::Algebra::Project')) {
250 0         0 $query = RDF::Query::Algebra::Project->new($query, \@vars);
251             }
252             }
253             $parsed = {
254 0         0 method => $method,
255             triples => [$query],
256             sources => [],
257             base => $base_uri,
258             options => {},
259             star => 0,
260             variables => \@vars,
261             };
262 0         0 $query = $query->as_sparql;
263             } else {
264 207         1121 $parsed = $parser->parse( $query, $base_uri, $update );
265             }
266            
267 207         1383 my $self = $class->_new(
268             base_uri => $base_uri,
269             parser => $parser,
270             parsed => $parsed,
271             query_string => $query,
272             update => $update,
273             options => { %options },
274             );
275 207 50       1783 if (exists $options{load_data}) {
    100          
276 0         0 $self->{load_data} = delete $options{load_data};
277             } elsif ($pclass =~ /^RDF::Query::Parser::(RDQL|SPARQL)$/) {
278 106         432 $self->{load_data} = 1;
279             } else {
280 101         315 $self->{load_data} = 0;
281             }
282 207 100       742 unless ($parsed->{'triples'}) {
283 2         14 $class->set_error( $parser->error );
284 2         8 $l->debug($parser->error);
285 2         32 return;
286             }
287            
288 205 50       649 if (defined $options{defines}) {
289 0         0 @{ $self->{options} }{ keys %{ $options{defines} } } = values %{ delete $options{defines} };
  0         0  
  0         0  
  0         0  
290             }
291            
292 205 50       651 if ($options{logger}) {
293 0         0 $l->debug("got external logger");
294 0         0 $self->{logger} = delete $options{logger};
295             }
296            
297 205 50       676 if (my $opt = delete $options{optimize}) {
298 0         0 $l->debug("got optimization flag: $opt");
299 0         0 $self->{optimize} = $opt;
300             } else {
301 205         810 $self->{optimize} = 0;
302             }
303            
304 205 50       696 if (my $opt = delete $options{force_no_optimization}) {
305 0         0 $l->debug("got force_no_optimization flag");
306 0         0 $self->{force_no_optimization} = 1;
307             }
308            
309 205 50       658 if (my $time = delete $options{optimistic_threshold_time}) {
310 0         0 $l->debug("got optimistic_threshold_time flag");
311 0         0 $self->{optimistic_threshold_time} = $time;
312             }
313            
314             # add rdf as a default namespace to RDQL queries
315 205 100       615 if ($pclass eq 'RDF::Query::Parser::RDQL') {
316 17         71 $self->{parsed}{namespaces}{rdf} = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
317             }
318 205         1864 return $self;
319             }
320              
321             sub _new {
322 208     208   443 my $class = shift;
323 208         1664 my $self = bless( { @_ }, $class );
324 208         515 return $self;
325             }
326              
327             =item C<< get ( $model ) >>
328              
329             Executes the query using the specified model, and returns the first matching row as a LIST of values.
330              
331             =cut
332              
333             sub get {
334 18     18 1 505 my $self = shift;
335 18         90 my $stream = $self->execute( @_ );
336 18         79 my $row = $stream->next;
337 18 100       333 if (ref($row)) {
338 17         62 return @{ $row }{ $self->variables };
  17         148  
339             } else {
340 1         5 return undef;
341             }
342             }
343              
344             =item C<< prepare ( $model ) >>
345              
346             Prepares the query, constructing a query execution plan, and returns a list
347             containing ($plan, $context). To execute the plan, call
348             C<< execute_plan( $plan, $context ) >>.
349              
350             =cut
351              
352             sub prepare {
353 158     158 1 1161 my $self = shift;
354 158         293 my $_model = shift;
355 158         359 my %args = @_;
356 158         651 my $l = Log::Log4perl->get_logger("rdf.query");
357            
358 158         3491 $self->{_query_cache} = {}; # a new scratch hash for each execution.
359 158         287 my %bound;
360 158 100       545 if ($args{ 'bind' }) {
361 1         3 %bound = %{ $args{ 'bind' } };
  1         6  
362             }
363            
364 158         273 my $delegate;
365 158 50       554 if (defined $args{ 'delegate' }) {
366 0         0 $delegate = delete $args{ 'delegate' };
367 0 0 0     0 if ($delegate and not blessed($delegate)) {
368 0         0 $delegate = $delegate->new();
369             }
370             }
371 158 50       530 my $errors = ($args{ 'strict_errors' }) ? 1 : 0;
372 158         343 my $parsed = $self->{parsed};
373 158         695 my @vars = $self->variables( $parsed );
374            
375 158         560 local($self->{model}) = $self->{model};
376 158   33     1054 my $model = $self->{model} || $self->get_model( $_model, %args );
377 158 50       430 if ($model) {
378 158         623 $self->model( $model );
379 158         880 $l->debug("got model $model");
380             } else {
381 0         0 throw RDF::Query::Error::ModelError ( -text => "Could not create a model object." );
382             }
383            
384 158 100       1543 if ($self->{load_data}) {
385 100         514 $l->trace("loading data");
386 100         872 $self->load_data();
387             }
388            
389 158         469 $model = $self->model(); # reload the model object, because load_data might have changed it.
390            
391 158 100       2074 my $dataset = ($model->isa('RDF::Trine::Model::Dataset')) ? $model : RDF::Trine::Model::Dataset->new($model);
392            
393 158         1812 $l->trace("constructing ExecutionContext");
394             my $context = RDF::Query::ExecutionContext->new(
395             bound => \%bound,
396             model => $dataset,
397             query => $self,
398             base_uri => $parsed->{base_uri},
399             ns => $parsed->{namespaces},
400             logger => $self->logger,
401             optimize => $self->{optimize},
402             force_no_optimization => $self->{force_no_optimization},
403             optimistic_threshold_time => $self->{optimistic_threshold_time} || 0,
404             requested_variables => \@vars,
405             strict_errors => $errors,
406             options => $self->{options},
407 158   50     1970 delegate => $delegate,
408             );
409 158         528 $self->{model} = $model;
410            
411 158         574 $l->trace("getting QEP...");
412 158 100       1039 my %plan_args = %{ $args{ planner_args } || {} };
  158         1053  
413 158         862 my $plan = $self->query_plan( $context, %plan_args );
414 158         557 $l->trace("-> done.");
415            
416 158 50       1358 unless ($plan) {
417 0         0 throw RDF::Query::Error::CompilationError -text => "Query didn't produce a valid execution plan";
418             }
419            
420 158         819 return ($plan, $context);
421             }
422              
423             =item C<execute ( $model, %args )>
424              
425             Executes the query using the specified RDF C<< $model >>. If called in a list
426             context, returns an array of rows, otherwise returns an L<RDF::Trine::Iterator>
427             object. The iterator returned may be an instance of several subclasses of
428             L<RDF::Trine::Iterator>:
429              
430             * A L<RDF::Trine::Iterator::Bindings> object is returned for query forms producing variable binding results (SELECT queries).
431              
432             * A L<RDF::Trine::Iterator::Graph> object is returned for query forms producing in an RDF graph result (DESCRIBE and CONSTRUCT queries).
433              
434             * A L<RDF::Trine::Iterator::Boolean> object is returned for query forms producing a true/false result (ASK queries).
435              
436             =cut
437              
438             sub execute {
439 138     138 1 7761 my $self = shift;
440 138         289 my $model = shift;
441 138         381 my %args = @_;
442 138         837 my $l = Log::Log4perl->get_logger("rdf.query");
443 138   100     4629 $l->debug("executing query with model " . ($model or ''));
444            
445 138         1407 my $lang_iri = '';
446 138         318 my $parser = $self->{parser};
447 138         217 my $name;
448 138 100       1503 if ($parser->isa('RDF::Query::Parser::SPARQL11')) {
    100          
449 42 100       194 if ($self->is_update) {
450 5         13 $name = 'SPARQL 1.1 Update';
451 5         14 $lang_iri = 'http://www.w3.org/ns/sparql-service-description#SPARQL11Update';
452             } else {
453 37         88 $name = 'SPARQL 1.1 Query';
454 37         95 $lang_iri = 'http://www.w3.org/ns/sparql-service-description#SPARQL11Query';
455             }
456             } elsif ($parser->isa('RDF::Query::Parser::SPARQL')) {
457 83         170 $name = 'SPARQL 1.0 Query';
458 83         182 $lang_iri = 'http://www.w3.org/ns/sparql-service-description#SPARQL10Query';
459             }
460            
461 138         528 local($self->{model}) = $self->{model};
462             # warn "model: $self->{model}";
463             # warn "passthrough checking if model supports $lang_iri\n";
464 138 50 33     661 if ($self->{options}{allow_passthrough} and $model->supports($lang_iri)) {
465 0         0 $l->info("delegating $name execution to the underlying model");
466 0         0 return $model->get_sparql( $self->{query_string} );
467             } else {
468 138         658 my ($plan, $context) = $self->prepare( $model, %args );
469 138 50       564 if ($l->is_trace) {
470 0         0 $l->trace(">>>>>>>>>>>>>>>>>>>>>>>>>>>>>");
471 0         0 $l->trace($self->as_sparql);
472 0         0 $l->trace(">>>>>>>>>>>>>>>>>>>>>>>>>>>>>");
473             }
474 138         1367 return $self->execute_plan( $plan, $context );
475             }
476             }
477              
478             =item C<< execute_plan ( $plan, $context ) >>
479              
480             Executes the query plan generated by the C<<prepare>> method using the supplied
481             L<RDF::Query::ExecutionContext> object. Return value(s) are the same as for the
482             C<<execute>> method.
483              
484             =cut
485              
486             sub execute_plan {
487 157     157 1 383 my $self = shift;
488 157         268 my $plan = shift;
489 157         256 my $context = shift;
490 157         574 my $model = $context->model;
491 157         416 my $parsed = $self->{parsed};
492 157         567 my @vars = $self->variables( $parsed );
493            
494 157         675 my $l = Log::Log4perl->get_logger("rdf.query");
495            
496 157         3268 my $pattern = $self->pattern;
497             # $l->trace("calling fixup()");
498             # my $cpattern = $self->fixup();
499            
500 157         963 my @funcs = $pattern->referenced_functions;
501 157         377 foreach my $f (@funcs) {
502 32         145 $self->run_hook( 'http://kasei.us/code/rdf-query/hooks/function_init', $f );
503             }
504            
505             # RUN THE QUERY!
506            
507 157         625 $l->debug("executing the graph pattern");
508            
509 157   50     1714 my $options = $parsed->{options} || {};
510 157 50       554 if ($self->{options}{plan}) {
511 0         0 warn $plan->sse({}, '');
512             }
513            
514 157         766 $plan->execute( $context );
515 157         842 my $stream = $plan->as_iterator( $context );
516            
517 157 100       998 if ($parsed->{'method'} eq 'DESCRIBE') {
    100          
518 4         22 $stream = $self->describe( $stream, $context );
519             } elsif ($parsed->{'method'} eq 'ASK') {
520 8         31 $stream = $self->ask( $stream, $context );
521             }
522            
523 157         1114 $l->debug("going to call post-execute hook");
524 157         1633 $self->run_hook( 'http://kasei.us/code/rdf-query/hooks/post-execute', $model, $stream );
525            
526 157 100       391 if (wantarray) {
527 19         104 return $stream->get_all();
528             } else {
529 138         1920 return $stream;
530             }
531             }
532              
533             =item C<< prepare_with_named_graphs ( $model, @uris ) >>
534              
535             =cut
536              
537             sub prepare_with_named_graphs {
538 0     0 1 0 my $self = shift;
539 0         0 my $_model = shift;
540 0         0 my @graphs = @_;
541 0         0 my $l = Log::Log4perl->get_logger("rdf.query");
542             # $self->{model} = $model;
543 0         0 my $model = $self->get_model( $_model );
544 0 0       0 if ($model) {
545 0         0 $self->model( $model );
546             } else {
547 0         0 throw RDF::Query::Error::ModelError ( -text => "Could not create a model object." );
548             }
549            
550 0         0 foreach my $gdata (@graphs) {
551 0 0       0 my $url = (blessed($gdata)) ? $gdata->uri_value : $gdata;
552 0         0 $l->debug("-> adding graph data $url");
553 0         0 $self->parse_url( $url, 1 );
554             }
555            
556 0         0 return $self->prepare( $model );
557             }
558              
559             =item C<< execute_with_named_graphs ( $model, @uris ) >>
560              
561             Executes the query using the specified RDF C<< $model >>, loading the contents
562             of the specified C<@uris> into named graphs immediately prior to matching the
563             query. Otherwise, acts just like C<< execute >>.
564              
565             =cut
566              
567             sub execute_with_named_graphs {
568 0     0 1 0 my $self = shift;
569 0         0 my $_model = shift;
570 0         0 my @graphs;
571             my @options;
572 0 0       0 if (scalar(@_)) {
573 0 0 0     0 if (not(blessed($_[0])) and reftype($_[0]) eq 'ARRAY') {
574 0         0 @graphs = @{ shift(@_) };
  0         0  
575 0         0 @options = @_;
576             } else {
577 0         0 @graphs = @_;
578             }
579             }
580            
581 0         0 my ($plan, $ctx) = $self->prepare_with_named_graphs( $_model, @graphs );
582 0         0 return $self->execute_plan( $plan, $ctx );
583             }
584              
585             =begin private
586              
587             =item C<< query_plan ( $execution_context ) >>
588              
589             Returns a RDF::Query::Plan object that is (hopefully) the optimal QEP for the
590             current query.
591              
592             =end private
593              
594             =cut
595              
596             sub query_plan {
597 158     158 1 295 my $self = shift;
598 158         288 my $context = shift;
599 158         327 my %args = @_;
600 158         353 my $parsed = $self->{parsed};
601            
602 158         757 my $bound = $context->bound;
603 158         319 my @bkeys = keys %{ $bound };
  158         440  
604 158         685 my $model = $context->model;
605            
606 158 100       542 unless ($self->{update}) {
607 148 50 33     690 if (not exists $self->{options}{'rdf.query.plan.delegate'} or $self->{options}{'rdf.query.plan.delegate'}) {
608             my $delegate_key = $self->{update}
609 148 50       513 ? 'http://www.w3.org/ns/sparql-service-description#SPARQL11Update'
610             : "http://www.w3.org/ns/sparql-service-description#SPARQL10Query"; # TODO: need to determine if the query is only 1.0, and if so, check for 1.0 support. otherwise check for 1.1 support
611 148 50 66     1054 if (scalar(@bkeys) == 0 and $model->supports($delegate_key)) {
612             my $plan = RDF::Query::Plan::Iterator->new( sub {
613 0     0   0 my $context = shift;
614 0         0 my $model = $context->model;
615 0         0 my $iter = $model->get_sparql( $self->{query_string} );
616 0         0 return $iter;
617 0         0 } );
618 0         0 return $plan;
619             }
620             }
621             }
622            
623 158         4130 my %constant_plan;
624 158 100       592 if (my $b = $self->{parsed}{bindings}) {
625 3         7 my $vars = $b->{vars};
626 3         7 my $values = $b->{terms};
627 3         5 my @names = map { $_->name } @{ $vars };
  5         22  
  3         9  
628 3         16 my @constants;
629 3         5 while (my $values = shift(@{ $b->{terms} })) {
  7         26  
630 4         5 my %bound;
631             # @bound{ @names } = @{ $values };
632 4         10 foreach my $i (0 .. $#names) {
633 6         14 my $k = $names[$i];
634 6         13 my $v = $values->[$i];
635 6 100       15 next unless defined($v);
636 5         16 $bound{ $k } = $v;
637             }
638 4         23 my $bound = RDF::Query::VariableBindings->new( \%bound );
639 4         11 push(@constants, $bound);
640             }
641 3         21 my $constant_plan = RDF::Query::Plan::Constant->new( @constants );
642 3         14 %constant_plan = ( constants => [ $constant_plan ] );
643             }
644            
645 158         653 my $algebra = $self->pattern;
646 158         626 my $pclass = $self->plan_class;
647 158         1332 my @plans = $pclass->generate_plans( $algebra, $context, %args, %constant_plan );
648            
649 158         772 my $l = Log::Log4perl->get_logger("rdf.query.plan");
650 158 50       3523 if (wantarray) {
651 0         0 return @plans;
652             } else {
653 158         334 my ($plan) = @plans; # XXX need to figure out what's the 'best' plan here
654 158 50       603 if ($l->is_debug) {
655 0         0 $l->debug("using query plan: " . $plan->sse({}, ''));
656             }
657 158         1689 return $plan;
658             }
659             }
660              
661             =begin private
662              
663             =item C<< plan_class >>
664              
665             Returns the class name for Plan generation. This method should be overloaded by
666             RDF::Query subclasses if the implementation also provides a subclass of
667             RDF::Query::Plan.
668              
669             =end private
670              
671             =cut
672              
673             sub plan_class {
674 158     158 1 382 return 'RDF::Query::Plan';
675             }
676              
677             =begin private
678              
679             =item C<< describe ( $iter, $context ) >>
680              
681             Takes a stream of matching statements and constructs a DESCRIBE graph.
682              
683             =end private
684              
685             =cut
686              
687             sub describe {
688 4     4 1 6 my $self = shift;
689 4         9 my $stream = shift;
690 4         8 my $context = shift;
691 4         15 my $model = $context->model;
692 4         9 my @nodes;
693             my %seen;
694 4         20 while (my $row = $stream->next) {
695 7         11 foreach my $v (@{ $self->{parsed}{variables} }) {
  7         23  
696 7 100       36 if ($v->isa('RDF::Query::Node::Variable')) {
    50          
697 6         21 my $node = $row->{ $v->name };
698 6 50       51 my $string = blessed($node) ? $node->as_string : '';
699 6 100       83 push(@nodes, $node) unless ($seen{ $string }++);
700             } elsif ($v->isa('RDF::Query::Node::Resource')) {
701 1 50       8 my $string = blessed($v) ? $v->as_string : '';
702 1 50       17 push(@nodes, $v) unless ($seen{ $string }++);
703             }
704             }
705             }
706            
707 4         77 my @streams;
708 4         13 $self->{'describe_nodes'} = [];
709 4         9 foreach my $node (@nodes) {
710 4         7 push(@{ $self->{'describe_nodes'} }, $node);
  4         11  
711 4         31 push(@streams, $model->bounded_description( $node ));
712             }
713            
714             my $ret = sub {
715 148     148   40054 while (@streams) {
716 148         456 my $val = $streams[0]->next;
717 148 100       96209 if (defined $val) {
718 144         357 return $val;
719             } else {
720 4         10 shift(@streams);
721 4 50       76 return undef if (not @streams);
722             }
723             }
724 4         258 };
725 4         15 return RDF::Trine::Iterator::Graph->new( $ret );
726             }
727              
728              
729             =begin private
730              
731             =item C<ask ( $iter, $context )>
732              
733             Takes a stream of matching statements and returns a boolean query result stream.
734              
735             =end private
736              
737             =cut
738              
739             sub ask {
740 8     8 1 15 my $self = shift;
741 8         19 my $stream = shift;
742 8         15 my $context = shift;
743 8         36 my $value = $stream->next;
744 8 100       88 my $bool = ($value) ? 1 : 0;
745 8         76 return RDF::Trine::Iterator::Boolean->new( [ $bool ] );
746             }
747              
748             ######################################################################
749              
750             =item C<< pattern >>
751              
752             Returns the RDF::Query::Algebra::GroupGraphPattern algebra pattern for this query.
753              
754             =cut
755              
756             sub pattern {
757 430     430 1 747 my $self = shift;
758 430         1119 my $parsed = $self->parsed;
759 430         711 my @triples = @{ $parsed->{triples} };
  430         1121  
760 430 100 66     16512 if (scalar(@triples) == 1 and ($triples[0]->isa('RDF::Query::Algebra::GroupGraphPattern')
      66        
761             or $triples[0]->isa('RDF::Query::Algebra::Filter')
762             or $triples[0]->isa('RDF::Query::Algebra::Sort')
763             or $triples[0]->isa('RDF::Query::Algebra::Limit')
764             or $triples[0]->isa('RDF::Query::Algebra::Offset')
765             or $triples[0]->isa('RDF::Query::Algebra::Distinct')
766             or $triples[0]->isa('RDF::Query::Algebra::Project')
767             or $triples[0]->isa('RDF::Query::Algebra::Construct')
768             or $triples[0]->isa('RDF::Query::Algebra::Load')
769             or $triples[0]->isa('RDF::Query::Algebra::Clear')
770             or $triples[0]->isa('RDF::Query::Algebra::Create')
771             or $triples[0]->isa('RDF::Query::Algebra::Update')
772             )) {
773 427         696 my $ggp = $triples[0];
774 427         1093 return $ggp;
775             } else {
776 3         16 return RDF::Query::Algebra::GroupGraphPattern->new( @triples );
777             }
778             }
779              
780             =item C<< is_update >>
781              
782             =cut
783              
784             sub is_update {
785 48     48 1 4082 my $self = shift;
786 48         194 my $pat = $self->pattern;
787 48 50       234 return 1 if ($pat->subpatterns_of_type('RDF::Query::Algebra::Clear'));
788 48 50       175 return 1 if ($pat->subpatterns_of_type('RDF::Query::Algebra::Copy'));
789 48 50       167 return 1 if ($pat->subpatterns_of_type('RDF::Query::Algebra::Create'));
790 48 50       166 return 1 if ($pat->subpatterns_of_type('RDF::Query::Algebra::Move'));
791 48 100       176 return 1 if ($pat->subpatterns_of_type('RDF::Query::Algebra::Update'));
792 42         166 return 0;
793             }
794              
795             =item C<< as_sparql >>
796              
797             Returns the query as a string in the SPARQL syntax.
798              
799             =cut
800              
801             sub as_sparql {
802 33     33 1 580 my $self = shift;
803 33   50     108 my $parsed = $self->parsed || {};
804            
805 33 100       53 my $context = { namespaces => { %{ $parsed->{namespaces} || {} } } };
  33         206  
806 33         76 my $method = $parsed->{method};
807            
808 33 100       145 if ($method =~ /^(DESCRIBE|ASK)$/i) {
809 4         9 $context->{force_ggp_braces} = 1;
810             }
811            
812 33         53 my @vars = map { $_->as_sparql( $context, '' ) } @{ $parsed->{ variables } };
  34         156  
  33         77  
813 33         349 my $vars = join(' ', @vars);
814 33         100 my $ggp = $self->pattern;
815            
816 33 50       121 if ($method =~ /^(LOAD|CLEAR|CREATE|UPDATE)$/) {
817 0         0 return $ggp->as_sparql;
818             } else {
819             {
820 33         43 my $pvars = join(' ', sort $ggp->referenced_variables);
  33         151  
821 33 50       67 my $svars = join(' ', sort map { $_->isa('RDF::Query::Node::Resource') ? $_->as_string : $_->name } @{ $parsed->{ variables } });
  34         230  
  33         87  
822 33 100       222 if ($pvars eq $svars) {
823 15         37 $vars = '*';
824             }
825             }
826            
827 33 50       53 my @ns = map { "PREFIX " . ($_ eq '__DEFAULT__' ? '' : $_) . ": <$parsed->{namespaces}{$_}>" } (sort keys %{ $parsed->{namespaces} });
  39         232  
  33         104  
828 33         57 my @mod;
829 33 50       112 if (my $ob = $parsed->{options}{orderby}) {
830             push(@mod, 'ORDER BY ' . join(' ', map {
831 0         0 my ($dir,$v) = @$_;
  0         0  
832 0 0       0 ($dir eq 'ASC')
833             ? $v->as_sparql( $context, '' )
834             : "${dir}" . $v->as_sparql( $context, '' );
835             } @$ob));
836             }
837 33 50       101 if (my $l = $parsed->{options}{limit}) {
838 0         0 push(@mod, "LIMIT $l");
839             }
840 33 50       89 if (my $o = $parsed->{options}{offset}) {
841 0         0 push(@mod, "OFFSET $o");
842             }
843 33         62 my $mod = join("\n", @mod);
844            
845 33         49 my $methoddata = '';
846 33 100       86 if ($method eq 'SELECT') {
    100          
    100          
847 27         46 $methoddata = $method;
848             } elsif ($method eq 'ASK') {
849 2         5 $methoddata = $method;
850             } elsif ($method eq 'DESCRIBE') {
851 2         11 $methoddata = sprintf("%s %s\nWHERE", $method, $vars);
852             }
853            
854 33 100       106 my $ns = scalar(@ns) ? join("\n", @ns, '') : '';
855 33         45 my $sparql;
856 33 50 66     136 if ($methoddata or $ns) {
857 33         151 $sparql = sprintf(
858             "$ns%s %s\n%s",
859             $methoddata,
860             $ggp->as_sparql( $context, '' ),
861             $mod,
862             );
863             } else {
864 0         0 $sparql = sprintf(
865             "%s\n%s",
866             $ggp->as_sparql( $context, '' ),
867             $mod,
868             );
869             }
870            
871 33         106 chomp($sparql);
872 33         198 return $sparql;
873             }
874             }
875              
876             =item C<< as_hash >>
877              
878             Returns the query as a nested set of plain data structures (no objects).
879              
880             =cut
881              
882             sub as_hash {
883 0     0 1 0 my $self = shift;
884 0         0 my $pattern = $self->pattern;
885 0         0 return $pattern->as_hash;
886             }
887              
888             =item C<< sse >>
889              
890             Returns the query as a string in the SSE syntax.
891              
892             =cut
893              
894             sub sse {
895 13     13 1 58 my $self = shift;
896 13         40 my $parsed = $self->parsed;
897            
898 13         42 my $ggp = $self->pattern;
899 13         27 my $ns = $parsed->{namespaces};
900 13         21 my $nscount = scalar(@{ [ keys %$ns ] });
  13         41  
901 13         32 my $base_uri = $parsed->{base};
902            
903 13         20 my $indent = ' ';
904 13         51 my $context = { namespaces => $ns, indent => $indent };
905 13         20 my $indentcount = 0;
906 13 100       43 $indentcount++ if ($base_uri);
907 13 100       40 $indentcount++ if ($nscount);
908 13         30 my $prefix = $indent x $indentcount;
909            
910 13         54 my $sse = $ggp->sse( $context, $prefix );
911            
912 13 100       50 if ($nscount) {
913 8         33 $sse = sprintf("(prefix (%s)\n${prefix}%s)", join("\n${indent}" . ' 'x9, map { "(${_}: <$ns->{$_}>)" } (sort keys %$ns)), $sse);
  9         52  
914             }
915            
916 13 100       38 if ($base_uri) {
917 1         12 $sse = sprintf("(base <%s>\n${indent}%s)", $base_uri->uri_value, $sse);
918             }
919            
920 13         37 chomp($sse);
921 13         66 return $sse;
922             }
923              
924             =item C<< dateparser >>
925              
926             Returns the DateTime::Format::W3CDTF object associated with this query object.
927              
928             =cut
929              
930             sub dateparser {
931 2     2 1 3 my $self = shift;
932 2   33     23 my $parser = ($self->{dateparser} ||= DateTime::Format::W3CDTF->new);
933 2         20 return $parser;
934             }
935              
936             =begin private
937              
938             =item C<< supports ( $model, $feature ) >>
939              
940             Returns a boolean value representing the support of $feature for the given model.
941              
942             =end private
943              
944             =cut
945              
946             sub supports {
947 0     0 1 0 my $self = shift;
948 0         0 my $obj = shift;
949 0         0 my $model = $self->get_model( $obj );
950 0         0 return $model->supports( @_ );
951             }
952              
953             =item C<< specifies_update_dataset >>
954              
955             Returns true if the query specifies a custom update dataset via the WITH or
956             USING keywords, false otherwise.
957              
958             =cut
959              
960             sub specifies_update_dataset {
961 3     3 1 19 my $self = shift;
962 35     35   256 no warnings 'uninitialized';
  35         123  
  35         81005  
963 3 100       25 return $self->{parsed}{custom_update_dataset} ? 1 : 0;
964             }
965              
966             =begin private
967              
968             =item C<< get_model ( $model ) >>
969              
970             Returns a model object for use during execution.
971             If C<< $model >> is a usable model, it is simply returned.
972             Otherwise, a temporary model is constructed and returned.
973              
974             =end private
975              
976             =cut
977              
978             sub get_model {
979 158     158 1 293 my $self = shift;
980 158         267 my $store = shift;
981 158         325 my %args = @_;
982            
983 158 50       584 my $parsed = ref($self) ? $self->{parsed} : undef;
984            
985 158         241 my $model;
986 158 100       1340 if (not $store) {
    50          
    0          
    0          
987 2         60 $model = RDF::Trine::Model->temporary_model;
988             } elsif (($store->isa('RDF::Trine::Model'))) {
989 156         297 $model = $store;
990             } elsif ($store->isa('RDF::Redland::Model')) {
991 0         0 my $s = RDF::Trine::Store->new_with_object( $store );
992 0         0 $model = RDF::Trine::Model->new( $s );
993 0 0       0 unless (blessed($model)) {
994 0         0 Carp::cluck "Failed to construct an RDF::Trine model from $store";
995 0         0 return;
996             }
997             } elsif ($store->isa('RDF::Core::Model')) {
998 0         0 Carp::croak "RDF::Core is no longer supported";
999             } else {
1000 0         0 Carp::confess "unknown store type: $store";
1001             }
1002            
1003 158         953 return $model;
1004             }
1005              
1006             =begin private
1007              
1008             =item C<< load_data >>
1009              
1010             Loads any external data required by this query (FROM and FROM NAMED clauses).
1011              
1012             =end private
1013              
1014             =cut
1015              
1016             sub load_data {
1017 100     100 1 174 my $self = shift;
1018 100         222 my $parsed = $self->{parsed};
1019            
1020             ## LOAD ANY EXTERNAL RDF FILES
1021 100         214 my $sources = $parsed->{'sources'};
1022 100 100 66     1054 if (ref($sources) and reftype($sources) eq 'ARRAY' and scalar(@$sources)) {
      100        
1023 13         158 my $model = RDF::Trine::Model->temporary_model;
1024 13         1071 $self->model( $model );
1025 13         43 foreach my $source (@$sources) {
1026 23   66     1057212 my $named_source = (2 == @{$source} and $source->[1] eq 'NAMED');
1027 23         121 my $uri = $source->[0]->uri_value;
1028 23         245 $self->parse_url( $uri, $named_source );
1029             }
1030 13         580086 $self->run_hook( 'http://kasei.us/code/rdf-query/hooks/post-create-model', $model );
1031             }
1032             }
1033              
1034              
1035             =begin private
1036              
1037             =item C<< var_or_expr_value ( \%bound, $value, $context ) >>
1038              
1039             Returns an (non-variable) RDF::Query::Node value based on C<< $value >>.
1040             If C<< $value >> is a node object, it is simply returned. If it is an
1041             RDF::Query::Node::Variable object, the corresponding value in C<< \%bound >>
1042             is returned. If it is an RDF::Query::Expression object, the expression
1043             is evaluated using C<< \%bound >>, and the resulting value is returned.
1044              
1045             =end private
1046              
1047             =cut
1048              
1049             sub var_or_expr_value {
1050 338     338 1 525 my $self = shift;
1051 338         409 my $bound = shift;
1052 338         423 my $v = shift;
1053 338         385 my $ctx = shift;
1054 338 50       1099 Carp::confess 'not an object value in var_or_expr_value: ' . Dumper($v) unless (blessed($v));
1055 338 100       2341 if ($v->isa('RDF::Query::Expression')) {
    100          
    50          
1056 46         176 return $v->evaluate( $self, $bound, $ctx );
1057             } elsif ($v->isa('RDF::Trine::Node::Variable')) {
1058 265         752 return $bound->{ $v->name };
1059             } elsif ($v->isa('RDF::Query::Node')) {
1060 27         97 return $v;
1061             } else {
1062 0         0 Carp::cluck "not an expression or node value in var_or_expr_value: " . Dumper($v, $bound);
1063 0         0 throw RDF::Query::Error -text => 'Not an expression or node value';
1064             }
1065             }
1066              
1067              
1068             =item C<add_function ( $uri, $function )>
1069              
1070             Associates the custom function C<$function> (a CODE reference) with the
1071             specified URI, allowing the function to be called by query FILTERs.
1072              
1073             =cut
1074              
1075             sub add_function {
1076 2     2 1 44 my $self = shift;
1077 2         5 my $uri = shift;
1078 2         4 my $code = shift;
1079 2 100       9 if (ref($self)) {
1080 1         5 $self->{'functions'}{$uri} = $code;
1081             } else {
1082 1         3 our %functions;
1083 1         6 $RDF::Query::functions{ $uri } = $code;
1084             }
1085             }
1086              
1087             =item C<< supported_extensions >>
1088              
1089             Returns a list of URLs representing extensions to SPARQL that are supported
1090             by the query engine.
1091              
1092             =cut
1093              
1094             sub supported_extensions {
1095 0     0 1 0 my $self = shift;
1096 0         0 return qw(
1097             http://kasei.us/2008/04/sparql-extension/service
1098             http://kasei.us/2008/04/sparql-extension/service/bloom_filters
1099             http://kasei.us/2008/04/sparql-extension/unsaid
1100             http://kasei.us/2008/04/sparql-extension/federate_bindings
1101             http://kasei.us/2008/04/sparql-extension/select_expression
1102             http://kasei.us/2008/04/sparql-extension/aggregate
1103             http://kasei.us/2008/04/sparql-extension/aggregate/count
1104             http://kasei.us/2008/04/sparql-extension/aggregate/count-distinct
1105             http://kasei.us/2008/04/sparql-extension/aggregate/min
1106             http://kasei.us/2008/04/sparql-extension/aggregate/max
1107             );
1108             }
1109              
1110             =item C<< supported_functions >>
1111              
1112             Returns a list URLs that may be used as functions in FILTER clauses
1113             (and the SELECT clause if the SPARQL 1.1 parser is used).
1114              
1115             =cut
1116              
1117             sub supported_functions {
1118 0     0 1 0 my $self = shift;
1119 0         0 my @funcs;
1120            
1121 0 0       0 if (blessed($self)) {
1122 0         0 push(@funcs, keys %{ $self->{'functions'} });
  0         0  
1123             }
1124            
1125 0         0 push(@funcs, keys %RDF::Query::functions);
1126 0         0 return grep { not(/^sparql:/) } @funcs;
  0         0  
1127             }
1128              
1129             =begin private
1130              
1131             =item C<get_function ( $uri, %args )>
1132              
1133             If C<$uri> is associated with a query function, returns a CODE reference
1134             to the function. Otherwise returns C<undef>.
1135              
1136             =end private
1137              
1138             =cut
1139              
1140             sub get_function {
1141 360     360 1 496 my $self = shift;
1142 360         491 my $uri = shift;
1143 360         659 my %args = @_;
1144 360         1189 my $l = Log::Log4perl->get_logger("rdf.query");
1145 360 50 33     9998 if (blessed($uri) and $uri->isa('RDF::Query::Node::Resource')) {
1146 360         1070 $uri = $uri->uri_value;
1147             }
1148 360         2500 $l->debug("trying to get function from $uri");
1149            
1150 360 50 33     3256 if (blessed($uri) and $uri->isa('RDF::Query::Node::Resource')) {
1151 0         0 $uri = $uri->uri_value;
1152             }
1153            
1154 360         485 my $func;
1155 360 100       770 if (ref($self)) {
1156 261   66     1344 $func = $self->{'functions'}{$uri} || $RDF::Query::functions{ $uri };
1157             } else {
1158 99         254 $func = $RDF::Query::functions{ $uri };
1159             }
1160            
1161 360 50       857 if ($func) {
1162 360         1113 return $func;
1163             }
1164 0         0 return;
1165             }
1166              
1167              
1168             =begin private
1169              
1170             =item C<< call_function ( $model, $bound, $uri, @args ) >>
1171              
1172             If C<$uri> is associated with a query function, calls the function with the supplied arguments.
1173              
1174             =end private
1175              
1176             =cut
1177              
1178             sub call_function {
1179 0     0 1 0 my $self = shift;
1180 0         0 my $model = shift;
1181 0         0 my $bound = shift;
1182 0         0 my $uri = shift;
1183 0         0 my $l = Log::Log4perl->get_logger("rdf.query");
1184 0         0 $l->debug("trying to get function from $uri");
1185            
1186 0         0 my $filter = RDF::Query::Expression::Function->new( $uri, @_ );
1187 0         0 return $filter->evaluate( $self, $bound );
1188             }
1189              
1190             =item C<< add_computed_statement_generator ( $predicate => \&generator ) >>
1191              
1192             Adds a statement generator for the given C<< $predicate >> to the query object.
1193             This statement generator will be called as
1194             C<< $generator->( $query, $model, \%bound, $s, $p, $o, $c ) >>
1195             and is expected to return an RDF::Trine::Iterator::Graph object containing
1196             statements with C<< $predicate >>.
1197              
1198             =cut
1199              
1200             sub add_computed_statement_generator {
1201 1     1 1 8 my $self = shift;
1202 1 50       5 if (scalar(@_) == 1) {
1203 0         0 throw RDF::Query::Error::MethodInvocationError -text => 'RDF::Query::add_computed_statement_generator must now take two arguments: ( $predicate, \&generator ).';
1204             }
1205 1         2 my $pred = shift;
1206 1         2 my $gen = shift;
1207 1 50       5 if (blessed($pred)) {
1208 0 0       0 if ($pred->can('uri_value')) {
1209 0         0 $pred = $pred->uri_value;
1210             } else {
1211 0         0 $pred = "$pred";
1212             }
1213             }
1214 1         1 push( @{ $self->{'computed_statement_generators'}{ $pred } }, $gen );
  1         7  
1215             }
1216              
1217             =item C<< get_computed_statement_generators ( [ $predicate ] ) >>
1218              
1219             Returns an ARRAY reference of computed statement generator closures.
1220              
1221             =cut
1222              
1223             sub get_computed_statement_generators {
1224 409     409 1 3718 my $self = shift;
1225 409 50       1042 if (@_) {
1226 409         653 my $pred = shift;
1227 409 50       1231 if (blessed($pred)) {
1228 0 0       0 if ($pred->can('uri_value')) {
1229 0         0 $pred = $pred->uri_value;
1230             } else {
1231 0         0 $pred = "$pred";
1232             }
1233             }
1234 409   100     2922 return $self->{'computed_statement_generators'}{ $pred } || [];
1235             } else {
1236 0   0     0 return $self->{'computed_statement_generators'} || {};
1237             }
1238             }
1239              
1240             =item C<< add_hook_once ( $hook_uri, $function, $token ) >>
1241              
1242             Calls C<< add_hook >> adding the supplied C<< $function >> only once based on
1243             the C<< $token >> identifier. This may be useful if the only code that is able
1244             to add a hook is called many times (in an extension function, for example).
1245              
1246             =cut
1247              
1248             sub add_hook_once {
1249 0     0 1 0 my $self = shift;
1250 0         0 my $uri = shift;
1251 0         0 my $code = shift;
1252 0         0 my $token = shift;
1253 0 0       0 unless ($self->{'hooks_once'}{ $token }++) {
1254 0         0 $self->add_hook( $uri, $code );
1255             }
1256             }
1257              
1258             =item C<< add_hook ( $hook_uri, $function ) >>
1259              
1260             Associates the custom function C<$function> (a CODE reference) with the
1261             RDF::Query code hook specified by C<$uri>. Each function that has been
1262             associated with a particular hook will be called (in the order they were
1263             registered as hooks) when the hook event occurs. See L</"Defined Hooks">
1264             for more information.
1265              
1266             =cut
1267              
1268             sub add_hook {
1269 0     0 1 0 my $self = shift;
1270 0         0 my $uri = shift;
1271 0         0 my $code = shift;
1272 0 0       0 if (ref($self)) {
1273 0         0 push(@{ $self->{'hooks'}{$uri} }, $code);
  0         0  
1274             } else {
1275 0         0 our %hooks;
1276 0         0 push(@{ $RDF::Query::hooks{ $uri } }, $code);
  0         0  
1277             }
1278             }
1279              
1280             =begin private
1281              
1282             =item C<get_hooks ( $uri )>
1283              
1284             If C<$uri> is associated with any query callback functions ("hooks"),
1285             returns an ARRAY reference to the functions. If no hooks are associated
1286             with C<$uri>, returns a reference to an empty array.
1287              
1288             =end private
1289              
1290             =cut
1291              
1292             sub get_hooks {
1293 202     202 1 357 my $self = shift;
1294 202         348 my $uri = shift;
1295             my $func = $self->{'hooks'}{ $uri }
1296 202   50     1830 || $RDF::Query::hooks{ $uri }
1297             || [];
1298 202         502 return $func;
1299             }
1300              
1301             =begin private
1302              
1303             =item C<run_hook ( $uri, @args )>
1304              
1305             Calls any query callback functions associated with C<$uri>. Each callback
1306             is called with the query object as the first argument, followed by any
1307             caller-supplied arguments from C<@args>.
1308              
1309             =end private
1310              
1311             =cut
1312              
1313             sub run_hook {
1314 202     202 1 440 my $self = shift;
1315 202         395 my $uri = shift;
1316 202         1239 my @args = @_;
1317 202         884 my $hooks = $self->get_hooks( $uri );
1318 202         799 foreach my $hook (@$hooks) {
1319 0         0 $hook->( $self, @args );
1320             }
1321             }
1322              
1323             =begin private
1324              
1325             =item C<< parse_url ( $url, $named ) >>
1326              
1327             Retrieve a remote file by URL, and parse RDF into the RDF store.
1328             If $named is TRUE, associate all parsed triples with a named graph.
1329              
1330             =end private
1331              
1332             =cut
1333             sub parse_url {
1334 23     23 1 63 my $self = shift;
1335 23         41 my $url = shift;
1336 23         42 my $named = shift;
1337 23         75 my $model = $self->model;
1338            
1339 23 100       79 if ($named) {
1340 16         113 RDF::Trine::Parser->parse_url_into_model( $url, $model, context => iri($url) );
1341             } else {
1342 7         112 RDF::Trine::Parser->parse_url_into_model( $url, $model );
1343             }
1344             }
1345              
1346             =begin private
1347              
1348             =item C<variables ()>
1349              
1350             Returns a list of the ordered variables the query is selecting.
1351            
1352             =end private
1353              
1354             =cut
1355              
1356             sub variables {
1357 333     333 1 563 my $self = shift;
1358 333   66     953 my $parsed = shift || $self->parsed;
1359 480         3029 my @vars = map { $_->name }
1360             grep {
1361 482 100       2345 $_->isa('RDF::Query::Node::Variable') or $_->isa('RDF::Query::Expression::Alias')
1362 333         549 } @{ $parsed->{'variables'} };
  333         890  
1363 333         2735 return @vars;
1364             }
1365              
1366             =item C<parsed ()>
1367              
1368             Returns the parse tree.
1369              
1370             =cut
1371              
1372             sub parsed {
1373 494     494 1 705 my $self = shift;
1374 494 50       1234 if (@_) {
1375 0         0 $self->{parsed} = shift;
1376             }
1377 494         1128 return $self->{parsed};
1378             }
1379              
1380             =item C<< model >>
1381              
1382             Returns the RDF::Trine::Model object for this query.
1383              
1384             =cut
1385              
1386             sub model {
1387 365     365 1 590 my $self = shift;
1388 365 100       1008 if (@_) {
1389 171         425 $self->{model} = shift;
1390             }
1391 365         606 my $model = $self->{model};
1392 365 50       930 unless (defined $model) {
1393 0         0 Carp::confess "query->model shouldn't be calling get_model";
1394 0         0 $model = $self->get_model();
1395             }
1396            
1397 365         703 return $model;
1398             }
1399              
1400              
1401             =item C<< useragent >>
1402              
1403             Returns the LWP::UserAgent object used for retrieving web content.
1404              
1405             =cut
1406              
1407             sub useragent {
1408 0     0 1 0 my $self = shift;
1409 0 0       0 if (my $ua = $self->{useragent}) {
1410 0         0 return $ua;
1411             } else {
1412 0         0 my $ua = LWP::UserAgent->new( agent => "RDF::Query/${VERSION}" );
1413 0         0 $ua->default_headers->push_header( 'Accept' => "application/sparql-results+xml;q=0.9,application/rdf+xml;q=0.5,text/turtle;q=0.7,text/xml" );
1414 0         0 $self->{useragent} = $ua;
1415 0         0 return $ua;
1416             }
1417             }
1418              
1419              
1420             =item C<< log ( $key [, $value ] ) >>
1421              
1422             If no logger object is associated with this query object, does nothing.
1423             Otherwise, return or set the corresponding value depending on whether a
1424             C<< $value >> is specified.
1425              
1426             =cut
1427              
1428             sub log {
1429 0     0 1 0 my $self = shift;
1430 0 0       0 if (blessed(my $l = $self->{ logger })) {
1431 0         0 $l->log( @_ );
1432             }
1433             }
1434              
1435              
1436             =item C<< logger >>
1437              
1438             Returns the logger object associated with this query object (if present).
1439              
1440             =cut
1441              
1442             sub logger {
1443 158     158 1 274 my $self = shift;
1444 158         2394 return $self->{ logger };
1445             }
1446              
1447             =item C<error ()>
1448              
1449             Returns the last error the parser experienced.
1450              
1451             =cut
1452              
1453             sub error {
1454 0     0 1 0 my $self = shift;
1455 0 0       0 if (blessed($self)) {
1456 0         0 return $self->{error};
1457             } else {
1458 0         0 our $_ERROR;
1459 0         0 return $_ERROR;
1460             }
1461             }
1462              
1463             sub _uniq {
1464 1414     1414   5673 my %seen;
1465             my @data;
1466 1414         2692 foreach (@_) {
1467 928 100       3102 push(@data, $_) unless ($seen{ $_ }++);
1468             }
1469 1414         24304 return @data;
1470             }
1471              
1472             =begin private
1473              
1474             =item C<set_error ( $error )>
1475              
1476             Sets the object's error variable.
1477              
1478             =end private
1479              
1480             =cut
1481              
1482             sub set_error {
1483 2     2 1 5 my $self = shift;
1484 2         5 my $error = shift;
1485 2         3 my $e = shift;
1486 2 50       9 if (blessed($self)) {
1487 0         0 $self->{error} = $error;
1488 0         0 $self->{exception} = $e;
1489             }
1490 2         6 our $_ERROR = $error;
1491 2         4 our $_EXCEPTION = $e;
1492             }
1493              
1494             =begin private
1495              
1496             =item C<clear_error ()>
1497              
1498             Clears the object's error variable.
1499              
1500             =end private
1501              
1502             =cut
1503              
1504             sub clear_error {
1505 207     207 1 485 my $self = shift;
1506 207 50       1075 if (blessed($self)) {
1507 0         0 $self->{error} = undef;
1508 0         0 $self->{exception} = undef;
1509             }
1510 207         382 our($_ERROR, $_EXCEPTION);
1511 207         494 undef $_ERROR;
1512 207         512 undef $_EXCEPTION;
1513             }
1514              
1515              
1516             # =begin private
1517             #
1518             # =item C<_debug_closure ( $code )>
1519             #
1520             # Debugging function to print out a deparsed (textual) version of a closure.
1521             #
1522             # =end private
1523             #
1524             # =cut
1525             #
1526             # sub _debug_closure {
1527             # my $closure = shift;
1528             # my $l = Log::Log4perl->get_logger("rdf.query");
1529             # if ($l->is_trace) {
1530             # require B::Deparse;
1531             # my $deparse = B::Deparse->new("-p", "-sC");
1532             # my $body = $deparse->coderef2text($closure);
1533             # $l->trace("--- --- CLOSURE --- ---");
1534             # $l->logcluck($body);
1535             # }
1536             # }
1537              
1538              
1539             1;
1540              
1541             __END__
1542              
1543             =back
1544              
1545             =head1 DEFINED HOOKS
1546              
1547             The following hook URIs are defined and may be used to extend the query engine
1548             functionality using the C<< add_hook >> method:
1549              
1550             =over 4
1551              
1552             =item http://kasei.us/code/rdf-query/hooks/post-create-model
1553              
1554             Called after loading all external files to a temporary model in queries that
1555             use FROM and FROM NAMED.
1556              
1557             Args: ( $query, $model )
1558              
1559             C<$query> is the RDF::Query object.
1560             C<$model> is the RDF::Trine::Model object.
1561              
1562             =item http://kasei.us/code/rdf-query/hooks/post-execute
1563              
1564             Called immediately before returning a result iterator from the execute method.
1565              
1566             Args: ( $query, $model, $iterator )
1567              
1568             C<$query> is the RDF::Query object.
1569             C<$model> is the RDF::Trine::Model object.
1570             C<$iterator> is a RDF::Trine::Iterator object.
1571              
1572             =back
1573              
1574             =head1 SEE ALSO
1575              
1576             L<http://www.perlrdf.org/>
1577              
1578             =head1 AUTHOR
1579              
1580             Gregory Todd Williams <gwilliams@cpan.org>
1581              
1582             =head1 LICENSE
1583              
1584             Copyright (c) 2005-2012 Gregory Todd Williams. This
1585             program is free software; you can redistribute it and/or modify it under
1586             the same terms as Perl itself.
1587              
1588             =cut