File Coverage

blib/lib/RDF/Query/Parser/SPARQL11.pm
Criterion Covered Total %
statement 1533 2393 64.0
branch 387 694 55.7
condition 56 146 38.3
subroutine 157 194 80.9
pod 5 5 100.0
total 2138 3432 62.3


line stmt bran cond sub pod time code
1             # RDF::Query::Parser::SPARQL11
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Parser::SPARQL11 - SPARQL 1.1 Parser.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Parser::SPARQL11 version 2.916.
11              
12             =head1 SYNOPSIS
13              
14             use RDF::Query::Parser::SPARQL11;
15             my $parser = RDF::Query::Parser::SPARQL11->new();
16             my $iterator = $parser->parse( $query, $base_uri );
17              
18             =head1 DESCRIPTION
19              
20             ...
21              
22             =head1 METHODS
23              
24             Beyond the methods documented below, this class inherits methods from the
25             L<RDF::Query::Parser> class.
26              
27             =over 4
28              
29             =cut
30              
31             package RDF::Query::Parser::SPARQL11;
32              
33 35     35   200 use strict;
  35         82  
  35         2917  
34 35     35   204 use warnings;
  35         76  
  35         1069  
35 35     35   207 no warnings 'redefine';
  35         83  
  35         1633  
36 35     35   213 use base qw(RDF::Query::Parser);
  35         84  
  35         2753  
37              
38 35     35   215 use URI;
  35         86  
  35         863  
39 35     35   189 use Data::Dumper;
  35         80  
  35         1870  
40 35     35   196 use RDF::Query::Error qw(:try);
  35         82  
  35         263  
41 35     35   4763 use RDF::Query::Parser;
  35         78  
  35         754  
42 35     35   177 use RDF::Query::Algebra;
  35         78  
  35         1429  
43 35     35   206 use RDF::Trine::Namespace qw(rdf);
  35         84  
  35         429  
44 35     35   3342 use Scalar::Util qw(blessed looks_like_number reftype);
  35         88  
  35         2871  
45              
46             ######################################################################
47              
48             our ($VERSION);
49             BEGIN {
50 35     35   1027805 $VERSION = '2.916';
51             }
52              
53             ######################################################################
54              
55             my $rdf = RDF::Trine::Namespace->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#');
56             my $xsd = RDF::Trine::Namespace->new('http://www.w3.org/2001/XMLSchema#');
57              
58             our $r_ECHAR = qr/\\([tbnrf\\"'])/o;
59             our $r_STRING_LITERAL1 = qr/'(([^\x{27}\x{5C}\x{0A}\x{0D}])|${r_ECHAR})*'/o;
60             our $r_STRING_LITERAL2 = qr/"(([^\x{22}\x{5C}\x{0A}\x{0D}])|${r_ECHAR})*"/o;
61             our $r_STRING_LITERAL_LONG1 = qr/'''(('|'')?([^'\\]|${r_ECHAR}))*'''/o;
62             our $r_STRING_LITERAL_LONG2 = qr/"""(("|"")?([^"\\]|${r_ECHAR}))*"""/o;
63             our $r_LANGTAG = qr/@[a-zA-Z]+(-[a-zA-Z0-9]+)*/o;
64             our $r_IRI_REF = qr/<([^<>"{}|^`\\\x{00}-\x{20}])*>/o;
65             our $r_PN_CHARS_BASE = qr/([A-Z]|[a-z]|[\x{00C0}-\x{00D6}]|[\x{00D8}-\x{00F6}]|[\x{00F8}-\x{02FF}]|[\x{0370}-\x{037D}]|[\x{037F}-\x{1FFF}]|[\x{200C}-\x{200D}]|[\x{2070}-\x{218F}]|[\x{2C00}-\x{2FEF}]|[\x{3001}-\x{D7FF}]|[\x{F900}-\x{FDCF}]|[\x{FDF0}-\x{FFFD}]|[\x{10000}-\x{EFFFF}])/o;
66             our $r_PN_CHARS_U = qr/([_]|${r_PN_CHARS_BASE})/o;
67             our $r_VARNAME = qr/((${r_PN_CHARS_U}|[0-9])(${r_PN_CHARS_U}|[0-9]|\x{00B7}|[\x{0300}-\x{036F}]|[\x{203F}-\x{2040}])*)/o;
68             our $r_VAR1 = qr/[?]${r_VARNAME}/o;
69             our $r_VAR2 = qr/[\$]${r_VARNAME}/o;
70             our $r_PN_CHARS = qr/${r_PN_CHARS_U}|-|[0-9]|\x{00B7}|[\x{0300}-\x{036F}]|[\x{203F}-\x{2040}]/o;
71             our $r_PN_PREFIX = qr/(${r_PN_CHARS_BASE}((${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o;
72             our $r_PN_LOCAL_ESCAPED = qr{(\\([-~.!&'()*+,;=/?#@%_\$]))|%[0-9A-Fa-f]{2}}o;
73             our $r_PN_LOCAL = qr/((${r_PN_CHARS_U}|[:0-9]|${r_PN_LOCAL_ESCAPED})((${r_PN_CHARS}|${r_PN_LOCAL_ESCAPED}|[:.])*(${r_PN_CHARS}|[:]|${r_PN_LOCAL_ESCAPED}))?)/o;
74             our $r_PN_LOCAL_BNODE = qr/((${r_PN_CHARS_U}|[0-9])((${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o;
75             our $r_PNAME_NS = qr/((${r_PN_PREFIX})?:)/o;
76             our $r_PNAME_LN = qr/(${r_PNAME_NS}${r_PN_LOCAL})/o;
77             our $r_EXPONENT = qr/[eE][-+]?\d+/o;
78             our $r_DOUBLE = qr/\d+[.]\d*${r_EXPONENT}|[.]\d+${r_EXPONENT}|\d+${r_EXPONENT}/o;
79             our $r_DECIMAL = qr/(\d+[.]\d*)|([.]\d+)/o;
80             our $r_INTEGER = qr/\d+/o;
81             our $r_BLANK_NODE_LABEL = qr/_:${r_PN_LOCAL_BNODE}/o;
82             our $r_ANON = qr/\[[\t\r\n ]*\]/o;
83             our $r_NIL = qr/\([\n\r\t ]*\)/o;
84             our $r_AGGREGATE_CALL = qr/(MIN|MAX|COUNT|AVG|SUM|SAMPLE|GROUP_CONCAT)\b/io;
85              
86             =item C<< new >>
87              
88             Returns a new SPARQL 1.1 parser object.
89              
90             =cut
91              
92             sub new {
93 101     101 1 210 my $class = shift;
94 101         229 my %args = @_;
95 101         622 my $self = bless({
96             args => \%args,
97             bindings => {},
98             bnode_id => 0,
99             }, $class);
100 101         346 return $self;
101             }
102              
103             ################################################################################
104              
105             =item C<< parse ( $query, $base_uri, $update_flag ) >>
106              
107             Parses the C<< $query >>, using the given C<< $base_uri >>.
108             If C<< $update_flag >> is true, the query will be parsed allowing
109             SPARQL 1.1 Update statements.
110              
111             =cut
112              
113             sub parse {
114 101     101 1 183 my $self = shift;
115 101         208 my $input = shift;
116              
117 101 50       334 unless (defined($input)) {
118 0         0 $self->{build} = undef;
119 0         0 $self->{error} = "No query string found to parse";
120 0         0 return;
121             }
122              
123 101         208 my $baseuri = shift;
124 101   100     503 my $update = shift || 0;
125              
126 101         277 $input =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/ge;
  0         0  
127 101         264 $input =~ s/\\U([0-9A-Fa-f]{8})/chr(hex($1))/ge;
  0         0  
128              
129 101         322 delete $self->{error};
130 101         354 local($self->{namespaces}) = {};
131 101         295 local($self->{blank_ids}) = 1;
132 101         314 local($self->{baseURI}) = $baseuri;
133 101         334 local($self->{tokens}) = $input;
134 101         469 local($self->{stack}) = [];
135 101         319 local($self->{filters}) = [];
136 101         293 local($self->{pattern_container_stack}) = [];
137 101         277 local($self->{update}) = $update;
138 101         408 my $triples = $self->_push_pattern_container();
139 101         251 local($self->{build});
140 101         380 my $build = { sources => [], triples => $triples };
141 101         219 $self->{build} = $build;
142 101 50       301 if ($baseuri) {
143 0         0 $self->{build}{base} = $baseuri;
144             }
145              
146             try {
147 101     101   3791 $self->_RW_Query();
148             } catch RDF::Query::Error with {
149 0     0   0 my $e = shift;
150 0         0 $self->{build} = undef;
151 0         0 $build = undef;
152 0         0 $self->{error} = $e->stacktrace
153             } otherwise {
154 0     0   0 my $e = shift;
155 0         0 $self->{build} = undef;
156 0         0 $build = undef;
157 0         0 $self->{error} = $e->stacktrace
158 101         1106 };
159            
160 101         2436 delete $self->{build}{star};
161            
162 101         188 my $data = $build;
163             # $data->{triples} = $self->_pop_pattern_container();
164 101         921 return $data;
165             }
166              
167             =item C<< parse_pattern ( $pattern, $base_uri, \%namespaces ) >>
168              
169             Parses the C<< $pattern >>, using the given C<< $base_uri >> and returns a
170             RDF::Query::Algebra pattern.
171              
172             =cut
173              
174             sub parse_pattern {
175 0     0 1 0 my $self = shift;
176 0         0 my $input = shift;
177 0         0 my $baseuri = shift;
178 0         0 my $ns = shift;
179              
180 0         0 $input =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/ge;
  0         0  
181 0         0 $input =~ s/\\U([0-9A-Fa-f]{8})/chr(hex($1))/ge;
  0         0  
182              
183 0         0 delete $self->{error};
184 0         0 local($self->{namespaces}) = $ns;
185 0         0 local($self->{blank_ids}) = 1;
186 0         0 local($self->{baseURI}) = $baseuri;
187 0         0 local($self->{tokens}) = $input;
188 0         0 local($self->{stack}) = [];
189 0         0 local($self->{filters}) = [];
190 0         0 local($self->{pattern_container_stack}) = [];
191 0         0 my $triples = $self->_push_pattern_container();
192 0         0 $self->{build} = { sources => [], triples => $triples };
193 0 0       0 if ($baseuri) {
194 0         0 $self->{build}{base} = $baseuri;
195             }
196              
197             try {
198 0     0   0 $self->_GroupGraphPattern();
199             } catch RDF::Query::Error with {
200 0     0   0 my $e = shift;
201 0         0 $self->{build} = undef;
202 0         0 $self->{error} = $e->text;
203 0         0 };
204 0         0 my $data = delete $self->{build};
205              
206 0         0 return $data->{triples}[0];
207             }
208              
209             =item C<< parse_expr ( $pattern, $base_uri, \%namespaces ) >>
210              
211             Parses the C<< $pattern >>, using the given C<< $base_uri >> and returns a
212             RDF::Query::Expression pattern.
213              
214             =cut
215              
216             sub parse_expr {
217 0     0 1 0 my $self = shift;
218 0         0 my $input = shift;
219 0         0 my $baseuri = shift;
220 0         0 my $ns = shift;
221              
222 0         0 $input =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/ge;
  0         0  
223 0         0 $input =~ s/\\U([0-9A-Fa-f]{8})/chr(hex($1))/ge;
  0         0  
224              
225 0         0 delete $self->{error};
226 0         0 local($self->{namespaces}) = $ns;
227 0         0 local($self->{blank_ids}) = 1;
228 0         0 local($self->{baseURI}) = $baseuri;
229 0         0 local($self->{tokens}) = $input;
230 0         0 local($self->{stack}) = [];
231 0         0 local($self->{filters}) = [];
232 0         0 local($self->{pattern_container_stack}) = [];
233 0         0 my $triples = $self->_push_pattern_container();
234 0         0 $self->{build} = { sources => [], triples => $triples };
235 0 0       0 if ($baseuri) {
236 0         0 $self->{build}{base} = $baseuri;
237             }
238              
239             try {
240 0     0   0 $self->_Expression();
241             } catch RDF::Query::Error with {
242 0     0   0 my $e = shift;
243 0         0 $self->{build} = undef;
244 0         0 $self->{error} = $e->text;
245 0         0 };
246              
247 0         0 my $data = splice(@{ $self->{stack} });
  0         0  
248 0         0 return $data;
249             }
250              
251             ################################################################################
252              
253              
254             # [1] Query ::= Prologue ( SelectQuery | ConstructQuery | DescribeQuery | AskQuery | LoadUpdate )
255             sub _RW_Query {
256 101     101   181 my $self = shift;
257 101         379 $self->__consume_ws_opt;
258 101         405 $self->_Prologue;
259 101         275 $self->__consume_ws_opt;
260              
261 101         171 my $read_query = 0;
262 101         176 while (1) {
263 102 100       487 if ($self->_test(qr/SELECT/i)) {
    100          
    100          
    100          
    50          
    50          
    100          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
264 84         365 $self->_SelectQuery();
265 84         153 $read_query++;
266             } elsif ($self->_test(qr/CONSTRUCT/i)) {
267 2         9 $self->_ConstructQuery();
268 2         5 $read_query++;
269             } elsif ($self->_test(qr/DESCRIBE/i)) {
270 2         8 $self->_DescribeQuery();
271 2         3 $read_query++;
272             } elsif ($self->_test(qr/ASK/i)) {
273 2         10 $self->_AskQuery();
274 2         3 $read_query++;
275             } elsif ($self->_test(qr/CREATE\s+(SILENT\s+)?GRAPH/i)) {
276             throw RDF::Query::Error::PermissionError -text => "CREATE GRAPH update forbidden in read-only queries"
277 0 0       0 unless ($self->{update});
278 0         0 $self->_CreateGraph();
279             } elsif ($self->_test(qr/DROP\s+(SILENT\s+)?/i)) {
280             throw RDF::Query::Error::PermissionError -text => "DROP GRAPH update forbidden in read-only queries"
281 0 0       0 unless ($self->{update});
282 0         0 $self->_DropGraph();
283             } elsif ($self->_test(qr/LOAD\s+(SILENT\s+)?/i)) {
284             throw RDF::Query::Error::PermissionError -text => "LOAD update forbidden in read-only queries"
285 2 50       8 unless ($self->{update});
286 2         8 $self->_LoadUpdate();
287             } elsif ($self->_test(qr/CLEAR\s+(SILENT\s+)?/i)) {
288             throw RDF::Query::Error::PermissionError -text => "CLEAR GRAPH update forbidden in read-only queries"
289 0 0       0 unless ($self->{update});
290 0         0 $self->_ClearGraphUpdate();
291             } elsif ($self->_test(qr/(WITH|INSERT|DELETE)/i)) {
292             throw RDF::Query::Error::PermissionError -text => "INSERT/DELETE update forbidden in read-only queries"
293 10 50       38 unless ($self->{update});
294 10         16 my ($graph);
295 10 100       47 if ($self->_test(qr/WITH/)) {
296 1         4 $self->{build}{custom_update_dataset} = 1;
297 1         7 $self->_eat(qr/WITH/i);
298 1         5 $self->__consume_ws_opt;
299 1         5 $self->_IRIref;
300 1         3 ($graph) = splice( @{ $self->{stack} } );
  1         4  
301 1         4 $self->__consume_ws_opt;
302             }
303 10 100       57 if ($self->_test(qr/INSERT/ims)) {
    50          
304 6         30 $self->_eat(qr/INSERT/i);
305 6         25 $self->__consume_ws_opt;
306 6 50       31 if ($self->_test(qr/DATA/i)) {
307             throw RDF::Query::Error::PermissionError -text => "INSERT DATA update forbidden in read-only queries"
308 6 50       24 unless ($self->{update});
309 6         28 $self->_eat(qr/DATA/i);
310 6         22 $self->__consume_ws_opt;
311 6         61 $self->_InsertDataUpdate();
312             } else {
313 0         0 $self->_InsertUpdate($graph);
314             }
315             } elsif ($self->_test(qr/DELETE/ims)) {
316 4         22 $self->_eat(qr/DELETE/i);
317 4         18 $self->__consume_ws_opt;
318 4 50       17 if ($self->_test(qr/DATA/i)) {
319             throw RDF::Query::Error::PermissionError -text => "DELETE DATA update forbidden in read-only queries"
320 0 0       0 unless ($self->{update});
321 0         0 $self->_eat(qr/DATA/i);
322 0         0 $self->__consume_ws_opt;
323 0         0 $self->_DeleteDataUpdate();
324             } else {
325 4         17 $self->_DeleteUpdate($graph);
326             }
327             }
328             } elsif ($self->_test(qr/COPY/i)) {
329 0         0 $self->_CopyUpdate();
330             } elsif ($self->_test(qr/MOVE/i)) {
331 0         0 $self->_MoveUpdate();
332             } elsif ($self->_test(qr/ADD/i)) {
333 0         0 $self->_AddUpdate();
334             } elsif ($self->_test(qr/;/)) {
335 0         0 $self->_eat(qr/;/) ;
336 0         0 $self->__consume_ws_opt;
337 0 0       0 next if ($self->_Query_test);
338 0         0 last;
339             } elsif ($self->{tokens} eq '') {
340 0         0 last;
341             } else {
342 0         0 my $l = Log::Log4perl->get_logger("rdf.query");
343 0 0       0 if ($l->is_debug) {
344 0         0 $l->logcluck("Syntax error: Expected query type with input <<$self->{tokens}>>");
345             }
346 0         0 throw RDF::Query::Error::ParseError -text => 'Syntax error: Expected query type';
347             }
348              
349 102 100       552 last if ($read_query);
350 12         38 $self->__consume_ws_opt;
351 12 100       53 if ($self->_test(qr/;/)) {
352 1         9 $self->_eat(qr/;/) ;
353 1         5 $self->__consume_ws_opt;
354 1 50       5 if ($self->_Query_test) {
355 1         7 next;
356             }
357             }
358 11         42 last;
359             }
360             # $self->_eat(qr/;/) if ($self->_test(qr/;/));
361 101         530 $self->__consume_ws_opt;
362              
363 101         155 my $count = scalar(@{ $self->{build}{triples} });
  101         288  
364 101         227 my $remaining = $self->{tokens};
365 101 50       320 if ($remaining =~ m/\S/) {
366 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Remaining input after query: $remaining";
367             }
368              
369 101 100 66     855 if ($count == 0 or $count > 1) {
370 1         3 my @patterns = splice(@{ $self->{build}{triples} });
  1         4  
371 1         12 my $pattern = RDF::Query::Algebra::Sequence->new( @patterns );
372 1         6 $pattern->check_duplicate_blanks;
373 1         6 $self->{build}{triples} = [ $pattern ];
374             }
375              
376             # my %query = (%p, %body);
377             # return \%query;
378             }
379              
380             sub _Query_test {
381 1     1   2 my $self = shift;
382 1 50       5 return 1 if ($self->_test(qr/SELECT|CONSTRUCT|DESCRIBE|ASK|LOAD|CLEAR|DROP|ADD|MOVE|COPY|CREATE|INSERT|DELETE|WITH/i));
383 0         0 return 0;
384             }
385              
386             # [2] Prologue ::= BaseDecl? PrefixDecl*
387             # [3] BaseDecl ::= 'BASE' IRI_REF
388             # [4] PrefixDecl ::= 'PREFIX' PNAME_NS IRI_REF
389             sub _Prologue {
390 101     101   193 my $self = shift;
391              
392 101         179 my $base;
393             my @base;
394 101 100       499 if ($self->_test( qr/BASE/i )) {
395 2         14 $self->_eat( qr/BASE/i );
396 2         9 $self->__consume_ws_opt;
397 2         8 my $iriref = $self->_eat( $r_IRI_REF );
398 2         9 my $iri = substr($iriref,1,length($iriref)-2);
399 2         12 $base = RDF::Query::Node::Resource->new( $iri );
400 2         35 @base = $base;
401 2         8 $self->__consume_ws_opt;
402 2         7 $self->{base} = $base;
403             }
404              
405 101         254 my %namespaces;
406 101         517 while ($self->_test( qr/PREFIX/i )) {
407 126         655 $self->_eat( qr/PREFIX/i );
408 126         417 $self->__consume_ws_opt;
409 126         352 my $prefix = $self->_eat( $r_PNAME_NS );
410 126         1348 my $ns = substr($prefix, 0, length($prefix) - 1);
411 126 100       377 if ($ns eq '') {
412 6         16 $ns = '__DEFAULT__';
413             }
414 126         358 $self->__consume_ws_opt;
415 126         366 my $iriref = $self->_eat( $r_IRI_REF );
416 126         398 my $iri = substr($iriref,1,length($iriref)-2);
417 126 100       476 if (@base) {
418 1         6 my $r = RDF::Query::Node::Resource->new( $iri, @base );
419 1         9844 $iri = $r->uri_value;
420             }
421 126         430 $self->__consume_ws_opt;
422 126         391 $namespaces{ $ns } = $iri;
423 126         632 $self->{namespaces}{$ns} = $iri;
424             }
425              
426 101         398 $self->{build}{namespaces} = \%namespaces;
427 101 100       434 $self->{build}{base} = $base if (defined($base));
428              
429             # push(@data, (base => $base)) if (defined($base));
430             # return @data;
431             }
432              
433             sub _InsertDataUpdate {
434 6     6   16 my $self = shift;
435 6         20 $self->_eat('{');
436 6         15 $self->__consume_ws_opt;
437 6         22 local($self->{__data_pattern}) = 1;
438 6         27 $self->_ModifyTemplate();
439 6         22 $self->__consume_ws_opt;
440 6         18 my $data = $self->_remove_pattern;
441 6         19 $self->_eat('}');
442 6         16 $self->__consume_ws_opt;
443            
444 6         26 my $empty = RDF::Query::Algebra::GroupGraphPattern->new();
445 6         51 my $insert = RDF::Query::Algebra::Update->new(undef, $data, $empty, undef, 1);
446 6         17 $self->_add_patterns( $insert );
447 6         31 $self->{build}{method} = 'UPDATE';
448             }
449              
450             sub _DeleteDataUpdate {
451 0     0   0 my $self = shift;
452 0         0 $self->_eat('{');
453 0         0 $self->__consume_ws_opt;
454 0         0 local($self->{__data_pattern}) = 1;
455 0         0 local($self->{__no_bnodes}) = "DELETE DATA block";
456 0         0 $self->_ModifyTemplate();
457 0         0 $self->__consume_ws_opt;
458 0         0 my $data = $self->_remove_pattern;
459 0         0 $self->_eat('}');
460 0         0 $self->__consume_ws_opt;
461            
462 0         0 my $empty = RDF::Query::Algebra::GroupGraphPattern->new();
463 0         0 my $delete = RDF::Query::Algebra::Update->new($data, undef, $empty, undef, 1);
464 0         0 $self->_add_patterns( $delete );
465 0         0 $self->{build}{method} = 'UPDATE';
466             }
467              
468             sub _InsertUpdate {
469 0     0   0 my $self = shift;
470 0         0 my $graph = shift;
471 0         0 $self->_eat('{');
472 0         0 $self->__consume_ws_opt;
473 0         0 $self->_ModifyTemplate();
474 0         0 $self->__consume_ws_opt;
475 0         0 my $data = $self->_remove_pattern;
476 0         0 $self->_eat('}');
477 0         0 $self->__consume_ws_opt;
478 0 0       0 if ($graph) {
479 0         0 $data = RDF::Query::Algebra::NamedGraph->new( $graph, $data );
480             }
481              
482              
483 0         0 my %dataset;
484 0         0 while ($self->_test(qr/USING/i)) {
485 0         0 $self->{build}{custom_update_dataset} = 1;
486 0         0 $self->_eat(qr/USING/i);
487 0         0 $self->__consume_ws_opt;
488 0         0 my $named = 0;
489 0 0       0 if ($self->_test(qr/NAMED/i)) {
490 0         0 $self->_eat(qr/NAMED/i);
491 0         0 $self->__consume_ws_opt;
492 0         0 $named = 1;
493             }
494 0         0 $self->_IRIref;
495 0         0 my ($iri) = splice( @{ $self->{stack} } );
  0         0  
496 0 0       0 if ($named) {
497 0         0 $dataset{named}{$iri->uri_value} = $iri;
498             } else {
499 0         0 push(@{ $dataset{default} }, $iri );
  0         0  
500             }
501 0         0 $self->__consume_ws_opt;
502             }
503              
504 0         0 $self->_eat(qr/WHERE/i);
505 0         0 $self->__consume_ws_opt;
506 0 0       0 if ($graph) {
507             # local($self->{named_graph}) = $graph;
508 0         0 $self->_GroupGraphPattern;
509 0         0 my $ggp = $self->_remove_pattern;
510 0         0 $ggp = RDF::Query::Algebra::NamedGraph->new( $graph, $ggp );
511 0         0 $self->_add_patterns( $ggp );
512             } else {
513 0         0 $self->_GroupGraphPattern;
514             }
515              
516 0         0 my $ggp = $self->_remove_pattern;
517              
518 0         0 my @ds_keys = keys %dataset;
519 0 0       0 unless (@ds_keys) {
520 0   0     0 $dataset{ default } = [$graph || ()];
521             }
522            
523 0         0 my $insert = RDF::Query::Algebra::Update->new(undef, $data, $ggp, \%dataset, 0);
524 0         0 $self->_add_patterns( $insert );
525 0         0 $self->{build}{method} = 'UPDATE';
526             }
527              
528             sub _DeleteUpdate {
529 4     4   9 my $self = shift;
530 4         8 my $graph = shift;
531 4         8 my ($delete_data, $insert_data);
532            
533 0         0 my %dataset;
534 4         8 my $delete_where = 0;
535 4 50       20 if ($self->_test(qr/WHERE/i)) {
536 0 0       0 if ($graph) {
537 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: WITH clause cannot be used with DELETE WHERE operations";
538             }
539 0         0 $delete_where = 1;
540             } else {
541             {
542 4         10 local($self->{__no_bnodes}) = "DELETE block";
  4         15  
543 4         12 $self->_eat('{');
544 4         11 $self->__consume_ws_opt;
545 4         18 $self->_ModifyTemplate( $graph );
546 4         12 $self->__consume_ws_opt;
547 4         11 $self->_eat('}');
548             }
549 4         12 $delete_data = $self->_remove_pattern;
550            
551 4         13 $self->__consume_ws_opt;
552 4 50       19 if ($self->_test(qr/INSERT/i)) {
553 4         20 $self->_eat(qr/INSERT/i);
554 4         15 $self->__consume_ws_opt;
555 4         10 $self->_eat('{');
556 4         12 $self->__consume_ws_opt;
557 4         14 $self->_ModifyTemplate( $graph );
558 4         13 $self->__consume_ws_opt;
559 4         11 $self->_eat('}');
560 4         12 $self->__consume_ws_opt;
561 4         11 $insert_data = $self->_remove_pattern;
562             }
563            
564 4         22 while ($self->_test(qr/USING/i)) {
565 1         4 $self->{build}{custom_update_dataset} = 1;
566 1         6 $self->_eat(qr/USING/i);
567 1         4 $self->__consume_ws_opt;
568 1         3 my $named = 0;
569 1 50       5 if ($self->_test(qr/NAMED/i)) {
570 0         0 $self->_eat(qr/NAMED/i);
571 0         0 $self->__consume_ws_opt;
572 0         0 $named = 1;
573             }
574 1         6 $self->_IRIref;
575 1         3 my ($iri) = splice( @{ $self->{stack} } );
  1         4  
576 1 50       20 if ($named) {
577 0         0 $dataset{named}{$iri->uri_value} = $iri;
578             } else {
579 1         2 push(@{ $dataset{default} }, $iri );
  1         4  
580             }
581 1         4 $self->__consume_ws_opt;
582             }
583             }
584            
585 4         24 $self->_eat(qr/WHERE/i);
586 4         13 $self->__consume_ws_opt;
587 4 100       12 if ($graph) {
588             # local($self->{named_graph}) = $graph;
589 1 50       12 $self->{__no_bnodes} = "DELETE WHERE block" if ($delete_where);
590 1         5 $self->_GroupGraphPattern;
591 1         2 delete $self->{__no_bnodes};
592 1         4 my $ggp = $self->_remove_pattern;
593 1         6 $ggp = RDF::Query::Algebra::NamedGraph->new( $graph, $ggp );
594 1         4 $self->_add_patterns( $ggp );
595             } else {
596 3 50       10 $self->{__no_bnodes} = "DELETE WHERE block" if ($delete_where);
597 3         12 $self->_GroupGraphPattern;
598 3         7 delete $self->{__no_bnodes};
599             }
600              
601 4         13 my $ggp = $self->_remove_pattern;
602              
603 4 50       14 if ($delete_where) {
604 0         0 $delete_data = $ggp;
605             }
606            
607 4         14 my @ds_keys = keys %dataset;
608 4 100 66     18 if ($graph and not(scalar(@ds_keys))) {
609 1   33     16 $dataset{ default } = [$graph || ()];
610             }
611            
612 4         41 my $insert = RDF::Query::Algebra::Update->new($delete_data, $insert_data, $ggp, \%dataset, 0);
613 4         13 $self->_add_patterns( $insert );
614 4         21 $self->{build}{method} = 'UPDATE';
615             }
616              
617             sub _ModifyTemplate_test {
618 30     30   51 my $self = shift;
619 30 100       75 return 1 if ($self->_TriplesBlock_test);
620 22 100       252 return 1 if ($self->_test(qr/GRAPH/i));
621 14         61 return 0;
622             }
623              
624             sub _ModifyTemplate {
625 14     14   20 my $self = shift;
626 14         25 my $graph = shift;
627            
628 14         35 local($self->{named_graph});
629 14 100       39 if ($graph) {
630 2         21 $self->{named_graph} = $graph;
631             }
632            
633             # $self->__ModifyTemplate;
634             # $self->__consume_ws_opt;
635             # my $data = $self->_remove_pattern;
636             # $data = RDF::Query::Algebra::GroupGraphPattern->new( $data ) unless ($data->isa('RDF::Query::Algebra::GroupGraphPattern'));
637 14         24 my $data;
638 14         47 while ($self->_ModifyTemplate_test) {
639 16         158 $self->__ModifyTemplate( $graph );
640 16         168 $self->__consume_ws_opt;
641 16         47 my $d = $self->_remove_pattern;
642 16 100       72 my @patterns = blessed($data) ? $data->patterns : ();
643 16         81 $data = RDF::Query::Algebra::GroupGraphPattern->new( @patterns, $d );
644             }
645 14 50       66 $data = RDF::Query::Algebra::GroupGraphPattern->new() unless (blessed($data));
646 14 50       81 $data = RDF::Query::Algebra::GroupGraphPattern->new( $data ) unless ($data->isa('RDF::Query::Algebra::GroupGraphPattern'));
647 14         39 $self->_add_patterns( $data );
648             }
649              
650             sub __ModifyTemplate {
651 16     16   29 my $self = shift;
652 16         28 my $graph = shift;
653 16         49 local($self->{_modify_template}) = 1;
654 16 100       41 if ($self->_TriplesBlock_test) {
655 8         17 my $data;
656 8         24 $self->_push_pattern_container;
657 8         30 $self->_TriplesBlock;
658 8         15 ($data) = @{ $self->_pop_pattern_container };
  8         23  
659 8 100       33 if ($graph) {
660 2         24 my $ggp = RDF::Query::Algebra::GroupGraphPattern->new( $data );
661 2         11 my $data = RDF::Query::Algebra::NamedGraph->new( $graph, $ggp );
662             }
663 8         25 $self->_add_patterns( $data );
664             } else {
665 8         34 $self->_GraphGraphPattern;
666            
667             {
668 8         16 my (@d) = splice(@{ $self->{stack} });
  8         13  
  8         21  
669 8         30 $self->__handle_GraphPatternNotTriples( @d );
670             }
671             }
672             }
673              
674             sub _LoadUpdate {
675 2     2   5 my $self = shift;
676 2         9 my $op = $self->_eat(qr/LOAD\s+(SILENT\s+)?/i);
677 2         5 my $silent = ($op =~ /SILENT/);
678 2         7 $self->__consume_ws_opt;
679 2         7 $self->_IRIref;
680 2         4 my ($iri) = splice( @{ $self->{stack} } );
  2         5  
681 2         7 $self->__consume_ws_opt;
682 2 100       9 if ($self->_test(qr/INTO GRAPH/i)) {
683 1         6 $self->_eat(qr/INTO GRAPH/i);
684 1         4 $self->_ws;
685 1         4 $self->_IRIref;
686 1         3 my ($graph) = splice( @{ $self->{stack} } );
  1         3  
687 1         13 my $pat = RDF::Query::Algebra::Load->new( $iri, $graph, $silent );
688 1         4 $self->_add_patterns( $pat );
689             } else {
690 1         6 my $pat = RDF::Query::Algebra::Load->new( $iri, undef, $silent );
691 1         5 $self->_add_patterns( $pat );
692             }
693 2         10 $self->{build}{method} = 'LOAD';
694             }
695              
696             sub _CreateGraph {
697 0     0   0 my $self = shift;
698 0         0 my $op = $self->_eat(qr/CREATE\s+(SILENT\s+)?GRAPH/i);
699 0         0 my $silent = ($op =~ /SILENT/i);
700 0         0 $self->_ws;
701 0         0 $self->_IRIref;
702 0         0 my ($graph) = splice( @{ $self->{stack} } );
  0         0  
703 0         0 my $pat = RDF::Query::Algebra::Create->new( $graph );
704 0         0 $self->_add_patterns( $pat );
705 0         0 $self->{build}{method} = 'CREATE';
706             }
707              
708             sub _ClearGraphUpdate {
709 0     0   0 my $self = shift;
710 0         0 my $op = $self->_eat(qr/CLEAR(\s+SILENT)?/i);
711 0         0 my $silent = ($op =~ /SILENT/i);
712 0         0 $self->_ws;
713 0 0       0 if ($self->_test(qr/GRAPH/i)) {
    0          
    0          
    0          
714 0         0 $self->_eat(qr/GRAPH/i);
715 0         0 $self->_ws;
716 0         0 $self->_IRIref;
717 0         0 my ($graph) = splice( @{ $self->{stack} } );
  0         0  
718 0         0 my $pat = RDF::Query::Algebra::Clear->new( $graph );
719 0         0 $self->_add_patterns( $pat );
720             } elsif ($self->_test(qr/DEFAULT/i)) {
721 0         0 $self->_eat(qr/DEFAULT/i);
722 0         0 my $pat = RDF::Query::Algebra::Clear->new( RDF::Trine::Node::Nil->new );
723 0         0 $self->_add_patterns( $pat );
724             } elsif ($self->_test(qr/NAMED/i)) {
725 0         0 $self->_eat(qr/NAMED/i);
726 0         0 my $pat = RDF::Query::Algebra::Clear->new( RDF::Query::Node::Resource->new('tag:gwilliams@cpan.org,2010-01-01:RT:NAMED') );
727 0         0 $self->_add_patterns( $pat );
728             } elsif ($self->_test(qr/ALL/i)) {
729 0         0 $self->_eat(qr/ALL/i);
730 0         0 my $pat = RDF::Query::Algebra::Clear->new( RDF::Query::Node::Resource->new('tag:gwilliams@cpan.org,2010-01-01:RT:ALL') );
731 0         0 $self->_add_patterns( $pat );
732             }
733 0         0 $self->{build}{method} = 'CLEAR';
734             }
735              
736             sub _DropGraph {
737 0     0   0 my $self = shift;
738 0         0 my $op = $self->_eat(qr/DROP(\s+SILENT)?/i);
739 0         0 my $silent = ($op =~ /SILENT/i);
740 0         0 $self->_ws;
741 0 0       0 if ($self->_test(qr/GRAPH/i)) {
    0          
    0          
    0          
742 0         0 $self->_eat(qr/GRAPH/i);
743 0         0 $self->_ws;
744 0         0 $self->_IRIref;
745 0         0 my ($graph) = splice( @{ $self->{stack} } );
  0         0  
746 0         0 my $pat = RDF::Query::Algebra::Clear->new( $graph );
747 0         0 $self->_add_patterns( $pat );
748             } elsif ($self->_test(qr/DEFAULT/i)) {
749 0         0 $self->_eat(qr/DEFAULT/i);
750 0         0 my $pat = RDF::Query::Algebra::Clear->new( RDF::Trine::Node::Nil->new );
751 0         0 $self->_add_patterns( $pat );
752             } elsif ($self->_test(qr/NAMED/i)) {
753 0         0 $self->_eat(qr/NAMED/i);
754 0         0 my $pat = RDF::Query::Algebra::Clear->new( RDF::Query::Node::Resource->new('tag:gwilliams@cpan.org,2010-01-01:RT:NAMED') );
755 0         0 $self->_add_patterns( $pat );
756             } elsif ($self->_test(qr/ALL/i)) {
757 0         0 $self->_eat(qr/ALL/i);
758 0         0 my $pat = RDF::Query::Algebra::Clear->new( RDF::Query::Node::Resource->new('tag:gwilliams@cpan.org,2010-01-01:RT:ALL') );
759 0         0 $self->_add_patterns( $pat );
760             }
761 0         0 $self->{build}{method} = 'CLEAR';
762             }
763              
764             sub __graph {
765 0     0   0 my $self = shift;
766 0 0       0 if ($self->_test(qr/DEFAULT/i)) {
767 0         0 $self->_eat(qr/DEFAULT/i);
768 0         0 return RDF::Trine::Node::Nil->new();
769             } else {
770 0 0       0 if ($self->_test(qr/GRAPH/)) {
771 0         0 $self->_eat(qr/GRAPH/i);
772 0         0 $self->__consume_ws_opt;
773             }
774 0         0 $self->_IRIref;
775 0         0 my ($g) = splice( @{ $self->{stack} } );
  0         0  
776 0         0 return $g;
777             }
778             }
779              
780             sub _CopyUpdate {
781 0     0   0 my $self = shift;
782 0         0 my $op = $self->_eat(qr/COPY(\s+SILENT)?/i);
783 0         0 my $silent = ($op =~ /SILENT/i);
784 0         0 $self->_ws;
785 0         0 my $from = $self->__graph();
786 0         0 $self->_ws;
787 0         0 $self->_eat(qr/TO/i);
788 0         0 $self->_ws;
789 0         0 my $to = $self->__graph();
790 0         0 my $pattern = RDF::Query::Algebra::Copy->new( $from, $to, $silent );
791 0         0 $self->_add_patterns( $pattern );
792 0         0 $self->{build}{method} = 'UPDATE';
793             }
794              
795             sub _MoveUpdate {
796 0     0   0 my $self = shift;
797 0         0 my $op = $self->_eat(qr/MOVE(\s+SILENT)?/i);
798 0         0 my $silent = ($op =~ /SILENT/i);
799 0         0 $self->_ws;
800 0         0 my $from = $self->__graph();
801 0         0 $self->_ws;
802 0         0 $self->_eat(qr/TO/i);
803 0         0 $self->_ws;
804 0         0 my $to = $self->__graph();
805 0         0 my $pattern = RDF::Query::Algebra::Move->new( $from, $to, $silent );
806 0         0 $self->_add_patterns( $pattern );
807 0         0 $self->{build}{method} = 'UPDATE';
808             }
809              
810             sub _AddUpdate {
811 0     0   0 my $self = shift;
812 0         0 my $op = $self->_eat(qr/ADD(\s+SILENT)?/i);
813 0         0 my $silent = ($op =~ /SILENT/i);
814 0         0 $self->_ws;
815 0         0 return $self->__UpdateShortcuts( 'ADD', $silent );
816             }
817              
818             sub __UpdateShortcuts {
819 0     0   0 my $self = shift;
820 0         0 my $op = shift;
821 0         0 my $silent = shift;
822 0         0 my ($from, $to);
823 0 0       0 if ($self->_test(qr/DEFAULT/i)) {
824 0         0 $self->_eat(qr/DEFAULT/i);
825             } else {
826 0 0       0 if ($self->_test(qr/GRAPH/)) {
827 0         0 $self->_eat(qr/GRAPH/i);
828 0         0 $self->__consume_ws_opt;
829             }
830 0         0 $self->_IRIref;
831 0         0 ($from) = splice( @{ $self->{stack} } );
  0         0  
832             }
833 0         0 $self->_ws;
834 0         0 $self->_eat(qr/TO/i);
835 0         0 $self->_ws;
836 0 0       0 if ($self->_test(qr/DEFAULT/i)) {
837 0         0 $self->_eat(qr/DEFAULT/i);
838             } else {
839 0 0       0 if ($self->_test(qr/GRAPH/)) {
840 0         0 $self->_eat(qr/GRAPH/i);
841 0         0 $self->__consume_ws_opt;
842             }
843 0         0 $self->_IRIref;
844 0         0 ($to) = splice( @{ $self->{stack} } );
  0         0  
845             }
846            
847             my $from_pattern = RDF::Query::Algebra::GroupGraphPattern->new(
848             RDF::Query::Algebra::BasicGraphPattern->new(
849             RDF::Query::Algebra::Triple->new(
850 0         0 map { RDF::Query::Node::Variable->new( $_ ) } qw(s p o)
  0         0  
851             )
852             )
853             );
854 0 0       0 if (defined($from)) {
855 0         0 $from_pattern = RDF::Query::Algebra::NamedGraph->new( $from, $from_pattern );
856             }
857              
858             my $to_pattern = RDF::Query::Algebra::GroupGraphPattern->new(
859             RDF::Query::Algebra::BasicGraphPattern->new(
860             RDF::Query::Algebra::Triple->new(
861 0         0 map { RDF::Query::Node::Variable->new( $_ ) } qw(s p o)
  0         0  
862             )
863             )
864             );
865 0 0       0 if (defined($to)) {
866 0         0 $to_pattern = RDF::Query::Algebra::NamedGraph->new( $to, $to_pattern );
867             }
868            
869 0   0     0 my $to_graph = $to || RDF::Trine::Node::Nil->new;
870 0   0     0 my $from_graph = $from || RDF::Trine::Node::Nil->new;
871 0         0 my $drop_to = RDF::Query::Algebra::Clear->new( $to_graph, $silent );
872 0         0 my $update = RDF::Query::Algebra::Update->new( undef, $to_pattern, $from_pattern, undef, 0 );
873 0         0 my $drop_from = RDF::Query::Algebra::Clear->new( $from_graph );
874 0         0 my $pattern;
875 0 0       0 if ($op eq 'MOVE') {
    0          
876 0         0 $pattern = RDF::Query::Algebra::Sequence->new( $drop_to, $update, $drop_from );
877             } elsif ($op eq 'COPY') {
878 0         0 $pattern = RDF::Query::Algebra::Sequence->new( $drop_to, $update );
879             } else {
880 0         0 $pattern = $update;
881             }
882 0         0 $self->_add_patterns( $pattern );
883 0         0 $self->{build}{method} = 'UPDATE';
884             }
885              
886             # [5] SelectQuery ::= 'SELECT' ( 'DISTINCT' | 'REDUCED' )? ( Var+ | '*' ) DatasetClause* WhereClause SolutionModifier
887             sub _SelectQuery {
888 84     84   146 my $self = shift;
889 84         409 $self->_eat(qr/SELECT/i);
890 84         414 $self->__consume_ws;
891            
892 84 100       468 if ($self->{tokens} =~ m/^(DISTINCT|REDUCED)/i) {
893 2         11 my $mod = $self->_eat( qr/DISTINCT|REDUCED/i );
894 2         10 $self->__consume_ws;
895 2         10 $self->{build}{options}{lc($mod)} = 1;
896             }
897            
898 84         349 my $star = $self->__SelectVars;
899            
900 84         351 $self->_DatasetClause();
901            
902 84         335 $self->__consume_ws_opt;
903 84         359 $self->_WhereClause;
904              
905 84 100       286 if ($star) {
906 25   50     154 my $triples = $self->{build}{triples} || [];
907 25         49 my @vars;
908 25         80 foreach my $t (@$triples) {
909 26         136 my @v = $t->potentially_bound;
910 26         95 push(@vars, @v);
911             }
912 25         88 @vars = RDF::Query::_uniq( @vars );
913 25         56 push( @{ $self->{build}{variables} }, map { $self->new_variable($_) } @vars );
  25         84  
  43         320  
914             }
915              
916 84         367 $self->__consume_ws_opt;
917 84         344 $self->_SolutionModifier();
918            
919 84         364 $self->__consume_ws_opt;
920 84 100       403 if ($self->_test( qr/VALUES/i )) {
921 3         13 $self->_eat( qr/VALUES/i );
922 3         9 $self->__consume_ws_opt;
923 3         8 my @vars;
924             # $self->_Var;
925             # push( @vars, splice(@{ $self->{stack} }));
926             # $self->__consume_ws_opt;
927 3         5 my $parens = 0;
928 3 100       16 if ($self->_test(qr/[(]/)) {
929 2         15 $self->_eat( qr/[(]/ );
930 2         5 $parens = 1;
931             }
932 3         17 while ($self->_test(qr/[\$?]/)) {
933 5         16 $self->_Var;
934 5         12 push( @vars, splice(@{ $self->{stack} }));
  5         12  
935 5         14 $self->__consume_ws_opt;
936             }
937 3 100       12 if ($parens) {
938 2         9 $self->_eat( qr/[)]/ );
939             }
940 3         9 $self->__consume_ws_opt;
941            
942 3         5 my $count = scalar(@vars);
943 3 50 66     28 if (not($parens) and $count == 0) {
    50 66        
944 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Expected VAR in inline data declaration";
945             } elsif (not($parens) and $count > 1) {
946 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Inline data declaration can only have one variable when parens are omitted";
947             }
948            
949 3   66     16 my $short = (not($parens) and $count == 1);
950 3         7 $self->_eat('{');
951 3         7 $self->__consume_ws_opt;
952 3 100 33     20 if (not($short) or ($short and $self->_Binding_test)) {
      66        
953 2         10 while ($self->_Binding_test) {
954 2         9 my $terms = $self->_Binding($count);
955 2         5 push( @{ $self->{build}{bindings}{terms} }, $terms );
  2         9  
956 2         7 $self->__consume_ws_opt;
957             }
958             } else {
959 1         5 while ($self->_BindingValue_test) {
960 2         12 $self->_BindingValue;
961 2         14 $self->__consume_ws_opt;
962 2         3 my ($term) = splice(@{ $self->{stack} });
  2         5  
963 2         4 push( @{ $self->{build}{bindings}{terms} }, [$term] );
  2         9  
964 2         5 $self->__consume_ws_opt;
965             }
966             }
967            
968 3         9 $self->_eat('}');
969 3         10 $self->__consume_ws_opt;
970 3         12 $self->{build}{bindings}{vars} = \@vars;
971             }
972            
973 84         411 $self->__solution_modifiers( $star );
974            
975            
976 84         195 my $pattern = $self->{build}{triples}[0];
977 84         508 my @agg = $pattern->subpatterns_of_type( 'RDF::Query::Algebra::Aggregate', 'RDF::Query::Algebra::SubSelect' );
978 84 100       296 if (@agg) {
979 17         44 my ($agg) = @agg;
980 17         56 my @gvars = $agg->groupby;
981 17 100       69 if (scalar(@gvars) == 0) {
982             # aggregate query with no explicit group keys
983 9         18 foreach my $v (@{ $self->{build}{variables} }) {
  9         31  
984 11 50       72 if ($v->isa('RDF::Query::Node::Variable')) {
985 0         0 my $name = $v->name;
986 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Variable used in projection but not present in aggregate grouping ($name)";
987             }
988             }
989             }
990             }
991            
992 84         252 delete $self->{build}{options};
993 84         310 $self->{build}{method} = 'SELECT';
994             }
995              
996             sub __SelectVars {
997 85     85   164 my $self = shift;
998 85         144 my $star = 0;
999 85         132 my @vars;
1000 85         156 my $count = 0;
1001 85   100     226 while ($self->_test('*') or $self->__SelectVar_test) {
1002 109 100       353 if ($self->_test('*')) {
1003 25         83 $self->{build}{star}++;
1004 25         83 $self->_eat('*');
1005 25         46 $star = 1;
1006 25         74 $self->__consume_ws_opt;
1007 25         70 $count++;
1008             } else {
1009 84         271 $self->__SelectVar;
1010 84         184 push( @vars, splice(@{ $self->{stack} }));
  84         282  
1011 84         227 $self->__consume_ws_opt;
1012 84         252 $count++;
1013             }
1014             }
1015            
1016 85         179 my %seen;
1017 85         248 foreach my $v (@vars) {
1018 84 50 66     715 if ($v->isa('RDF::Query::Node::Variable') or $v->isa('RDF::Query::Expression::Alias')) {
1019 84         361 my $name = $v->name;
1020 84 100       1527 if ($v->isa('RDF::Query::Expression::Alias')) {
1021 29 50       93 if ($seen{ $name }) {
1022 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Repeated variable ($name) used in projection list";
1023             }
1024             }
1025 84         300 $seen{ $name }++;
1026             }
1027             }
1028            
1029 85         262 $self->{build}{variables} = \@vars;
1030 85 50       285 if ($count == 0) {
1031 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: No select variable or expression specified";
1032             }
1033 85         274 return $star;
1034             }
1035              
1036             sub _BrackettedAliasExpression {
1037 29     29   51 my $self = shift;
1038 29         88 $self->_eat('(');
1039 29         71 $self->__consume_ws_opt;
1040 29         115 $self->_Expression;
1041 29         53 my ($expr) = splice(@{ $self->{stack} });
  29         82  
1042 29         87 $self->__consume_ws_opt;
1043 29         132 $self->_eat(qr/AS/i);
1044 29         93 $self->__consume_ws_opt;
1045 29         77 $self->_Var;
1046 29         79 my ($var) = splice(@{ $self->{stack} });
  29         73  
1047 29         104 $self->__consume_ws_opt;
1048 29         99 $self->_eat(')');
1049            
1050 29         172 my $alias = $self->new_alias_expression( $var, $expr );
1051 29         88 $self->_add_stack( $alias );
1052             }
1053              
1054             sub __SelectVar_test {
1055 169     169   249 my $self = shift;
1056 169         479 local($self->{__aggregate_call_ok}) = 1;
1057             # return 1 if $self->_BuiltInCall_test;
1058 169 100       670 return 1 if $self->_test( qr/[(]/i);
1059 140         1125 return $self->{tokens} =~ m'^[?$]';
1060             }
1061              
1062             sub __SelectVar {
1063 84     84   155 my $self = shift;
1064 84         227 local($self->{__aggregate_call_ok}) = 1;
1065 84 100       208 if ($self->_test('(')) {
1066 29         101 $self->_BrackettedAliasExpression;
1067             # } elsif ($self->_BuiltInCall_test) {
1068             # $self->_BuiltInCall;
1069             } else {
1070 55         201 $self->_Var;
1071             }
1072             }
1073              
1074             # [6] ConstructQuery ::= 'CONSTRUCT' ConstructTemplate DatasetClause* WhereClause SolutionModifier
1075             sub _ConstructQuery {
1076 2     2   3 my $self = shift;
1077 2         10 $self->_eat(qr/CONSTRUCT/i);
1078 2         7 $self->__consume_ws_opt;
1079 2         5 my $shortcut = 1;
1080 2 50       8 if ($self->_test( qr/[{]/ )) {
1081 2         3 $shortcut = 0;
1082 2         8 $self->_ConstructTemplate;
1083 2         5 $self->__consume_ws_opt;
1084             }
1085 2         12 $self->_DatasetClause();
1086 2         8 $self->__consume_ws_opt;
1087 2 50       6 if ($shortcut) {
1088 0         0 $self->_TriplesWhereClause;
1089             } else {
1090 2         8 $self->_WhereClause;
1091             }
1092            
1093 2         8 $self->__consume_ws_opt;
1094 2         8 $self->_SolutionModifier();
1095            
1096 2         8 my $pattern = $self->{build}{triples}[0];
1097            
1098 2         5 my $triples = delete $self->{build}{construct_triples};
1099 2         18 my $construct = RDF::Query::Algebra::Construct->new( $pattern, $triples );
1100 2         5 $self->{build}{triples}[0] = $construct;
1101 2         7 $self->{build}{method} = 'CONSTRUCT';
1102             }
1103              
1104             # [7] DescribeQuery ::= 'DESCRIBE' ( VarOrIRIref+ | '*' ) DatasetClause* WhereClause? SolutionModifier
1105             sub _DescribeQuery {
1106 2     2   5 my $self = shift;
1107 2         10 $self->_eat(qr/DESCRIBE/i);
1108 2         7 $self->_ws;
1109            
1110 2 50       19 if ($self->_test('*')) {
1111 0         0 $self->_eat('*');
1112 0         0 $self->{build}{variables} = ['*'];
1113 0         0 $self->__consume_ws_opt;
1114             } else {
1115 2         9 $self->_VarOrIRIref;
1116 2         8 $self->__consume_ws_opt;
1117 2         7 while ($self->_VarOrIRIref_test) {
1118 0         0 $self->_VarOrIRIref;
1119 0         0 $self->__consume_ws_opt;
1120             }
1121 2         68 $self->{build}{variables} = [ splice(@{ $self->{stack} }) ];
  2         9  
1122             }
1123            
1124 2         10 $self->_DatasetClause();
1125            
1126 2         8 $self->__consume_ws_opt;
1127 2 50       8 if ($self->_WhereClause_test) {
1128 2         7 $self->_WhereClause;
1129             } else {
1130 0         0 my $pattern = RDF::Query::Algebra::GroupGraphPattern->new();
1131 0         0 $self->_add_patterns( $pattern );
1132             }
1133            
1134 2         11 $self->__consume_ws_opt;
1135 2         6 $self->_SolutionModifier();
1136 2         8 $self->{build}{method} = 'DESCRIBE';
1137             }
1138              
1139             # [8] AskQuery ::= 'ASK' DatasetClause* WhereClause
1140             sub _AskQuery {
1141 2     2   4 my $self = shift;
1142 2         10 $self->_eat(qr/ASK/i);
1143 2         6 $self->__consume_ws_opt;
1144            
1145 2         7 $self->_DatasetClause();
1146            
1147 2         8 $self->__consume_ws_opt;
1148 2         6 $self->_WhereClause;
1149            
1150 2         8 $self->{build}{variables} = [];
1151 2         7 $self->{build}{method} = 'ASK';
1152             }
1153              
1154             sub _DatasetClause_test {
1155 0     0   0 my $self = shift;
1156 0         0 return $self->_test( qr/FROM/i );
1157             }
1158              
1159             # [9] DatasetClause ::= 'FROM' ( DefaultGraphClause | NamedGraphClause )
1160             sub _DatasetClause {
1161 90     90   160 my $self = shift;
1162            
1163             # my @dataset;
1164 90         250 $self->{build}{sources} = [];
1165 90         447 while ($self->_test( qr/FROM/i )) {
1166 2         13 $self->_eat( qr/FROM/i );
1167 2         10 $self->__consume_ws;
1168 2 50       9 if ($self->_test( qr/NAMED/i )) {
1169 2         9 $self->_NamedGraphClause;
1170             } else {
1171 0         0 $self->_DefaultGraphClause;
1172             }
1173 2         7 $self->__consume_ws_opt;
1174             }
1175             }
1176              
1177             # [10] DefaultGraphClause ::= SourceSelector
1178             sub _DefaultGraphClause {
1179 0     0   0 my $self = shift;
1180 0         0 $self->_SourceSelector;
1181 0         0 my ($source) = splice(@{ $self->{stack} });
  0         0  
1182 0         0 push( @{ $self->{build}{sources} }, [$source] );
  0         0  
1183             }
1184              
1185             # [11] NamedGraphClause ::= 'NAMED' SourceSelector
1186             sub _NamedGraphClause {
1187 2     2   5 my $self = shift;
1188 2         9 $self->_eat( qr/NAMED/i );
1189 2         9 $self->__consume_ws_opt;
1190 2         9 $self->_SourceSelector;
1191 2         5 my ($source) = splice(@{ $self->{stack} });
  2         5  
1192 2         5 push( @{ $self->{build}{sources} }, [$source, 'NAMED'] );
  2         8  
1193             }
1194              
1195             # [12] SourceSelector ::= IRIref
1196             sub _SourceSelector {
1197 2     2   4 my $self = shift;
1198 2         8 $self->_IRIref;
1199             }
1200              
1201             # [13] WhereClause ::= 'WHERE'? GroupGraphPattern
1202             sub _WhereClause_test {
1203 2     2   3 my $self = shift;
1204 2         9 return $self->_test( qr/WHERE|{/i );
1205             }
1206             sub _WhereClause {
1207 91     91   155 my $self = shift;
1208 91 100       416 if ($self->_test( qr/WHERE/i )) {
1209 90         361 $self->_eat( qr/WHERE/i );
1210             }
1211 91         409 $self->__consume_ws_opt;
1212 91         369 $self->_GroupGraphPattern;
1213            
1214 91         292 my $ggp = $self->_peek_pattern;
1215 91         448 $ggp->check_duplicate_blanks;
1216             }
1217              
1218             sub _TriplesWhereClause {
1219 0     0   0 my $self = shift;
1220 0         0 $self->_push_pattern_container;
1221            
1222 0         0 $self->_eat( qr/WHERE/i );
1223 0         0 $self->__consume_ws_opt;
1224 0         0 $self->_eat(qr/{/);
1225 0         0 $self->__consume_ws_opt;
1226 0 0       0 if ($self->_TriplesBlock_test) {
1227 0         0 $self->_TriplesBlock;
1228             }
1229 0         0 $self->_eat(qr/}/);
1230            
1231 0         0 my $cont = $self->_pop_pattern_container;
1232 0         0 $self->{build}{construct_triples} = $cont->[0];
1233            
1234 0         0 my $pattern = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
1235 0         0 $self->_add_patterns( $pattern );
1236             }
1237              
1238             sub _Binding_test {
1239 5     5   7 my $self = shift;
1240 5         14 return $self->_test( '(' );
1241             }
1242              
1243             sub _Binding {
1244 2     2   5 my $self = shift;
1245 2         4 my $count = shift;
1246            
1247 2         7 $self->_eat( '(' );
1248 2         5 $self->__consume_ws_opt;
1249            
1250 2         4 my @terms;
1251 2         7 foreach my $i (1..$count) {
1252 4 50       11 unless ($self->_BindingValue_test) {
1253 0         0 my $found = $i-1;
1254 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Expected $count BindingValues but only found $found";
1255             }
1256 4         41 $self->_BindingValue;
1257 4         22 push( @terms, splice(@{ $self->{stack} }));
  4         9  
1258 4         11 $self->__consume_ws_opt;
1259             }
1260 2         6 $self->__consume_ws_opt;
1261 2         7 $self->_eat( ')' );
1262 2         6 return \@terms;
1263             }
1264              
1265             sub _BindingValue_test {
1266 7     7   13 my $self = shift;
1267 7 100       17 return 1 if ($self->_IRIref_test);
1268 6 100       143 return 1 if ($self->_test(qr/UNDEF|[<'".0-9]|(true|false)\b|_:|\([\n\r\t ]*\)/));
1269 1         7 return 0;
1270             }
1271              
1272             sub _BindingValue {
1273 6     6   10 my $self = shift;
1274 6 100       24 if ($self->_test(qr/UNDEF/i)) {
1275 1         5 $self->_eat(qr/UNDEF/i);
1276 1         2 push(@{ $self->{stack} }, undef);
  1         4  
1277             } else {
1278 5         16 $self->_GraphTerm;
1279             }
1280             }
1281              
1282             # [20] GroupCondition ::= ( BuiltInCall | FunctionCall | '(' Expression ( 'AS' Var )? ')' | Var )
1283             sub __GroupByVar_test {
1284 8     8   15 my $self = shift;
1285 8 50       25 return 1 if ($self->_BuiltInCall_test);
1286 8 50       71 return 1 if ($self->_IRIref_test);
1287 8 50       204 return 1 if ($self->_test( qr/[(]/i ));
1288 8 50       50 return 1 if ($self->_test(qr/[\$?]/));
1289             }
1290              
1291             sub __GroupByVar {
1292 8     8   14 my $self = shift;
1293 8 50       21 if ($self->_test('(')) {
    50          
    50          
1294 0         0 $self->_eat('(');
1295 0         0 $self->__consume_ws_opt;
1296 0         0 $self->_Expression;
1297 0         0 my ($expr) = splice(@{ $self->{stack} });
  0         0  
1298 0         0 $self->__consume_ws_opt;
1299            
1300 0 0       0 if ($self->_test(qr/AS/i)) {
1301 0         0 $self->_eat('AS');
1302 0         0 $self->__consume_ws_opt;
1303 0         0 $self->_Var;
1304 0         0 my ($var) = splice(@{ $self->{stack} });
  0         0  
1305 0         0 $self->__consume_ws_opt;
1306 0         0 my $alias = $self->new_alias_expression( $var, $expr );
1307 0         0 $self->_add_stack( $alias );
1308             } else {
1309 0         0 $self->_add_stack( $expr );
1310             }
1311 0         0 $self->_eat(')');
1312            
1313             } elsif ($self->_IRIref_test) {
1314 0         0 $$self->_FunctionCall;
1315             } elsif ($self->_BuiltInCall_test) {
1316 0         0 $self->_BuiltInCall;
1317             } else {
1318 8         24 $self->_Var;
1319             }
1320             }
1321              
1322             # [14] SolutionModifier ::= OrderClause? LimitOffsetClauses?
1323             sub _SolutionModifier {
1324 89     89   154 my $self = shift;
1325            
1326 89 100       419 if ($self->_test( qr/GROUP\s+BY/i )) {
1327 8         30 $self->_GroupClause;
1328 8         27 $self->__consume_ws_opt;
1329             }
1330            
1331 89 100       445 if ($self->_test( qr/HAVING/i )) {
1332 3         13 $self->_HavingClause;
1333 3         7 $self->__consume_ws_opt;
1334             }
1335            
1336 89 100       418 if ($self->_OrderClause_test) {
1337 8         37 $self->_OrderClause;
1338 8         30 $self->__consume_ws_opt;
1339             }
1340            
1341 89 100       432 if ($self->_LimitOffsetClauses_test) {
1342 3         14 $self->_LimitOffsetClauses;
1343             }
1344             }
1345              
1346             sub _GroupClause {
1347 8     8   16 my $self = shift;
1348 8         35 $self->_eat( qr/GROUP\s+BY/i );
1349            
1350 8 50       38 if ($self->{build}{star}) {
1351 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: SELECT * cannot be used with aggregate grouping";
1352             }
1353            
1354 8   100     31 $self->{build}{__aggregate} ||= {};
1355 8         13 my @vars;
1356 8         25 $self->__consume_ws_opt;
1357 8         31 $self->__GroupByVar;
1358 8         230 my ($v) = splice(@{ $self->{stack} });
  8         21  
1359 8         20 push( @vars, $v );
1360 8         22 $self->__consume_ws_opt;
1361 8         31 while ($self->__GroupByVar_test) {
1362 0         0 $self->__GroupByVar;
1363 0         0 my ($v) = splice(@{ $self->{stack} });
  0         0  
1364 0         0 push( @vars, $v );
1365 0         0 $self->__consume_ws_opt;
1366             }
1367              
1368 8         23 my %seen;
1369 8         21 foreach my $v (@vars) {
1370 8 50 33     64 if ($v->isa('RDF::Query::Node::Variable') or $v->isa('RDF::Query::Expression::Alias')) {
1371 8         53 my $name = $v->name;
1372 8         69 $seen{ $name }++;
1373             }
1374             }
1375 8         14 foreach my $v (@{ $self->{build}{variables} }) {
  8         31  
1376 14 100       95 if ($v->isa('RDF::Query::Node::Variable')) {
    50          
1377 7         25 my $name = $v->name;
1378 7 50       52 unless ($seen{ $name }) {
1379 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Variable used in projection but not present in aggregate grouping ($name)";
1380             }
1381             } elsif ($v->isa('RDF::Query::Expression::Alias')) {
1382 7         32 my $expr = $v->expression;
1383             # warn 'expression: ' . Dumper($expr);
1384 7 50       54 if ($expr->isa('RDF::Query::Node::Variable::ExpressionProxy')) {
    0          
1385             # RDF::Query::Node::Variable::ExpressionProxy is used for aggregate operations.
1386             # we can ignore these because any variable used in an aggreate is valid, even if it's not mentioned in the grouping keys
1387             } elsif ($expr->isa('RDF::Query::Expression')) {
1388 0         0 my @vars = $expr->nonaggregated_referenced_variables;
1389 0         0 foreach my $name (@vars) {
1390 0 0       0 unless ($seen{ $name }) {
1391 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Variable used in projection but not present in aggregate grouping ($name)";
1392             }
1393             }
1394             }
1395             }
1396             }
1397            
1398 8         30 $self->{build}{__group_by} = \@vars;
1399 8         27 $self->__consume_ws_opt;
1400             }
1401              
1402             sub _HavingClause {
1403 3     3   8 my $self = shift;
1404 3         14 $self->_eat(qr/HAVING/i);
1405 3         11 $self->__consume_ws_opt;
1406 3   50     13 $self->{build}{__aggregate} ||= {};
1407 3         10 local($self->{__aggregate_call_ok}) = 1;
1408 3         45 $self->_Constraint;
1409 3         5 my ($expr) = splice(@{ $self->{stack} });
  3         9  
1410 3         14 $self->{build}{__having} = $expr;
1411             }
1412              
1413             # [15] LimitOffsetClauses ::= ( LimitClause OffsetClause? | OffsetClause LimitClause? )
1414             sub _LimitOffsetClauses_test {
1415 89     89   162 my $self = shift;
1416 89         384 return $self->_test( qr/LIMIT|OFFSET/i );
1417             }
1418              
1419             sub _LimitOffsetClauses {
1420 3     3   12 my $self = shift;
1421 3 50       19 if ($self->_LimitClause_test) {
1422 3         14 $self->_LimitClause;
1423 3         11 $self->__consume_ws_opt;
1424 3 100       12 if ($self->_OffsetClause_test) {
1425 1         5 $self->_OffsetClause;
1426             }
1427             } else {
1428 0         0 $self->_OffsetClause;
1429 0         0 $self->__consume_ws_opt;
1430 0 0       0 if ($self->_LimitClause_test) {
1431 0         0 $self->_LimitClause;
1432             }
1433             }
1434             }
1435              
1436             # [16] OrderClause ::= 'ORDER' 'BY' OrderCondition+
1437             sub _OrderClause_test {
1438 89     89   164 my $self = shift;
1439 89         397 return $self->_test( qr/ORDER[\n\r\t ]+BY/i );
1440             }
1441              
1442             sub _OrderClause {
1443 8     8   37 my $self = shift;
1444 8         45 $self->_eat( qr/ORDER/i );
1445 8         32 $self->__consume_ws;
1446 8         40 $self->_eat( qr/BY/i );
1447 8         32 $self->__consume_ws_opt;
1448 8         15 my @order;
1449 8   100     56 $self->{build}{__aggregate} ||= {};
1450 8         27 local($self->{__aggregate_call_ok}) = 1;
1451 8         37 $self->_OrderCondition;
1452 8         23 $self->__consume_ws_opt;
1453 8         15 push(@order, splice(@{ $self->{stack} }));
  8         26  
1454 8         36 while ($self->_OrderCondition_test) {
1455 0         0 $self->_OrderCondition;
1456 0         0 $self->__consume_ws_opt;
1457 0         0 push(@order, splice(@{ $self->{stack} }));
  0         0  
1458             }
1459 8         52 $self->{build}{options}{orderby} = \@order;
1460             }
1461              
1462             # [17] OrderCondition ::= ( ( 'ASC' | 'DESC' ) BrackettedExpression ) | ( Constraint | Var )
1463             sub _OrderCondition_test {
1464 8     8   18 my $self = shift;
1465 8 50       40 return 1 if $self->_test( qr/ASC|DESC|[?\$]/i );
1466 8 50       58 return 1 if $self->_Constraint_test;
1467 8         33 return 0;
1468             }
1469              
1470             sub _OrderCondition {
1471 8     8   18 my $self = shift;
1472 8         17 my $dir = 'ASC';
1473 8 100       37 if ($self->_test( qr/ASC|DESC/i )) {
    100          
1474 4         21 $dir = uc( $self->_eat( qr/ASC|DESC/i ) );
1475 4         18 $self->__consume_ws_opt;
1476 4         15 $self->_BrackettedExpression;
1477             } elsif ($self->_test( qr/[?\$]/ )) {
1478 3         8 $self->_Var;
1479             } else {
1480 1         6 $self->_Constraint;
1481             }
1482 8         40 my ($expr) = splice(@{ $self->{stack} });
  8         26  
1483 8         34 $self->_add_stack( [ $dir, $expr ] );
1484             }
1485              
1486             # [18] LimitClause ::= 'LIMIT' INTEGER
1487             sub _LimitClause_test {
1488 3     3   6 my $self = shift;
1489 3         17 return $self->_test( qr/LIMIT/i );
1490             }
1491              
1492             sub _LimitClause {
1493 3     3   7 my $self = shift;
1494 3         16 $self->_eat( qr/LIMIT/i );
1495 3         13 $self->__consume_ws;
1496 3         12 my $limit = $self->_eat( $r_INTEGER );
1497 3         16 $self->{build}{options}{limit} = $limit;
1498             }
1499              
1500             # [19] OffsetClause ::= 'OFFSET' INTEGER
1501             sub _OffsetClause_test {
1502 3     3   17 my $self = shift;
1503 3         18 return $self->_test( qr/OFFSET/i );
1504             }
1505              
1506             sub _OffsetClause {
1507 1     1   3 my $self = shift;
1508 1         5 $self->_eat( qr/OFFSET/i );
1509 1         4 $self->__consume_ws;
1510 1         3 my $off = $self->_eat( $r_INTEGER );
1511 1         6 $self->{build}{options}{offset} = $off;
1512             }
1513              
1514             # [20] GroupGraphPattern ::= '{' TriplesBlock? ( ( GraphPatternNotTriples | Filter ) '.'? TriplesBlock? )* '}'
1515             sub _GroupGraphPattern {
1516 130     130   225 my $self = shift;
1517            
1518 130         341 $self->_eat('{');
1519 130         293 $self->__consume_ws_opt;
1520            
1521 130 100       445 if ($self->_SubSelect_test) {
1522 1         7 $self->_SubSelect;
1523             } else {
1524 129         448 $self->_GroupGraphPatternSub;
1525             }
1526              
1527 130         463 $self->__consume_ws_opt;
1528 130         342 $self->_eat('}');
1529             }
1530              
1531             sub _GroupGraphPatternSub {
1532 129     129   220 my $self = shift;
1533 129         348 $self->_push_pattern_container;
1534            
1535 129         192 my $got_pattern = 0;
1536 129         193 my $need_dot = 0;
1537 129 100       415 if ($self->_TriplesBlock_test) {
1538 112         201 $need_dot = 1;
1539 112         190 $got_pattern++;
1540 112         361 $self->_TriplesBlock;
1541 112         308 $self->__consume_ws_opt;
1542             }
1543            
1544 129         2061 my $pos = length($self->{tokens});
1545 129         374 while (not $self->_test('}')) {
1546 38 100       137 if ($self->_GraphPatternNotTriples_test) {
    50          
1547 20         36 $need_dot = 0;
1548 20         39 $got_pattern++;
1549 20         78 $self->_GraphPatternNotTriples;
1550 20         116 $self->__consume_ws_opt;
1551 20         37 my (@data) = splice(@{ $self->{stack} });
  20         67  
1552 20         101 $self->__handle_GraphPatternNotTriples( @data );
1553 20         53 $self->__consume_ws_opt;
1554             } elsif ($self->_test( qr/FILTER/i )) {
1555 18         31 $got_pattern++;
1556 18         33 $need_dot = 0;
1557 18         72 $self->_Filter;
1558 18         48 $self->__consume_ws_opt;
1559             }
1560            
1561 38 100 66     307 if ($need_dot or $self->_test('.')) {
1562 5         16 $self->_eat('.');
1563 5 50       14 if ($got_pattern) {
1564 5         9 $need_dot = 0;
1565 5         11 $got_pattern = 0;
1566             } else {
1567 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Extra dot found without preceding pattern";
1568             }
1569 5         16 $self->__consume_ws_opt;
1570             }
1571            
1572 38 50       113 if ($self->_TriplesBlock_test) {
1573 0         0 my $peek = $self->_peek_pattern;
1574 0 0 0     0 if (blessed($peek) and $peek->isa('RDF::Query::Algebra::BasicGraphPattern')) {
1575 0         0 $self->_TriplesBlock;
1576 0         0 my $rhs = $self->_remove_pattern;
1577 0         0 my $lhs = $self->_remove_pattern;
1578 0 0       0 if ($rhs->isa('RDF::Query::Algebra::BasicGraphPattern')) {
1579 0         0 my $merged = $self->__new_bgp( map { $_->triples } ($lhs, $rhs) );
  0         0  
1580 0         0 $self->_add_patterns( $merged );
1581             } else {
1582 0         0 my $merged = RDF::Query::Algebra::GroupGraphPattern->new($lhs, $rhs);
1583 0         0 $self->_add_patterns( $merged );
1584             }
1585             } else {
1586 0         0 $self->_TriplesBlock;
1587             }
1588 0         0 $self->__consume_ws_opt;
1589             }
1590            
1591 38         441 $self->__consume_ws_opt;
1592 38 50       170 last unless ($self->_test( qr/\S/ ));
1593            
1594 38         114 my $new = length($self->{tokens});
1595 38 50       105 if ($pos == $new) {
1596             # we haven't progressed, and so would infinite loop if we don't break out and throw an error.
1597 0         0 $self->_syntax_error('');
1598             } else {
1599 38         117 $pos = $new;
1600             }
1601             }
1602            
1603 129         365 my $cont = $self->_pop_pattern_container;
1604              
1605 129         218 my @filters = splice(@{ $self->{filters} });
  129         369  
1606 129         204 my @patterns;
1607 129         713 my $pattern = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
1608 129 100       403 if (@filters) {
1609 17         88 while (my $f = shift @filters) {
1610 18         108 $pattern = RDF::Query::Algebra::Filter->new( $f, $pattern );
1611             }
1612             }
1613 129         362 $self->_add_patterns( $pattern );
1614             }
1615              
1616             sub __handle_GraphPatternNotTriples {
1617 28     28   52 my $self = shift;
1618 28         47 my $data = shift;
1619 28         63 my ($class, @args) = @$data;
1620 28 100       385 if ($class =~ /^RDF::Query::Algebra::(Optional|Minus)$/) {
    50          
    50          
    50          
    50          
1621 6         18 my $cont = $self->_pop_pattern_container;
1622 6         27 my $ggp = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
1623 6         20 $self->_push_pattern_container;
1624             # my $ggp = $self->_remove_pattern();
1625 6 50       32 unless ($ggp) {
1626 0         0 $ggp = RDF::Query::Algebra::GroupGraphPattern->new();
1627             }
1628            
1629 6         56 my $opt = $class->new( $ggp, @args );
1630 6         19 $self->_add_patterns( $opt );
1631             } elsif ($class eq 'RDF::Query::Algebra::Table') {
1632 0         0 my ($table) = @args;
1633 0         0 $self->_add_patterns( $table );
1634             } elsif ($class eq 'RDF::Query::Algebra::Extend') {
1635 0         0 my $cont = $self->_pop_pattern_container;
1636 0         0 my $ggp = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
1637 0         0 $self->_push_pattern_container;
1638             # my $ggp = $self->_remove_pattern();
1639 0 0       0 unless ($ggp) {
1640 0         0 $ggp = RDF::Query::Algebra::GroupGraphPattern->new();
1641             }
1642              
1643 0         0 my $alias = $args[0];
1644 0         0 my %in_scope = map { $_ => 1 } $ggp->potentially_bound();
  0         0  
1645 0         0 my $var = $alias->name;
1646 0 0       0 if (exists $in_scope{ $var }) {
1647 0         0 throw RDF::Query::Error::QueryPatternError -text => "Syntax error: BIND used with variable already in scope";
1648             }
1649            
1650 0         0 my $bind = $class->new( $ggp, [$alias] );
1651 0         0 $self->_add_patterns( $bind );
1652             } elsif ($class eq 'RDF::Query::Algebra::Service') {
1653 0         0 my ($endpoint, $pattern, $silent) = @args;
1654 0 0       0 if ($endpoint->isa('RDF::Query::Node::Variable')) {
1655             # SERVICE ?var
1656 0         0 my $cont = $self->_pop_pattern_container;
1657 0         0 my $ggp = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
1658 0         0 $self->_push_pattern_container;
1659             # my $ggp = $self->_remove_pattern();
1660 0 0       0 unless ($ggp) {
1661 0         0 $ggp = RDF::Query::Algebra::GroupGraphPattern->new();
1662             }
1663            
1664 0         0 my $service = $class->new( $endpoint, $pattern, $silent, $ggp );
1665 0         0 $self->_add_patterns( $service );
1666             } else {
1667             # SERVICE <endpoint>
1668             # no-op
1669 0         0 my $service = $class->new( $endpoint, $pattern, $silent );
1670 0         0 $self->_add_patterns( $service );
1671             }
1672             } elsif ($class =~ /RDF::Query::Algebra::(Union|NamedGraph|GroupGraphPattern)$/) {
1673             # no-op
1674             } else {
1675 0         0 throw RDF::Query::Error::ParseError 'Unrecognized GraphPattern: ' . $class;
1676             }
1677             }
1678              
1679             sub _SubSelect_test {
1680 130     130   207 my $self = shift;
1681 130         545 return $self->_test(qr/SELECT/i);
1682             }
1683              
1684             sub _SubSelect {
1685 1     1   2 my $self = shift;
1686 1         2 my $pattern;
1687             {
1688 1         2 local($self->{error});
  1         3  
1689 1         4 local($self->{namespaces}) = $self->{namespaces};
1690 1         3 local($self->{blank_ids}) = $self->{blank_ids};
1691 1         4 local($self->{stack}) = [];
1692 1         3 local($self->{filters}) = [];
1693 1         3 local($self->{pattern_container_stack}) = [];
1694 1         5 my $triples = $self->_push_pattern_container();
1695 1         5 local($self->{build}) = { triples => $triples};
1696 1 50       5 if ($self->{baseURI}) {
1697 0         0 $self->{build}{base} = $self->{baseURI};
1698             }
1699            
1700 1         6 $self->_eat(qr/SELECT/i);
1701 1         4 $self->__consume_ws;
1702            
1703 1 50       9 if ($self->{tokens} =~ m/^(DISTINCT|REDUCED)/i) {
1704 0         0 my $mod = $self->_eat( qr/DISTINCT|REDUCED/i );
1705 0         0 $self->__consume_ws;
1706 0         0 $self->{build}{options}{lc($mod)} = 1;
1707             }
1708            
1709 1         4 my $star = $self->__SelectVars;
1710            
1711 1         4 $self->__consume_ws_opt;
1712 1         5 $self->_WhereClause;
1713            
1714 1 50       4 if ($star) {
1715 0   0     0 my $triples = $self->{build}{triples} || [];
1716 0         0 my @vars;
1717 0         0 foreach my $t (@$triples) {
1718 0         0 my @v = $t->potentially_bound;
1719 0         0 push(@vars, @v);
1720             }
1721 0         0 @vars = RDF::Query::_uniq( @vars );
1722 0         0 push( @{ $self->{build}{variables} }, map { $self->new_variable($_) } @vars );
  0         0  
  0         0  
1723             }
1724            
1725 1         4 $self->__consume_ws_opt;
1726 1         6 $self->_SolutionModifier();
1727            
1728 1 50       8 if ($self->{build}{options}{orderby}) {
1729 0         0 my $order = delete $self->{build}{options}{orderby};
1730 0         0 my $pattern = pop(@{ $self->{build}{triples} });
  0         0  
1731 0         0 my $sort = RDF::Query::Algebra::Sort->new( $pattern, @$order );
1732 0         0 push(@{ $self->{build}{triples} }, $sort);
  0         0  
1733             }
1734            
1735 1         4 $self->__consume_ws_opt;
1736 1 50       28 if ($self->_test( qr/VALUES/i )) {
1737 0         0 $self->_eat( qr/VALUES/i );
1738 0         0 $self->__consume_ws_opt;
1739 0         0 my @vars;
1740 0         0 my $parens = 0;
1741 0 0       0 if ($self->_test(qr/[(]/)) {
1742 0         0 $self->_eat( qr/[(]/ );
1743 0         0 $parens = 1;
1744             }
1745 0         0 while ($self->_test(qr/[\$?]/)) {
1746 0         0 $self->_Var;
1747 0         0 push( @vars, splice(@{ $self->{stack} }));
  0         0  
1748 0         0 $self->__consume_ws_opt;
1749             }
1750 0 0       0 if ($parens) {
1751 0         0 $self->_eat( qr/[)]/ );
1752             }
1753 0         0 $self->__consume_ws_opt;
1754            
1755 0         0 my $count = scalar(@vars);
1756 0 0 0     0 if (not($parens) and $count == 0) {
    0 0        
1757 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Expected VAR in inline data declaration";
1758             } elsif (not($parens) and $count > 1) {
1759 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Inline data declaration can only have one variable when parens are omitted";
1760             }
1761            
1762 0   0     0 my $short = (not($parens) and $count == 1);
1763 0         0 $self->_eat('{');
1764 0         0 $self->__consume_ws_opt;
1765 0 0 0     0 if (not($short) or ($short and $self->_Binding_test)) {
      0        
1766 0         0 while ($self->_Binding_test) {
1767 0         0 my $terms = $self->_Binding($count);
1768 0         0 push( @{ $self->{build}{bindings}{terms} }, $terms );
  0         0  
1769 0         0 $self->__consume_ws_opt;
1770             }
1771             } else {
1772 0         0 while ($self->_BindingValue_test) {
1773 0         0 $self->_BindingValue;
1774 0         0 $self->__consume_ws_opt;
1775 0         0 my ($term) = splice(@{ $self->{stack} });
  0         0  
1776 0         0 push( @{ $self->{build}{bindings}{terms} }, [$term] );
  0         0  
1777 0         0 $self->__consume_ws_opt;
1778             }
1779             }
1780            
1781 0         0 $self->_eat('}');
1782 0         0 $self->__consume_ws_opt;
1783 0         0 $self->{build}{bindings}{vars} = \@vars;
1784             }
1785            
1786 1         6 $self->__solution_modifiers( $star );
1787            
1788 1         3 delete $self->{build}{options};
1789 1         3 my $data = delete $self->{build};
1790 1         3 $data->{method} = 'SELECT';
1791             my $query = RDF::Query->_new(
1792             base => $self->{baseURI},
1793             # parser => $self,
1794 1         10 parsed => { %$data },
1795             );
1796 1         11 $pattern = RDF::Query::Algebra::SubSelect->new( $query );
1797             }
1798            
1799 1         4 $self->_add_patterns( $pattern );
1800             }
1801              
1802             # [21] TriplesBlock ::= TriplesSameSubject ( '.' TriplesBlock? )?
1803             sub _TriplesBlock_test {
1804 311     311   482 my $self = shift;
1805             # VarOrTerm | TriplesNode -> (Var | GraphTerm) | (Collection | BlankNodePropertyList) -> Var | IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL | Collection | BlankNodePropertyList
1806             # but since a triple can't start with a literal, this is reduced to:
1807             # Var | IRIref | BlankNode | NIL
1808 311         8357 return $self->_test(qr/[\$?]|<|_:|\[[\n\r\t ]*\]|\([\n\r\t ]*\)|\[|[[(]|${r_PNAME_NS}/);
1809             }
1810              
1811             sub _TriplesBlock {
1812 120     120   205 my $self = shift;
1813 120         291 $self->_push_pattern_container;
1814 120         389 $self->__TriplesBlock;
1815 120         386 my $triples = $self->_pop_pattern_container;
1816 120         426 my $bgp = $self->__new_bgp( @$triples );
1817 120         348 $self->_add_patterns( $bgp );
1818             }
1819              
1820             ## this one (with two underscores) doesn't pop patterns off the stack and make a BGP.
1821             ## instead, things are left on the stack so we can recurse without doing the wrong thing.
1822             ## the one with one underscore (_TriplesBlock) will pop everything off and make the BGP.
1823             sub __TriplesBlock {
1824 120     120   204 my $self = shift;
1825 120         204 my $got_dot = 0;
1826 149         1159 TRIPLESBLOCKLOOP:
1827             $self->_TriplesSameSubjectPath;
1828 149         408 $self->__consume_ws_opt;
1829 149         403 while ($self->_test('.')) {
1830 95 50       282 if ($got_dot) {
1831 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: found extra DOT after TriplesBlock";
1832             }
1833 95         246 $self->_eat('.');
1834 95         140 $got_dot++;
1835 95         231 $self->__consume_ws_opt;
1836 95 100       260 if ($self->_TriplesBlock_test) {
1837 29         46 $got_dot = 0;
1838 29         193 goto TRIPLESBLOCKLOOP;
1839             }
1840 66         891 $self->__consume_ws_opt;
1841             }
1842 120         340 $self->__consume_ws_opt;
1843             }
1844              
1845             # [22] GraphPatternNotTriples ::= OptionalGraphPattern | GroupOrUnionGraphPattern | GraphGraphPattern
1846             sub _GraphPatternNotTriples_test {
1847 38     38   75 my $self = shift;
1848 38 50       172 return 1 if $self->_test(qr/VALUES/i); # InlineDataClause
1849 38         189 return $self->_test(qr/BIND|SERVICE|MINUS|OPTIONAL|{|GRAPH/i);
1850             }
1851              
1852             sub _GraphPatternNotTriples {
1853 20     20   37 my $self = shift;
1854 20 50       98 if ($self->_test(qr/VALUES/i)) {
    50          
    50          
    50          
    100          
    100          
1855 0         0 $self->_InlineDataClause;
1856             } elsif ($self->_test(qr/SERVICE/i)) {
1857 0         0 $self->_ServiceGraphPattern;
1858             } elsif ($self->_test(qr/MINUS/i)) {
1859 0         0 $self->_MinusGraphPattern;
1860             } elsif ($self->_test(qr/BIND/i)) {
1861 0         0 $self->_Bind;
1862             } elsif ($self->_OptionalGraphPattern_test) {
1863 6         27 $self->_OptionalGraphPattern;
1864             } elsif ($self->_GroupOrUnionGraphPattern_test) {
1865 7         30 $self->_GroupOrUnionGraphPattern;
1866             } else {
1867 7         29 $self->_GraphGraphPattern;
1868             }
1869             }
1870              
1871             sub _InlineDataClause {
1872 0     0   0 my $self = shift;
1873 0         0 $self->_eat( qr/VALUES/i );
1874 0         0 $self->__consume_ws_opt;
1875 0         0 my @vars;
1876            
1877 0         0 my $parens = 0;
1878 0 0       0 if ($self->_test(qr/[(]/)) {
1879 0         0 $self->_eat( qr/[(]/ );
1880 0         0 $self->__consume_ws_opt;
1881 0         0 $parens = 1;
1882             }
1883 0         0 while ($self->_test(qr/[\$?]/)) {
1884 0         0 $self->_Var;
1885 0         0 push( @vars, splice(@{ $self->{stack} }));
  0         0  
1886 0         0 $self->__consume_ws_opt;
1887             }
1888 0 0       0 if ($parens) {
1889 0         0 $self->_eat( qr/[)]/ );
1890 0         0 $self->__consume_ws_opt;
1891             }
1892            
1893 0         0 my $count = scalar(@vars);
1894 0 0 0     0 if (not($parens) and $count == 0) {
    0 0        
1895 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Expected VAR in inline data declaration";
1896             } elsif (not($parens) and $count > 1) {
1897 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Inline data declaration can only have one variable when parens are omitted";
1898             }
1899            
1900 0   0     0 my $short = (not($parens) and $count == 1);
1901 0         0 $self->_eat('{');
1902 0         0 $self->__consume_ws_opt;
1903 0         0 my @rows;
1904 0 0 0     0 if (not($short) or ($short and $self->_Binding_test)) {
      0        
1905             # { (term) (term) }
1906 0         0 while ($self->_Binding_test) {
1907 0         0 my $terms = $self->_Binding($count);
1908 0         0 push( @rows, $terms );
1909 0         0 $self->__consume_ws_opt;
1910             }
1911             } else {
1912             # { term term }
1913 0         0 while ($self->_BindingValue_test) {
1914 0         0 $self->_BindingValue;
1915 0         0 $self->__consume_ws_opt;
1916 0         0 my ($term) = splice(@{ $self->{stack} });
  0         0  
1917 0         0 push( @rows, [$term] );
1918             }
1919             }
1920            
1921 0         0 $self->_eat('}');
1922 0         0 $self->__consume_ws_opt;
1923            
1924 0         0 my @vbs = map { my %d; @d{ map { $_->name } @vars } = @$_; RDF::Query::VariableBindings->new(\%d) } @rows;
  0         0  
  0         0  
  0         0  
  0         0  
1925            
1926 0         0 my $table = RDF::Query::Algebra::Table->new( [ map { $_->name } @vars ], @vbs );
  0         0  
1927 0         0 $self->_add_stack( ['RDF::Query::Algebra::Table', $table] );
1928            
1929             }
1930              
1931             sub _Bind {
1932 0     0   0 my $self = shift;
1933 0         0 $self->_eat(qr/BIND/i);
1934 0         0 $self->__consume_ws_opt;
1935 0         0 $self->_BrackettedAliasExpression;
1936 0         0 my ($alias) = splice(@{ $self->{stack} });
  0         0  
1937 0         0 $self->_add_stack( ['RDF::Query::Algebra::Extend', $alias] );
1938             }
1939              
1940             sub _ServiceGraphPattern {
1941 0     0   0 my $self = shift;
1942 0         0 my $op = $self->_eat( qr/SERVICE(\s+SILENT)?/i );
1943 0         0 my $silent = ($op =~ /SILENT/i);
1944 0         0 $self->__consume_ws_opt;
1945 0 0       0 if ($self->_test(qr/[\$?]/)) {
1946 0         0 $self->__close_bgp_with_filters;
1947 0         0 $self->_Var;
1948             } else {
1949 0         0 $self->_IRIref;
1950             }
1951 0         0 my ($endpoint) = splice( @{ $self->{stack} } );
  0         0  
1952 0         0 $self->__consume_ws_opt;
1953 0         0 $self->_GroupGraphPattern;
1954 0         0 my $ggp = $self->_remove_pattern;
1955            
1956             # my $pattern = RDF::Query::Algebra::Service->new( $endpoint, $ggp, $silent );
1957             # $self->_add_patterns( $pattern );
1958            
1959 0 0       0 my $opt = ['RDF::Query::Algebra::Service', $endpoint, $ggp, ($silent ? 1 : 0)];
1960 0         0 $self->_add_stack( $opt );
1961             }
1962              
1963             # [23] OptionalGraphPattern ::= 'OPTIONAL' GroupGraphPattern
1964             sub _OptionalGraphPattern_test {
1965 20     20   36 my $self = shift;
1966 20         91 return $self->_test( qr/OPTIONAL/i );
1967             }
1968              
1969             sub __close_bgp_with_filters {
1970 6     6   14 my $self = shift;
1971 6         12 my @filters = splice(@{ $self->{filters} });
  6         19  
1972 6 50       24 if (@filters) {
1973 0         0 my $cont = $self->_pop_pattern_container;
1974 0         0 my $ggp = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
1975 0         0 $self->_push_pattern_container;
1976             # my $ggp = $self->_remove_pattern();
1977 0 0       0 unless ($ggp) {
1978 0         0 $ggp = RDF::Query::Algebra::GroupGraphPattern->new();
1979             }
1980 0         0 while (my $f = shift @filters) {
1981 0         0 $ggp = RDF::Query::Algebra::Filter->new( $f, $ggp );
1982             }
1983 0         0 $self->_add_patterns($ggp);
1984             }
1985             }
1986              
1987             sub _OptionalGraphPattern {
1988 6     6   12 my $self = shift;
1989 6         28 $self->_eat( qr/OPTIONAL/i );
1990 6         28 $self->__close_bgp_with_filters;
1991            
1992 6         19 $self->__consume_ws_opt;
1993 6         28 $self->_GroupGraphPattern;
1994 6         19 my $ggp = $self->_remove_pattern;
1995 6         17 my $opt = ['RDF::Query::Algebra::Optional', $ggp];
1996 6         21 $self->_add_stack( $opt );
1997             }
1998              
1999             sub _MinusGraphPattern {
2000 0     0   0 my $self = shift;
2001 0         0 $self->_eat( qr/MINUS/i );
2002 0         0 $self->__close_bgp_with_filters;
2003            
2004 0         0 $self->__consume_ws_opt;
2005 0         0 $self->_GroupGraphPattern;
2006 0         0 my $ggp = $self->_remove_pattern;
2007 0         0 my $opt = ['RDF::Query::Algebra::Minus', $ggp];
2008 0         0 $self->_add_stack( $opt );
2009             }
2010              
2011             # [24] GraphGraphPattern ::= 'GRAPH' VarOrIRIref GroupGraphPattern
2012             sub _GraphGraphPattern {
2013 15     15   30 my $self = shift;
2014 15 100       53 if ($self->{__data_pattern}) {
2015 4 50       23 if ($self->{__graph_nesting_level}++) {
2016 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Nested named GRAPH blocks not allowed in data template.";
2017             }
2018             }
2019            
2020 15         72 $self->_eat( qr/GRAPH\b/i );
2021 15         56 $self->__consume_ws_opt;
2022 15         55 $self->_VarOrIRIref;
2023 15         37 my ($graph) = splice(@{ $self->{stack} });
  15         47  
2024 15         53 $self->__consume_ws_opt;
2025            
2026 15 100       88 if ($graph->isa('RDF::Trine::Node::Resource')) {
2027 9         30 local($self->{named_graph}) = $graph;
2028 9         32 $self->_GroupGraphPattern;
2029             } else {
2030 6         60 $self->_GroupGraphPattern;
2031             }
2032              
2033 15 100       59 if ($self->{__data_pattern}) {
2034 4         9 $self->{__graph_nesting_level}--;
2035             }
2036            
2037 15         49 my $ggp = $self->_remove_pattern;
2038 15         106 my $pattern = RDF::Query::Algebra::NamedGraph->new( $graph, $ggp );
2039 15         43 $self->_add_patterns( $pattern );
2040 15         60 $self->_add_stack( [ 'RDF::Query::Algebra::NamedGraph' ] );
2041             }
2042              
2043             # [25] GroupOrUnionGraphPattern ::= GroupGraphPattern ( 'UNION' GroupGraphPattern )*
2044             sub _GroupOrUnionGraphPattern_test {
2045 14     14   30 my $self = shift;
2046 14         40 return $self->_test('{');
2047             }
2048              
2049             sub _GroupOrUnionGraphPattern {
2050 7     7   14 my $self = shift;
2051 7         23 $self->_GroupGraphPattern;
2052 7         23 my $ggp = $self->_remove_pattern;
2053 7         21 $self->__consume_ws_opt;
2054            
2055 7 100       54 if ($self->_test( qr/UNION/i )) {
2056 6         27 while ($self->_test( qr/UNION/i )) {
2057 6         32 $self->_eat( qr/UNION/i );
2058 6         20 $self->__consume_ws_opt;
2059 6         19 $self->_GroupGraphPattern;
2060 6         20 $self->__consume_ws_opt;
2061 6         17 my $rhs = $self->_remove_pattern;
2062 6         55 $ggp = RDF::Query::Algebra::Union->new( $ggp, $rhs );
2063             }
2064 6         22 $self->_add_patterns( $ggp );
2065 6         21 $self->_add_stack( [ 'RDF::Query::Algebra::Union' ] );
2066             } else {
2067 1         4 $self->_add_patterns( $ggp );
2068 1         4 $self->_add_stack( [ 'RDF::Query::Algebra::GroupGraphPattern' ] );
2069             }
2070             }
2071              
2072             # [26] Filter ::= 'FILTER' Constraint
2073             sub _Filter {
2074 18     18   31 my $self = shift;
2075 18         91 $self->_eat( qr/FILTER/i );
2076 18         64 $self->__consume_ws_opt;
2077 18         69 $self->_Constraint;
2078 18         35 my ($expr) = splice(@{ $self->{stack} });
  18         52  
2079 18         67 $self->_add_filter( $expr );
2080             }
2081              
2082             # [27] Constraint ::= BrackettedExpression | BuiltInCall | FunctionCall
2083             sub _Constraint_test {
2084 8     8   18 my $self = shift;
2085 8 50       38 return 1 if $self->_test( qr/[(]/ );
2086 8 50       38 return 1 if $self->_BuiltInCall_test;
2087 8 50       83 return 1 if $self->_FunctionCall_test;
2088 8         198 return 0;
2089             }
2090              
2091             sub _Constraint {
2092 22     22   39 my $self = shift;
2093 22 100       81 if ($self->_BrackettedExpression_test) {
    50          
2094 21         72 $self->_BrackettedExpression();
2095             } elsif ($self->_BuiltInCall_test) {
2096 0         0 $self->_BuiltInCall();
2097             } else {
2098 1         6 $self->_FunctionCall();
2099             }
2100             }
2101              
2102             # [28] FunctionCall ::= IRIref ArgList
2103             sub _FunctionCall_test {
2104 8     8   22 my $self = shift;
2105 8         29 return $self->_IRIref_test;
2106             }
2107              
2108             sub _FunctionCall {
2109 1     1   3 my $self = shift;
2110 1         3 $self->_IRIref;
2111 1         15 my ($iri) = splice(@{ $self->{stack} });
  1         5  
2112            
2113 1         4 $self->__consume_ws_opt;
2114            
2115 1         5 $self->_ArgList;
2116 1         2 my @args = splice(@{ $self->{stack} });
  1         4  
2117 1         7 my $func = $self->new_function_expression( $iri, @args );
2118 1         5 $self->_add_stack( $func );
2119             }
2120              
2121             # [29] ArgList ::= ( NIL | '(' Expression ( ',' Expression )* ')' )
2122             sub _ArgList_test {
2123 11     11   21 my $self = shift;
2124 11         31 return $self->_test('(');
2125             }
2126              
2127             sub _ArgList {
2128 16     16   37 my $self = shift;
2129 16         41 $self->_eat('(');
2130 16         42 $self->__consume_ws_opt;
2131 16         26 my @args;
2132 16 50       42 unless ($self->_test(')')) {
2133 16         62 $self->_Expression;
2134 16         29 push( @args, splice(@{ $self->{stack} }) );
  16         40  
2135 16         43 while ($self->_test(',')) {
2136 7         18 $self->_eat(',');
2137 7         18 $self->__consume_ws_opt;
2138 7         18 $self->_Expression;
2139 7         11 push( @args, splice(@{ $self->{stack} }) );
  7         22  
2140             }
2141             }
2142 16         47 $self->_eat(')');
2143 16         43 $self->_add_stack( @args );
2144             }
2145              
2146             # [30] ConstructTemplate ::= '{' ConstructTriples? '}'
2147             sub _ConstructTemplate {
2148 2     2   4 my $self = shift;
2149 2         7 $self->_push_pattern_container;
2150 2         6 $self->_eat( '{' );
2151 2         6 $self->__consume_ws_opt;
2152            
2153 2 50       7 if ($self->_ConstructTriples_test) {
2154 2         8 $self->_ConstructTriples;
2155             }
2156              
2157 2         33 $self->__consume_ws_opt;
2158 2         5 $self->_eat( '}' );
2159 2         6 my $cont = $self->_pop_pattern_container;
2160 2         8 $self->{build}{construct_triples} = $cont;
2161             }
2162              
2163             # [31] ConstructTriples ::= TriplesSameSubject ( '.' ConstructTriples? )?
2164             sub _ConstructTriples_test {
2165 3     3   6 my $self = shift;
2166 3         9 return $self->_TriplesBlock_test;
2167             }
2168              
2169             sub _ConstructTriples {
2170 2     2   5 my $self = shift;
2171 2         8 $self->_TriplesSameSubject;
2172 2         7 $self->__consume_ws_opt;
2173 2         9 while ($self->_test(qr/[.]/)) {
2174 1         6 $self->_eat( qr/[.]/ );
2175 1         5 $self->__consume_ws_opt;
2176 1 50       4 if ($self->_ConstructTriples_test) {
2177 0         0 $self->_TriplesSameSubject;
2178             }
2179             }
2180             }
2181              
2182             # [32] TriplesSameSubject ::= VarOrTerm PropertyListNotEmpty | TriplesNode PropertyList
2183             sub _TriplesSameSubject {
2184 2     2   4 my $self = shift;
2185 2         3 my @triples;
2186 2 50       8 if ($self->_TriplesNode_test) {
2187 0         0 $self->_TriplesNode;
2188 0         0 my ($s) = splice(@{ $self->{stack} });
  0         0  
2189 0         0 $self->__consume_ws_opt;
2190 0         0 $self->_PropertyList;
2191 0         0 $self->__consume_ws_opt;
2192            
2193 0         0 my @list = splice(@{ $self->{stack} });
  0         0  
2194 0         0 foreach my $data (@list) {
2195 0         0 push(@triples, $self->__new_statement( $s, @$data ));
2196             }
2197             } else {
2198 2         9 $self->_VarOrTerm;
2199 2         5 my ($s) = splice(@{ $self->{stack} });
  2         5  
2200              
2201 2         7 $self->__consume_ws_opt;
2202 2         9 $self->_PropertyListNotEmpty;
2203 2         6 $self->__consume_ws_opt;
2204 2         4 my (@list) = splice(@{ $self->{stack} });
  2         18  
2205 2         5 foreach my $data (@list) {
2206 2         9 push(@triples, $self->__new_statement( $s, @$data ));
2207             }
2208             }
2209            
2210 2         47 $self->_add_patterns( @triples );
2211             # return @triples;
2212             }
2213              
2214             # TriplesSameSubjectPath ::= VarOrTerm PropertyListNotEmptyPath | TriplesNode PropertyListPath
2215             sub _TriplesSameSubjectPath {
2216 149     149   226 my $self = shift;
2217 149         218 my @triples;
2218 149 100       504 if ($self->_TriplesNode_test) {
2219 9         31 $self->_TriplesNode;
2220 9         27 my ($s) = splice(@{ $self->{stack} });
  9         23  
2221 9         28 $self->__consume_ws_opt;
2222 9         34 $self->_PropertyListPath;
2223 9         285 $self->__consume_ws_opt;
2224            
2225 9         16 my @list = splice(@{ $self->{stack} });
  9         27  
2226 9         31 foreach my $data (@list) {
2227 0         0 push(@triples, $self->__new_statement( $s, @$data ));
2228             }
2229             } else {
2230 140         475 $self->_VarOrTerm;
2231 140         472 my ($s) = splice(@{ $self->{stack} });
  140         400  
2232              
2233 140         696 $self->__consume_ws_opt;
2234 140         480 $self->_PropertyListNotEmptyPath;
2235 140         353 $self->__consume_ws_opt;
2236 140         232 my (@list) = splice(@{ $self->{stack} });
  140         372  
2237 140         353 foreach my $data (@list) {
2238 185         1368 push(@triples, $self->__new_statement( $s, @$data ));
2239             }
2240             }
2241            
2242 149         3316 $self->_add_patterns( @triples );
2243             # return @triples;
2244             }
2245              
2246             # [33] PropertyListNotEmpty ::= Verb ObjectList ( ';' ( Verb ObjectList )? )*
2247             sub _PropertyListNotEmpty {
2248 2     2   4 my $self = shift;
2249 2         8 $self->_Verb;
2250 2         34 my ($v) = splice(@{ $self->{stack} });
  2         6  
2251 2         6 $self->__consume_ws_opt;
2252 2         13 $self->_ObjectList;
2253 2         4 my @l = splice(@{ $self->{stack} });
  2         6  
2254 2         4 my @props = map { [$v, $_] } @l;
  2         7  
2255 2         10 while ($self->_test(qr'\s*;')) {
2256 0         0 $self->_eat(';');
2257 0         0 $self->__consume_ws_opt;
2258 0 0       0 if ($self->_Verb_test) {
2259 0         0 $self->_Verb;
2260 0         0 my ($v) = splice(@{ $self->{stack} });
  0         0  
2261 0         0 $self->__consume_ws_opt;
2262 0         0 $self->_ObjectList;
2263 0         0 my @l = splice(@{ $self->{stack} });
  0         0  
2264 0         0 push(@props, map { [$v, $_] } @l);
  0         0  
2265             }
2266             }
2267 2         9 $self->_add_stack( @props );
2268             }
2269              
2270             # [34] PropertyList ::= PropertyListNotEmpty?
2271             sub _PropertyList {
2272 0     0   0 my $self = shift;
2273 0 0       0 if ($self->_Verb_test) {
2274 0         0 $self->_PropertyListNotEmpty;
2275             }
2276             }
2277              
2278             # [33] PropertyListNotEmptyPath ::= (VerbPath | VerbSimple) ObjectList ( ';' ( (VerbPath | VerbSimple) ObjectList )? )*
2279             sub _PropertyListNotEmptyPath {
2280 153     153   256 my $self = shift;
2281 153 100       478 if ($self->_VerbPath_test) {
2282 149         482 $self->_VerbPath;
2283             } else {
2284 4         19 $self->_VerbSimple;
2285             }
2286 153         2891 my ($v) = splice(@{ $self->{stack} });
  153         453  
2287 153         489 $self->__consume_ws_opt;
2288 153         550 $self->_ObjectList;
2289 153         271 my @l = splice(@{ $self->{stack} });
  153         388  
2290 153         348 my @props = map { [$v, $_] } @l;
  155         544  
2291 153         660 while ($self->_test(qr'\s*;')) {
2292 52         214 $self->_eat(';');
2293 52         136 $self->__consume_ws_opt;
2294 52 100 66     146 if ($self->_VerbPath_test or $self->_VerbSimple_test) {
2295 51 50       147 if ($self->_VerbPath_test) {
2296 51         138 $self->_VerbPath;
2297             } else {
2298 0         0 $self->_VerbSimple;
2299             }
2300 51         181 my ($v) = splice(@{ $self->{stack} });
  51         153  
2301 51         141 $self->__consume_ws_opt;
2302 51         143 $self->_ObjectList;
2303 51         91 my @l = splice(@{ $self->{stack} });
  51         130  
2304 51         112 push(@props, map { [$v, $_] } @l);
  51         1423  
2305             }
2306             }
2307 153         603 $self->_add_stack( @props );
2308             }
2309              
2310             # [34] PropertyListPath ::= PropertyListNotEmptyPath?
2311             sub _PropertyListPath {
2312 9     9   17 my $self = shift;
2313 9 50       32 if ($self->_Verb_test) {
2314 0         0 $self->_PropertyListNotEmptyPath;
2315             }
2316             }
2317              
2318             # [35] ObjectList ::= Object ( ',' Object )*
2319             sub _ObjectList {
2320 206     206   313 my $self = shift;
2321            
2322 206         290 my @list;
2323 206         507 $self->_Object;
2324 206         1520 push(@list, splice(@{ $self->{stack} }));
  206         491  
2325            
2326 206         566 $self->__consume_ws_opt;
2327 206         542 while ($self->_test(',')) {
2328 2         7 $self->_eat(',');
2329 2         5 $self->__consume_ws_opt;
2330 2         7 $self->_Object;
2331 2         13 push(@list, splice(@{ $self->{stack} }));
  2         6  
2332 2         7 $self->__consume_ws_opt;
2333             }
2334 206         513 $self->_add_stack( @list );
2335             }
2336              
2337             # [36] Object ::= GraphNode
2338             sub _Object {
2339 208     208   293 my $self = shift;
2340 208         562 $self->_GraphNode;
2341             }
2342              
2343             # [37] Verb ::= VarOrIRIref | 'a'
2344             sub _Verb_test {
2345 9     9   17 my $self = shift;
2346 9         1591 return $self->_test( qr/a[\n\t\r <]|[?\$]|<|${r_PNAME_LN}|${r_PNAME_NS}/ );
2347             }
2348              
2349             sub _Verb {
2350 2     2   4 my $self = shift;
2351 2 50       9 if ($self->_test(qr/a[\n\t\r <]/)) {
2352 0         0 $self->_eat('a');
2353 0         0 $self->__consume_ws;
2354 0         0 my $type = RDF::Query::Node::Resource->new( $rdf->type->uri_value );
2355 0         0 $self->_add_stack( $type );
2356             } else {
2357 2         7 $self->_VarOrIRIref;
2358             }
2359             }
2360              
2361             # VerbSimple ::= Var
2362             sub _VerbSimple_test {
2363 1     1   3 my $self = shift;
2364 1 50       5 return 1 if ($self->_test(qr/[\$?]/));
2365             }
2366              
2367             sub _VerbSimple {
2368 4     4   10 my $self = shift;
2369 4         14 $self->_Var;
2370             }
2371              
2372             # VerbPath ::= Path
2373             sub _VerbPath_test {
2374 256     256   381 my $self = shift;
2375 256 100       690 return 1 if ($self->_IRIref_test);
2376 47 100       1329 return 1 if ($self->_test(qr/\^|[|(a!]/));
2377 5         61 return 0;
2378             }
2379              
2380             sub _VerbPath {
2381 200     200   336 my $self = shift;
2382 200         674 $self->_Path
2383             }
2384              
2385             # [74] Path ::= PathAlternative
2386             sub _Path {
2387 200     200   306 my $self = shift;
2388             # my $distinct = 1;
2389             # if ($self->_test(qr/DISTINCT[(]/i)) {
2390             # $self->_eat(qr/DISTINCT[(]/i);
2391             # $self->__consume_ws_opt;
2392             # $distinct = 1;
2393             # }
2394 200         498 $self->_PathAlternative;
2395             # if ($distinct) {
2396             # $self->__consume_ws_opt;
2397             # $self->_eat(qr/[)]/);
2398             # $self->__consume_ws_opt;
2399             # my ($path) = splice(@{ $self->{stack} });
2400             # $self->_add_stack( ['PATH', 'DISTINCT', $path] );
2401             # }
2402             }
2403              
2404             ################################################################################
2405              
2406             # [75] PathAlternative ::= PathSequence ( '|' PathSequence )*
2407             sub _PathAlternative {
2408 200     200   323 my $self = shift;
2409 200         534 $self->_PathSequence;
2410 200         684 $self->__consume_ws_opt;
2411 200         781 while ($self->_test(qr/[|]/)) {
2412 0         0 my ($lhs) = splice(@{ $self->{stack} });
  0         0  
2413 0         0 $self->_eat(qr/[|]/);
2414 0         0 $self->__consume_ws_opt;
2415             # $self->_PathOneInPropertyClass;
2416 0         0 $self->_PathSequence;
2417 0         0 $self->__consume_ws_opt;
2418 0         0 my ($rhs) = splice(@{ $self->{stack} });
  0         0  
2419 0         0 $self->_add_stack( ['PATH', '|', $lhs, $rhs] );
2420             }
2421             }
2422              
2423             # [76] PathSequence ::= PathEltOrInverse ( '/' PathEltOrInverse | '^' PathElt )*
2424             sub _PathSequence {
2425 200     200   264 my $self = shift;
2426 200         548 $self->_PathEltOrInverse;
2427 200         879 $self->__consume_ws_opt;
2428 200         1115 while ($self->_test(qr<[/^]>)) {
2429 5         14 my $op;
2430 5         10 my ($lhs) = splice(@{ $self->{stack} });
  5         19  
2431 5 50       22 if ($self->_test(qr</>)) {
2432 5         23 $op = $self->_eat(qr</>);
2433 5         23 $self->__consume_ws_opt;
2434 5         20 $self->_PathEltOrInverse;
2435             } else {
2436 0         0 $op = $self->_eat(qr<\^>);
2437 0         0 $self->__consume_ws_opt;
2438 0         0 $self->_PathElt;
2439             }
2440 5         24 my ($rhs) = splice(@{ $self->{stack} });
  5         15  
2441 5         20 $self->_add_stack( ['PATH', $op, $lhs, $rhs] );
2442             }
2443             }
2444              
2445             # [77] PathElt ::= PathPrimary PathMod?
2446             sub _PathElt {
2447 205     205   327 my $self = shift;
2448 205         571 $self->_PathPrimary;
2449             # $self->__consume_ws_opt;
2450 205 100       7011 if ($self->_PathMod_test) {
2451 2         6 my @path = splice(@{ $self->{stack} });
  2         8  
2452 2         7 $self->_PathMod;
2453 2         9 my ($mod) = splice(@{ $self->{stack} });
  2         5  
2454 2 50       9 if (defined($mod)) {
2455 2         9 $self->_add_stack( ['PATH', $mod, @path] );
2456             } else {
2457             # this might happen if we descend into _PathMod by mistaking a + as
2458             # a path modifier, but _PathMod figures out it's actually part of a
2459             # signed numeric object that follows the path
2460 0         0 $self->_add_stack( @path );
2461             }
2462             }
2463             }
2464              
2465             # [78] PathEltOrInverse ::= PathElt | '^' PathElt
2466             sub _PathEltOrInverse {
2467 205     205   331 my $self = shift;
2468 205 50       909 if ($self->_test(qr/\^/)) {
2469 0         0 $self->_eat(qr<\^>);
2470 0         0 $self->__consume_ws_opt;
2471 0         0 $self->_PathElt;
2472 0         0 my @props = splice(@{ $self->{stack} });
  0         0  
2473 0         0 $self->_add_stack( [ 'PATH', '^', @props ] );
2474             } else {
2475 205         578 $self->_PathElt;
2476             }
2477             }
2478              
2479             # [79] PathMod ::= ( '*' | '?' | '+' | '{' ( Integer ( ',' ( '}' | Integer '}' ) | '}' ) ) )
2480             sub _PathMod_test {
2481 205     205   359 my $self = shift;
2482 205 100       877 return 1 if ($self->_test(qr/[*?+{]/));
2483             }
2484              
2485             sub _PathMod {
2486 2     2   4 my $self = shift;
2487 2 50       10 if ($self->_test(qr/[*?+]/)) {
2488 2 50       9 if ($self->_test(qr/[+][.0-9]/)) {
2489 0         0 return;
2490             } else {
2491 2         9 $self->_add_stack( $self->_eat(qr/[*?+]/) );
2492 2         9 $self->__consume_ws_opt;
2493             }
2494             ### path repetition range syntax :path{n,m}; removed from 1.1 Query 2LC
2495             # } else {
2496             # $self->_eat(qr/{/);
2497             # $self->__consume_ws_opt;
2498             # my $value = 0;
2499             # if ($self->_test(qr/}/)) {
2500             # throw RDF::Query::Error::ParseError -text => "Syntax error: Empty Path Modifier";
2501             # }
2502             # if ($self->_test($r_INTEGER)) {
2503             # $value = $self->_eat( $r_INTEGER );
2504             # $self->__consume_ws_opt;
2505             # }
2506             # if ($self->_test(qr/,/)) {
2507             # $self->_eat(qr/,/);
2508             # $self->__consume_ws_opt;
2509             # if ($self->_test(qr/}/)) {
2510             # $self->_eat(qr/}/);
2511             # $self->_add_stack( "$value-" );
2512             # } else {
2513             # my $end = $self->_eat( $r_INTEGER );
2514             # $self->__consume_ws_opt;
2515             # $self->_eat(qr/}/);
2516             # $self->_add_stack( "$value-$end" );
2517             # }
2518             # } else {
2519             # $self->_eat(qr/}/);
2520             # $self->_add_stack( "$value" );
2521             # }
2522             }
2523             }
2524              
2525             # [80] PathPrimary ::= ( IRIref | 'a' | '!' PathNegatedPropertyClass | '(' Path ')' )
2526             sub _PathPrimary {
2527 205     205   336 my $self = shift;
2528 205 100       469 if ($self->_IRIref_test) {
    50          
    0          
2529 163         479 $self->_IRIref;
2530             } elsif ($self->_test(qr/a[\n\t\r <]/)) {
2531 42         192 $self->_eat(qr/a/);
2532 42         507 my $type = RDF::Query::Node::Resource->new( $rdf->type->uri_value );
2533 42         2839 $self->_add_stack( $type );
2534             } elsif ($self->_test(qr/[!]/)) {
2535 0         0 $self->_eat(qr/[!]/);
2536 0         0 $self->__consume_ws_opt;
2537 0         0 $self->_PathNegatedPropertyClass;
2538 0         0 my (@path) = splice(@{ $self->{stack} });
  0         0  
2539 0         0 $self->_add_stack( ['PATH', '!', @path] );
2540             } else {
2541 0         0 $self->_eat(qr/[(]/);
2542 0         0 $self->__consume_ws_opt;
2543 0         0 $self->_Path;
2544 0         0 $self->__consume_ws_opt;
2545 0         0 $self->_eat(qr/[)]/);
2546             }
2547             }
2548              
2549             # [81] PathNegatedPropertyClass ::= ( PathOneInPropertyClass | '(' ( PathOneInPropertyClass ( '|' PathOneInPropertyClass )* )? ')' )
2550             sub _PathNegatedPropertyClass {
2551 0     0   0 my $self = shift;
2552 0 0       0 if ($self->_test(qr/[(]/)) {
2553 0         0 $self->_eat(qr/[(]/);
2554 0         0 $self->__consume_ws_opt;
2555            
2556 0         0 my @nodes;
2557 0 0       0 if ($self->_PathOneInPropertyClass_test) {
2558 0         0 $self->_PathOneInPropertyClass;
2559 0         0 push(@nodes, splice(@{ $self->{stack} }));
  0         0  
2560 0         0 $self->__consume_ws_opt;
2561 0         0 while ($self->_test(qr/[|]/)) {
2562 0         0 $self->_eat(qr/[|]/);
2563 0         0 $self->__consume_ws_opt;
2564 0         0 $self->_PathOneInPropertyClass;
2565 0         0 $self->__consume_ws_opt;
2566 0         0 push(@nodes, splice(@{ $self->{stack} }));
  0         0  
2567             # $self->_add_stack( ['PATH', '|', $lhs, $rhs] );
2568             }
2569             }
2570 0         0 $self->_eat(qr/[)]/);
2571 0         0 $self->_add_stack( @nodes );
2572             } else {
2573 0         0 $self->_PathOneInPropertyClass;
2574             }
2575             }
2576              
2577             # [82] PathOneInPropertyClass ::= IRIref | 'a'
2578             sub _PathOneInPropertyClass_test {
2579 0     0   0 my $self = shift;
2580 0 0       0 return 1 if $self->_IRIref_test;
2581 0 0       0 return 1 if ($self->_test(qr/a[|)\n\t\r <]/));
2582 0 0       0 return 1 if ($self->_test(qr/\^/));
2583 0         0 return 0;
2584             }
2585              
2586             sub _PathOneInPropertyClass {
2587 0     0   0 my $self = shift;
2588 0         0 my $rev = 0;
2589 0 0       0 if ($self->_test(qr/\^/)) {
2590 0         0 $self->_eat(qr/\^/);
2591 0         0 $rev = 1;
2592             }
2593 0 0       0 if ($self->_test(qr/a[|)\n\t\r <]/)) {
2594 0         0 $self->_eat(qr/a/);
2595 0         0 my $type = RDF::Query::Node::Resource->new( $rdf->type->uri_value );
2596 0 0       0 if ($rev) {
2597 0         0 $self->_add_stack( [ 'PATH', '^', $type ] );
2598             } else {
2599 0         0 $self->_add_stack( $type );
2600             }
2601             } else {
2602 0         0 $self->_IRIref;
2603 0 0       0 if ($rev) {
2604 0         0 my ($path) = splice(@{ $self->{stack} });
  0         0  
2605 0         0 $self->_add_stack( [ 'PATH', '^', $path ] );
2606             }
2607             }
2608             }
2609              
2610             ################################################################################
2611              
2612             # [38] TriplesNode ::= Collection | BlankNodePropertyList
2613             sub _TriplesNode_test {
2614 359     359   514 my $self = shift;
2615 359         1451 return $self->_test(qr/[[(](?![\n\r\t ]*\])(?![\n\r\t ]*\))/);
2616             }
2617              
2618             sub _TriplesNode {
2619 13     13   24 my $self = shift;
2620 13 50       59 if ($self->_test(qr/\(/)) {
2621 0         0 $self->_Collection;
2622             } else {
2623 13         53 $self->_BlankNodePropertyList;
2624             }
2625             }
2626              
2627             # [39] BlankNodePropertyList ::= '[' PropertyListNotEmpty ']'
2628             sub _BlankNodePropertyList {
2629 13     13   28 my $self = shift;
2630 13 50       50 if (my $where = $self->{__no_bnodes}) {
2631 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Blank nodes not allowed in $where";
2632             }
2633 13         38 $self->_eat('[');
2634 13         33 $self->__consume_ws_opt;
2635             # $self->_PropertyListNotEmpty;
2636 13         51 $self->_PropertyListNotEmptyPath;
2637 13         38 $self->__consume_ws_opt;
2638 13         41 $self->_eat(']');
2639            
2640 13         25 my @props = splice(@{ $self->{stack} });
  13         42  
2641 13         100 my $subj = $self->new_blank;
2642 13         106 my @triples = map { $self->__new_statement( $subj, @$_ ) } @props;
  21         222  
2643 13         287 $self->_add_patterns( @triples );
2644 13         37 $self->_add_stack( $subj );
2645             }
2646              
2647             # [40] Collection ::= '(' GraphNode+ ')'
2648             sub _Collection {
2649 0     0   0 my $self = shift;
2650 0         0 $self->_eat('(');
2651 0         0 $self->__consume_ws_opt;
2652 0         0 $self->_GraphNode;
2653 0         0 $self->__consume_ws_opt;
2654            
2655 0         0 my @nodes;
2656 0         0 push(@nodes, splice(@{ $self->{stack} }));
  0         0  
2657            
2658 0         0 while ($self->_GraphNode_test) {
2659 0         0 $self->_GraphNode;
2660 0         0 $self->__consume_ws_opt;
2661 0         0 push(@nodes, splice(@{ $self->{stack} }));
  0         0  
2662             }
2663            
2664 0         0 $self->_eat(')');
2665            
2666 0         0 my $subj = $self->new_blank;
2667 0         0 my $cur = $subj;
2668 0         0 my $last;
2669              
2670 0         0 my $first = RDF::Query::Node::Resource->new( $rdf->first->uri_value );
2671 0         0 my $rest = RDF::Query::Node::Resource->new( $rdf->rest->uri_value );
2672 0         0 my $nil = RDF::Query::Node::Resource->new( $rdf->nil->uri_value );
2673              
2674            
2675 0         0 my @triples;
2676 0         0 foreach my $node (@nodes) {
2677 0         0 push(@triples, $self->__new_statement( $cur, $first, $node ) );
2678 0         0 my $new = $self->new_blank;
2679 0         0 push(@triples, $self->__new_statement( $cur, $rest, $new ) );
2680 0         0 $last = $cur;
2681 0         0 $cur = $new;
2682             }
2683 0         0 pop(@triples);
2684 0         0 push(@triples, $self->__new_statement( $last, $rest, $nil ));
2685 0         0 $self->_add_patterns( @triples );
2686            
2687 0         0 $self->_add_stack( $subj );
2688             }
2689              
2690             # [41] GraphNode ::= VarOrTerm | TriplesNode
2691             sub _GraphNode_test {
2692 0     0   0 my $self = shift;
2693             # VarOrTerm | TriplesNode -> (Var | GraphTerm) | (Collection | BlankNodePropertyList) -> Var | IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL | Collection | BlankNodePropertyList
2694             # but since a triple can't start with a literal, this is reduced to:
2695             # Var | IRIref | BlankNode | NIL
2696 0         0 return $self->_test(qr/[\$?]|<|['"]|(true\b|false\b)|([+-]?\d)|_:|${r_ANON}|${r_NIL}|\[|[[(]/);
2697             }
2698              
2699             sub _GraphNode {
2700 208     208   287 my $self = shift;
2701 208 100       534 if ($self->_TriplesNode_test) {
2702 4         17 $self->_TriplesNode;
2703             } else {
2704 204         503 $self->_VarOrTerm;
2705             }
2706             }
2707              
2708             # [42] VarOrTerm ::= Var | GraphTerm
2709             sub _VarOrTerm_test {
2710 0     0   0 my $self = shift;
2711 0 0       0 return 1 if ($self->_test(qr/[\$?]/));
2712 0 0       0 return 1 if ($self->_IRIref_test);
2713 0 0       0 return 1 if ($self->_test(qr/[<'".0-9]|(true|false)\b|_:|\([\n\r\t ]*\)/));
2714 0         0 return 0;
2715             }
2716              
2717             sub _VarOrTerm {
2718 346     346   518 my $self = shift;
2719 346 100       1096 if ($self->{tokens} =~ m'^[?$]') {
2720 225         537 $self->_Var;
2721             } else {
2722 121         363 $self->_GraphTerm;
2723             }
2724             }
2725              
2726             # [43] VarOrIRIref ::= Var | IRIref
2727             sub _VarOrIRIref_test {
2728 2     2   4 my $self = shift;
2729 2         497 return $self->_test(qr/[\$?]|<|${r_PNAME_LN}|${r_PNAME_NS}/);
2730             }
2731              
2732             sub _VarOrIRIref {
2733 19     19   34 my $self = shift;
2734 19 100       73 if ($self->{tokens} =~ m'^[?$]') {
2735 8         30 $self->_Var;
2736             } else {
2737 11         38 $self->_IRIref;
2738             }
2739             }
2740              
2741             # [44] Var ::= VAR1 | VAR2
2742             sub _Var {
2743 387     387   583 my $self = shift;
2744 387 50       1023 if ($self->{__data_pattern}) {
2745 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Variable found where Term expected";
2746             }
2747              
2748 387 50       876 my $var = ($self->_test( $r_VAR1 )) ? $self->_eat( $r_VAR1 ) : $self->_eat( $r_VAR2 );
2749 387         4102 $self->_add_stack( RDF::Query::Node::Variable->new( substr($var,1) ) );
2750             }
2751              
2752             # [45] GraphTerm ::= IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL
2753             sub _GraphTerm {
2754 126     126   197 my $self = shift;
2755 126 50 100     506 if ($self->_test(qr/(true|false)\b/)) {
    50          
    100          
    100          
    100          
2756 0         0 $self->_BooleanLiteral;
2757             } elsif ($self->_test('(')) {
2758 0         0 $self->_NIL;
2759             } elsif ($self->_test( $r_ANON ) or $self->_test('_:')) {
2760 10         44 $self->_BlankNode;
2761             } elsif ($self->_test(qr/[-+]?\d/)) {
2762 3         11 $self->_NumericLiteral;
2763             } elsif ($self->_test(qr/['"]/)) {
2764 33         118 $self->_RDFLiteral;
2765             } else {
2766 80         250 $self->_IRIref;
2767             }
2768             }
2769              
2770             # [46] Expression ::= ConditionalOrExpression
2771             sub _Expression {
2772 113     113   167 my $self = shift;
2773 113         333 $self->_ConditionalOrExpression;
2774             }
2775              
2776             # [47] ConditionalOrExpression ::= ConditionalAndExpression ( '||' ConditionalAndExpression )*
2777             sub _ConditionalOrExpression {
2778 113     113   160 my $self = shift;
2779 113         167 my @list;
2780            
2781 113         322 $self->_ConditionalAndExpression;
2782 113         187 push(@list, splice(@{ $self->{stack} }));
  113         244  
2783            
2784 113         269 $self->__consume_ws_opt;
2785 113         312 while ($self->_test('||')) {
2786 0         0 $self->_eat('||');
2787 0         0 $self->__consume_ws_opt;
2788 0         0 $self->_ConditionalAndExpression;
2789 0         0 push(@list, splice(@{ $self->{stack} }));
  0         0  
2790             }
2791            
2792 113 50       277 if (scalar(@list) > 1) {
2793 0         0 $self->_add_stack( $self->new_function_expression( 'sparql:logical-or', @list ) );
2794             } else {
2795 113         264 $self->_add_stack( @list );
2796             }
2797 113 50       185 Carp::confess $self->{tokens} if (scalar(@{ $self->{stack} }) == 0);
  113         429  
2798             }
2799              
2800             # [48] ConditionalAndExpression ::= ValueLogical ( '&&' ValueLogical )*
2801             sub _ConditionalAndExpression {
2802 113     113   156 my $self = shift;
2803 113         299 $self->_ValueLogical;
2804 113         473 my @list = splice(@{ $self->{stack} });
  113         352  
2805            
2806 113         282 $self->__consume_ws_opt;
2807 113         280 while ($self->_test('&&')) {
2808 2         7 $self->_eat('&&');
2809 2         5 $self->__consume_ws_opt;
2810 2         7 $self->_ValueLogical;
2811 2         7 push(@list, splice(@{ $self->{stack} }));
  2         7  
2812             }
2813            
2814 113 100       284 if (scalar(@list) > 1) {
2815 2         9 $self->_add_stack( $self->new_function_expression( 'sparql:logical-and', @list ) );
2816             } else {
2817 111         270 $self->_add_stack( @list );
2818             }
2819             }
2820              
2821             # [49] ValueLogical ::= RelationalExpression
2822             sub _ValueLogical {
2823 115     115   151 my $self = shift;
2824 115         328 $self->_RelationalExpression;
2825             }
2826              
2827             # [50] RelationalExpression ::= NumericExpression ( '=' NumericExpression | '!=' NumericExpression | '<' NumericExpression | '>' NumericExpression | '<=' NumericExpression | '>=' NumericExpression )?
2828             sub _RelationalExpression {
2829 115     115   164 my $self = shift;
2830 115         303 $self->_NumericExpression;
2831            
2832 115         264 $self->__consume_ws_opt;
2833 115 100       455 if ($self->_test(qr/[!<>]?=|[<>]/)) {
    100          
2834 13 50       39 if ($self->_test( $r_IRI_REF )) {
2835 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: IRI found where expression expected";
2836             }
2837 13         37 my @list = splice(@{ $self->{stack} });
  13         41  
2838 13         91 my $op = $self->_eat(qr/[!<>]?=|[<>]/);
2839 13 100       67 $op = '==' if ($op eq '=');
2840 13         39 $self->__consume_ws_opt;
2841 13         36 $self->_NumericExpression;
2842 13         23 push(@list, splice(@{ $self->{stack} }));
  13         35  
2843 13         82 $self->_add_stack( $self->new_binary_expression( $op, @list ) );
2844             } elsif ($self->_test(qr/(NOT )?IN/)) {
2845 4         7 my @list = splice(@{ $self->{stack} });
  4         14  
2846 4         21 my $op = lc($self->_eat(qr/(NOT )?IN/));
2847 4         22 $op =~ s/\s+//g;
2848 4         12 $self->__consume_ws_opt;
2849 4         15 $self->_ExpressionList();
2850 4         6 push(@list, splice(@{ $self->{stack} }));
  4         35  
2851 4         29 $self->_add_stack( $self->new_function_expression( "sparql:$op", @list ) );
2852             }
2853             }
2854              
2855             sub _ExpressionList {
2856 4     4   9 my $self = shift;
2857 4         10 $self->_eat('(');
2858 4         10 $self->__consume_ws_opt;
2859 4         7 my @args;
2860 4 100       12 unless ($self->_test(')')) {
2861 3         11 $self->_Expression;
2862 3         7 push( @args, splice(@{ $self->{stack} }) );
  3         8  
2863 3         9 while ($self->_test(',')) {
2864 4         10 $self->_eat(',');
2865 4         9 $self->__consume_ws_opt;
2866 4         11 $self->_Expression;
2867 4         7 push( @args, splice(@{ $self->{stack} }) );
  4         30  
2868             }
2869             }
2870 4         11 $self->_eat(')');
2871 4         11 $self->_add_stack( @args );
2872             }
2873              
2874             # [51] NumericExpression ::= AdditiveExpression
2875             sub _NumericExpression {
2876 128     128   171 my $self = shift;
2877 128         339 $self->_AdditiveExpression;
2878             }
2879              
2880             # [52] AdditiveExpression ::= MultiplicativeExpression ( '+' MultiplicativeExpression | '-' MultiplicativeExpression | NumericLiteralPositive | NumericLiteralNegative )*
2881             sub _AdditiveExpression {
2882 128     128   177 my $self = shift;
2883 128         331 $self->_MultiplicativeExpression;
2884 128         212 my ($expr) = splice(@{ $self->{stack} });
  128         283  
2885            
2886 128         303 $self->__consume_ws_opt;
2887 128         522 while ($self->_test(qr/[-+]/)) {
2888 1         7 my $op = $self->_eat(qr/[-+]/);
2889 1         4 $self->__consume_ws_opt;
2890 1         4 $self->_MultiplicativeExpression;
2891 1         1 my ($rhs) = splice(@{ $self->{stack} });
  1         3  
2892 1         10 $expr = $self->new_binary_expression( $op, $expr, $rhs );
2893             }
2894 128         422 $self->_add_stack( $expr );
2895             }
2896              
2897             # [53] MultiplicativeExpression ::= UnaryExpression ( '*' UnaryExpression | '/' UnaryExpression )*
2898             sub _MultiplicativeExpression {
2899 129     129   224 my $self = shift;
2900 129         349 $self->_UnaryExpression;
2901 129         3264 my ($expr) = splice(@{ $self->{stack} });
  129         317  
2902            
2903 129         361 $self->__consume_ws_opt;
2904 129         578 while ($self->_test(qr#[*/]#)) {
2905 1         8 my $op = $self->_eat(qr#[*/]#);
2906 1         5 $self->__consume_ws_opt;
2907 1         4 $self->_UnaryExpression;
2908 1         36 my ($rhs) = splice(@{ $self->{stack} });
  1         4  
2909 1         6 $expr = $self->new_binary_expression( $op, $expr, $rhs );
2910             }
2911 129         454 $self->_add_stack( $expr );
2912             }
2913              
2914             # [54] UnaryExpression ::= '!' PrimaryExpression | '+' PrimaryExpression | '-' PrimaryExpression | PrimaryExpression
2915             sub _UnaryExpression {
2916 130     130   197 my $self = shift;
2917 130 100       282 if ($self->_test('!')) {
    50          
    100          
2918 3         8 $self->_eat('!');
2919 3         6 $self->__consume_ws_opt;
2920 3         10 $self->_PrimaryExpression;
2921 3         39 my ($expr) = splice(@{ $self->{stack} });
  3         9  
2922 3         19 my $not = $self->new_unary_expression( '!', $expr );
2923 3         10 $self->_add_stack( $not );
2924             } elsif ($self->_test('+')) {
2925 0         0 $self->_eat('+');
2926 0         0 $self->__consume_ws_opt;
2927 0         0 $self->_PrimaryExpression;
2928 0         0 my ($expr) = splice(@{ $self->{stack} });
  0         0  
2929            
2930             ### if it's just a literal, force the positive down into the literal
2931 0 0 0     0 if (blessed($expr) and $expr->isa('RDF::Trine::Node::Literal') and $expr->is_numeric_type) {
      0        
2932 0         0 my $value = '+' . $expr->literal_value;
2933 0         0 $expr->literal_value( $value );
2934 0         0 $self->_add_stack( $expr );
2935             } else {
2936 0         0 $self->_add_stack( $expr );
2937             }
2938             } elsif ($self->_test('-')) {
2939 2         8 $self->_eat('-');
2940 2         6 $self->__consume_ws_opt;
2941 2         6 $self->_PrimaryExpression;
2942 2         73 my ($expr) = splice(@{ $self->{stack} });
  2         6  
2943            
2944             ### if it's just a literal, force the negative down into the literal instead of make an unnecessary multiplication.
2945 2 50 33     30 if (blessed($expr) and $expr->isa('RDF::Trine::Node::Literal') and $expr->is_numeric_type) {
      33        
2946 2         8 my $value = -1 * $expr->literal_value;
2947 2         22 $expr->literal_value( $value );
2948 2         15 $self->_add_stack( $expr );
2949             } else {
2950 0         0 my $int = $xsd->integer->uri_value;
2951 0         0 my $neg = $self->new_binary_expression( '*', $self->new_literal('-1', undef, $int), $expr );
2952 0         0 $self->_add_stack( $neg );
2953             }
2954             } else {
2955 125         319 $self->_PrimaryExpression;
2956             }
2957             }
2958              
2959             # [55] PrimaryExpression ::= BrackettedExpression | BuiltInCall | IRIrefOrFunction | RDFLiteral | NumericLiteral | BooleanLiteral | Var
2960             sub _PrimaryExpression {
2961 130     130   198 my $self = shift;
2962 130 100       309 if ($self->_BrackettedExpression_test) {
    100          
    100          
    100          
    50          
    100          
2963 2         8 $self->_BrackettedExpression;
2964             } elsif ($self->_BuiltInCall_test) {
2965 34         134 $self->_BuiltInCall;
2966             } elsif ($self->_IRIref_test) {
2967 11         54 $self->_IRIrefOrFunction;
2968             } elsif ($self->_test(qr/[\$?]/)) {
2969 47         153 $self->_Var;
2970             } elsif ($self->_test(qr/(true|false)\b/)) {
2971 0         0 $self->_BooleanLiteral;
2972             } elsif ($self->_test(qr/[-+]?\d/)) {
2973 26         86 $self->_NumericLiteral;
2974             } else { # if ($self->_test(qr/['"]/)) {
2975 10         40 $self->_RDFLiteral;
2976             }
2977             }
2978              
2979             # [56] BrackettedExpression ::= '(' Expression ')'
2980             sub _BrackettedExpression_test {
2981 152     152   237 my $self = shift;
2982 152         380 return $self->_test('(');
2983             }
2984              
2985             sub _BrackettedExpression {
2986 27     27   50 my $self = shift;
2987 27         92 $self->_eat('(');
2988 27         68 $self->__consume_ws_opt;
2989 27         89 $self->_Expression;
2990 27         69 $self->__consume_ws_opt;
2991 27         74 $self->_eat(')');
2992             }
2993              
2994             sub _Aggregate {
2995 21     21   39 my $self = shift;
2996 21         178 my $op = uc( $self->_eat( $r_AGGREGATE_CALL ) );
2997 21         98 $self->__consume_ws_opt;
2998 21         58 $self->_eat('(');
2999 21         46 $self->__consume_ws_opt;
3000 21         33 my $distinct = 0;
3001 21 100       100 if ($self->_test( qr/DISTINCT/i )) {
3002 1         6 $self->_eat( qr/DISTINCT\s*/i );
3003 1         4 $self->__consume_ws_opt;
3004 1         3 $distinct = 1;
3005             }
3006            
3007 21         70 my (@expr, %options);
3008 21 50       152 if ($self->_test('*')) {
3009 0         0 @expr = $self->_eat('*');
3010             } else {
3011 21         67 $self->_Expression;
3012 21         36 push(@expr, splice(@{ $self->{stack} }));
  21         49  
3013 21 100       67 if ($op eq 'GROUP_CONCAT') {
3014 1         6 $self->__consume_ws_opt;
3015 1         5 while ($self->_test(qr/,/)) {
3016 0         0 $self->_eat(qr/,/);
3017 0         0 $self->__consume_ws_opt;
3018 0         0 $self->_Expression;
3019 0         0 push(@expr, splice(@{ $self->{stack} }));
  0         0  
3020             }
3021 1         4 $self->__consume_ws_opt;
3022 1 50       5 if ($self->_test(qr/;/)) {
3023 0         0 $self->_eat(qr/;/);
3024 0         0 $self->__consume_ws_opt;
3025 0 0       0 if ($self->{args}{allow_typos}) {
3026 0         0 $self->_eat(qr/SEP[AE]RATOR/i); # accept common typo
3027             } else {
3028 0         0 $self->_eat(qr/SEPARATOR/i);
3029             }
3030 0         0 $self->__consume_ws_opt;
3031 0         0 $self->_eat(qr/=/);
3032 0         0 $self->__consume_ws_opt;
3033 0         0 $self->_String;
3034 0         0 my ($sep) = splice(@{ $self->{stack} });
  0         0  
3035 0         0 $options{ seperator } = $sep;
3036             }
3037             }
3038             }
3039 21         58 $self->__consume_ws_opt;
3040            
3041 21 50       43 my $arg = join(',', map { blessed($_) ? $_->as_sparql : $_ } @expr);
  21         177  
3042 21 100       510 if ($distinct) {
3043 1         3 $arg = 'DISTINCT ' . $arg;
3044             }
3045 21         103 my $name = sprintf('%s(%s)', $op, $arg);
3046 21         54 $self->_eat(')');
3047            
3048 21 100       129 $self->{build}{__aggregate}{ $name } = [ (($distinct) ? "${op}-DISTINCT" : $op), \%options, @expr ];
3049            
3050 21 50       55 my @vars = grep { blessed($_) and $_->isa('RDF::Query::Node::Variable') } @expr;
  21         201  
3051 21         105 $self->_add_stack( RDF::Query::Node::Variable::ExpressionProxy->new($name, @vars) );
3052            
3053             }
3054              
3055             # [57] BuiltInCall ::= 'STR' '(' Expression ')' | 'LANG' '(' Expression ')' | 'LANGMATCHES' '(' Expression ',' Expression ')' | 'DATATYPE' '(' Expression ')' | 'BOUND' '(' Var ')' | 'sameTerm' '(' Expression ',' Expression ')' | 'isIRI' '(' Expression ')' | 'isURI' '(' Expression ')' | 'isBLANK' '(' Expression ')' | 'isLITERAL' '(' Expression ')' | RegexExpression
3056             sub _BuiltInCall_test {
3057 153     153   238 my $self = shift;
3058 153 100       400 if ($self->{__aggregate_call_ok}) {
3059 86 100       209 return 1 if ($self->_test( $r_AGGREGATE_CALL ));
3060             }
3061 132 100       672 return 1 if $self->_test(qr/((NOT\s+)?EXISTS)|COALESCE/i);
3062 129 50       700 return 1 if $self->_test(qr/ABS|CEIL|FLOOR|ROUND|CONCAT|SUBSTR|STRLEN|UCASE|LCASE|ENCODE_FOR_URI|CONTAINS|STRSTARTS|STRENDS|RAND|MD5|SHA1|SHA224|SHA256|SHA384|SHA512|HOURS|MINUTES|SECONDS|DAY|MONTH|YEAR|TIMEZONE|TZ|NOW/i);
3063 129         1586 return $self->_test(qr/UUID|STRUUID|STR|STRDT|STRLANG|STRBEFORE|STRAFTER|REPLACE|BNODE|IRI|URI|LANG|LANGMATCHES|DATATYPE|BOUND|sameTerm|isIRI|isURI|isBLANK|isLITERAL|REGEX|IF|isNumeric/i);
3064             }
3065              
3066             sub _BuiltInCall {
3067 34     34   61 my $self = shift;
3068 34 100 100     188 if ($self->{__aggregate_call_ok} and $self->_test( $r_AGGREGATE_CALL )) {
    100          
    100          
    100          
3069 21         71 $self->_Aggregate;
3070             } elsif ($self->_test(qr/(NOT\s+)?EXISTS/i)) {
3071 1         5 my $op = $self->_eat(qr/(NOT\s+)?EXISTS/i);
3072 1         5 $self->__consume_ws_opt;
3073 1         4 local($self->{filters}) = [];
3074 1         5 $self->_GroupGraphPattern;
3075 1         4 my $cont = $self->_remove_pattern;
3076 1         6 my $iri = RDF::Query::Node::Resource->new( 'sparql:exists' );
3077 1         24 my $func = $self->new_function_expression($iri, $cont);
3078 1 50       6 if ($op =~ /^NOT/i) {
3079 1         8 $self->_add_stack( $self->new_unary_expression( '!', $func ) );
3080            
3081             } else {
3082 0         0 $self->_add_stack( $func );
3083             }
3084             } elsif ($self->_test(qr/COALESCE|BNODE|CONCAT|SUBSTR|RAND|NOW/i)) {
3085             # n-arg functions that take expressions
3086 5         21 my $op = $self->_eat(qr/COALESCE|BNODE|CONCAT|SUBSTR|RAND|NOW/i);
3087 5         43 my $iri = RDF::Query::Node::Resource->new( 'sparql:' . lc($op) );
3088 5         94 $self->_ArgList;
3089 5         9 my @args = splice(@{ $self->{stack} });
  5         13  
3090 5         30 my $func = $self->new_function_expression( $iri, @args );
3091 5         19 $self->_add_stack( $func );
3092             } elsif ($self->_RegexExpression_test) {
3093 2         9 $self->_RegexExpression;
3094             } else {
3095 5         27 my $op = $self->_eat( qr/\w+/ );
3096 5         43 my $iri = RDF::Query::Node::Resource->new( 'sparql:' . lc($op) );
3097 5         85 $self->__consume_ws_opt;
3098 5         16 $self->_eat('(');
3099 5         15 $self->__consume_ws_opt;
3100 5 50       54 if ($op =~ /^(STR)?UUID$/i) {
    100          
    50          
    50          
3101             # no-arg functions
3102 0         0 $self->_add_stack( $self->new_function_expression($iri) );
3103             } elsif ($op =~ /^(STR|URI|IRI|LANG|DATATYPE|isIRI|isURI|isBLANK|isLITERAL|isNumeric|ABS|CEIL|FLOOR|ROUND|STRLEN|UCASE|LCASE|ENCODE_FOR_URI|MD5|SHA1|SHA224|SHA256|SHA384|SHA512|HOURS|MINUTES|SECONDS|DAY|MONTH|YEAR|TIMEZONE|TZ)$/i) {
3104             ### one-arg functions that take an expression
3105 2         9 $self->_Expression;
3106 2         5 my ($expr) = splice(@{ $self->{stack} });
  2         8  
3107 2         20 $self->_add_stack( $self->new_function_expression($iri, $expr) );
3108             } elsif ($op =~ /^(STRDT|STRLANG|LANGMATCHES|sameTerm|CONTAINS|STRSTARTS|STRENDS|STRBEFORE|STRAFTER)$/i) {
3109             ### two-arg functions that take expressions
3110 0         0 $self->_Expression;
3111 0         0 my ($arg1) = splice(@{ $self->{stack} });
  0         0  
3112 0         0 $self->__consume_ws_opt;
3113 0         0 $self->_eat(',');
3114 0         0 $self->__consume_ws_opt;
3115 0         0 $self->_Expression;
3116 0         0 my ($arg2) = splice(@{ $self->{stack} });
  0         0  
3117 0         0 $self->_add_stack( $self->new_function_expression($iri, $arg1, $arg2) );
3118             } elsif ($op =~ /^(IF|REPLACE)$/i) {
3119             ### three-arg functions that take expressions
3120 0         0 $self->_Expression;
3121 0         0 my ($arg1) = splice(@{ $self->{stack} });
  0         0  
3122 0         0 $self->__consume_ws_opt;
3123 0         0 $self->_eat(',');
3124 0         0 $self->__consume_ws_opt;
3125 0         0 $self->_Expression;
3126 0         0 my ($arg2) = splice(@{ $self->{stack} });
  0         0  
3127 0         0 $self->__consume_ws_opt;
3128 0         0 $self->_eat(',');
3129 0         0 $self->__consume_ws_opt;
3130 0         0 $self->_Expression;
3131 0         0 my ($arg3) = splice(@{ $self->{stack} });
  0         0  
3132 0         0 $self->_add_stack( $self->new_function_expression($iri, $arg1, $arg2, $arg3) );
3133             } else {
3134             ### BOUND(Var)
3135 3         9 $self->_Var;
3136 3         8 my ($expr) = splice(@{ $self->{stack} });
  3         8  
3137 3         17 $self->_add_stack( $self->new_function_expression($iri, $expr) );
3138             }
3139 5         17 $self->__consume_ws_opt;
3140 5         18 $self->_eat(')');
3141             }
3142             }
3143              
3144             # [58] RegexExpression ::= 'REGEX' '(' Expression ',' Expression ( ',' Expression )? ')'
3145             sub _RegexExpression_test {
3146 7     7   16 my $self = shift;
3147 7         31 return $self->_test( qr/REGEX/i );
3148             }
3149              
3150             sub _RegexExpression {
3151 2     2   6 my $self = shift;
3152 2         9 $self->_eat( qr/REGEX/i );
3153 2         8 $self->__consume_ws_opt;
3154 2         7 $self->_eat('(');
3155 2         6 $self->__consume_ws_opt;
3156 2         8 $self->_Expression;
3157 2         4 my $string = splice(@{ $self->{stack} });
  2         5  
3158            
3159 2         7 $self->__consume_ws_opt;
3160 2         8 $self->_eat(',');
3161 2         9 $self->__consume_ws_opt;
3162 2         8 $self->_Expression;
3163 2         4 my $pattern = splice(@{ $self->{stack} });
  2         5  
3164            
3165 2         5 my @args = ($string, $pattern);
3166 2 50       7 if ($self->_test(',')) {
3167 0         0 $self->_eat(',');
3168 0         0 $self->__consume_ws_opt;
3169 0         0 $self->_Expression;
3170 0         0 push(@args, splice(@{ $self->{stack} }));
  0         0  
3171             }
3172            
3173 2         6 $self->__consume_ws_opt;
3174 2         6 $self->_eat(')');
3175            
3176 2         13 my $iri = RDF::Query::Node::Resource->new( 'sparql:regex' );
3177 2         38 $self->_add_stack( $self->new_function_expression( $iri, @args ) );
3178             }
3179              
3180             # [59] IRIrefOrFunction ::= IRIref ArgList?
3181             sub _IRIrefOrFunction_test {
3182 0     0   0 my $self = shift;
3183 0         0 $self->_IRIref_test;
3184             }
3185              
3186             sub _IRIrefOrFunction {
3187 11     11   21 my $self = shift;
3188 11         38 $self->_IRIref;
3189 11 100       171 if ($self->_ArgList_test) {
3190 10         17 my ($iri) = splice(@{ $self->{stack} });
  10         30  
3191 10         33 $self->_ArgList;
3192 10         16 my @args = splice(@{ $self->{stack} });
  10         32  
3193 10         72 my $func = $self->new_function_expression( $iri, @args );
3194 10         33 $self->_add_stack( $func );
3195             }
3196             }
3197              
3198             # [60] RDFLiteral ::= String ( LANGTAG | ( '^^' IRIref ) )?
3199             sub _RDFLiteral {
3200 43     43   81 my $self = shift;
3201 43         147 $self->_String;
3202 43         73 my @args = splice(@{ $self->{stack} });
  43         131  
3203 43 50       137 if ($self->_test('@')) {
    50          
3204 0         0 my $lang = $self->_eat( $r_LANGTAG );
3205 0         0 substr($lang,0,1) = ''; # remove '@'
3206 0         0 push(@args, lc($lang));
3207             } elsif ($self->_test('^^')) {
3208 0         0 $self->_eat('^^');
3209 0         0 push(@args, undef);
3210 0         0 $self->_IRIref;
3211 0         0 my ($iri) = splice(@{ $self->{stack} });
  0         0  
3212 0         0 push(@args, $iri->uri_value);
3213             }
3214            
3215 43         312 my $obj = RDF::Query::Node::Literal->new( @args );
3216 43 0 33     1307 if ($self->{args}{canonicalize} and blessed($obj) and $obj->isa('RDF::Trine::Node::Literal')) {
      33        
3217 0         0 $obj = $obj->canonicalize;
3218             }
3219            
3220 43         125 $self->_add_stack( $obj );
3221             }
3222              
3223             # [61] NumericLiteral ::= NumericLiteralUnsigned | NumericLiteralPositive | NumericLiteralNegative
3224             # [62] NumericLiteralUnsigned ::= INTEGER | DECIMAL | DOUBLE
3225             # [63] NumericLiteralPositive ::= INTEGER_POSITIVE | DECIMAL_POSITIVE | DOUBLE_POSITIVE
3226             # [64] NumericLiteralNegative ::= INTEGER_NEGATIVE | DECIMAL_NEGATIVE | DOUBLE_NEGATIVE
3227             sub _NumericLiteral {
3228 29     29   49 my $self = shift;
3229 29         49 my $sign = 0;
3230 29 50       72 if ($self->_test('+')) {
    50          
3231 0         0 $self->_eat('+');
3232 0         0 $sign = '+';
3233             } elsif ($self->_test('-')) {
3234 0         0 $self->_eat('-');
3235 0         0 $sign = '-';
3236             }
3237            
3238 29         48 my $value;
3239             my $type;
3240 29 50       76 if ($self->_test( $r_DOUBLE )) {
    100          
3241 0         0 $value = $self->_eat( $r_DOUBLE );
3242 0         0 my $double = RDF::Query::Node::Resource->new( $xsd->double->uri_value );
3243 0         0 $type = $double
3244             } elsif ($self->_test( $r_DECIMAL )) {
3245 8         23 $value = $self->_eat( $r_DECIMAL );
3246 8         96 my $decimal = RDF::Query::Node::Resource->new( $xsd->decimal->uri_value );
3247 8         433 $type = $decimal;
3248             } else {
3249 21         64 $value = $self->_eat( $r_INTEGER );
3250 21         248 my $integer = RDF::Query::Node::Resource->new( $xsd->integer->uri_value );
3251 21         1428 $type = $integer;
3252             }
3253            
3254 29 50       376 if ($sign) {
3255 0         0 $value = $sign . $value;
3256             }
3257            
3258 29         115 my $obj = RDF::Query::Node::Literal->new( $value, undef, $type->uri_value );
3259 29 0 33     1163 if ($self->{args}{canonicalize} and blessed($obj) and $obj->isa('RDF::Trine::Node::Literal')) {
      33        
3260 0         0 $obj = $obj->canonicalize;
3261             }
3262 29         84 $self->_add_stack( $obj );
3263             }
3264              
3265             # [65] BooleanLiteral ::= 'true' | 'false'
3266             sub _BooleanLiteral {
3267 0     0   0 my $self = shift;
3268 0         0 my $bool = $self->_eat(qr/(true|false)\b/);
3269              
3270 0         0 my $obj = RDF::Query::Node::Literal->new( $bool, undef, $xsd->boolean->uri_value );
3271 0 0 0     0 if ($self->{args}{canonicalize} and blessed($obj) and $obj->isa('RDF::Trine::Node::Literal')) {
      0        
3272 0         0 $obj = $obj->canonicalize;
3273             }
3274 0         0 $self->_add_stack( $obj );
3275             }
3276              
3277             # [66] String ::= STRING_LITERAL1 | STRING_LITERAL2 | STRING_LITERAL_LONG1 | STRING_LITERAL_LONG2
3278             sub _String {
3279 43     43   104 my $self = shift;
3280 43         66 my $value;
3281 43 50       116 if ($self->_test( $r_STRING_LITERAL_LONG1 )) {
    50          
    100          
3282 0         0 my $string = $self->_eat( $r_STRING_LITERAL_LONG1 );
3283 0         0 $value = substr($string, 3, length($string) - 6);
3284             } elsif ($self->_test( $r_STRING_LITERAL_LONG2 )) {
3285 0         0 my $string = $self->_eat( $r_STRING_LITERAL_LONG2 );
3286 0         0 $value = substr($string, 3, length($string) - 6);
3287             } elsif ($self->_test( $r_STRING_LITERAL1 )) {
3288 7         22 my $string = $self->_eat( $r_STRING_LITERAL1 );
3289 7         23 $value = substr($string, 1, length($string) - 2);
3290             } else { # ($self->_test( $r_STRING_LITERAL2 )) {
3291 36         121 my $string = $self->_eat( $r_STRING_LITERAL2 );
3292 36         133 $value = substr($string, 1, length($string) - 2);
3293             }
3294             # $value =~ s/(${r_ECHAR})/"$1"/ge;
3295 43         173 $value =~ s/\\t/\t/g;
3296 43         79 $value =~ s/\\b/\n/g;
3297 43         89 $value =~ s/\\n/\n/g;
3298 43         84 $value =~ s/\\r/\x08/g;
3299 43         81 $value =~ s/\\"/"/g;
3300 43         81 $value =~ s/\\'/'/g;
3301 43         78 $value =~ s/\\\\/\\/g; # backslash must come last, so it doesn't accidentally create a new escape
3302 43         125 $self->_add_stack( $value );
3303             }
3304              
3305             # [67] IRIref ::= IRI_REF | PrefixedName
3306             sub _IRIref_test {
3307 586     586   835 my $self = shift;
3308 586         16240 return $self->_test(qr/<|${r_PNAME_LN}|${r_PNAME_NS}/);
3309             }
3310              
3311             sub _IRIref {
3312 273     273   446 my $self = shift;
3313 273 100       603 if ($self->_test( $r_IRI_REF )) {
3314 63         164 my $iri = $self->_eat( $r_IRI_REF );
3315 63         266 my $node = RDF::Query::Node::Resource->new( substr($iri,1,length($iri)-2), $self->__base );
3316 63         2066 $self->_add_stack( $node );
3317             } else {
3318 210         628 $self->_PrefixedName;
3319             }
3320             }
3321              
3322             # [68] PrefixedName ::= PNAME_LN | PNAME_NS
3323             sub _PrefixedName {
3324 210     210   336 my $self = shift;
3325 210 50       483 if ($self->_test( $r_PNAME_LN )) {
3326 210         567 my $ln = $self->_eat( $r_PNAME_LN );
3327 210         3037 my ($ns,$local) = split(/:/, $ln, 2);
3328 210 100       643 if ($ns eq '') {
3329 18         33 $ns = '__DEFAULT__';
3330             }
3331            
3332 210         416 $local =~ s{\\([-~.!&'()*+,;=:/?#@%_\$])}{$1}g;
3333            
3334 210 50       682 unless (exists $self->{namespaces}{$ns}) {
3335 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Use of undefined namespace '$ns'";
3336             }
3337            
3338 210         575 my $iri = $self->{namespaces}{$ns} . $local;
3339 210         601 $self->_add_stack( RDF::Query::Node::Resource->new( $iri, $self->__base ) );
3340             } else {
3341 0         0 my $ns = $self->_eat( $r_PNAME_NS );
3342 0 0       0 if ($ns eq ':') {
3343 0         0 $ns = '__DEFAULT__';
3344             } else {
3345 0         0 chop($ns);
3346             }
3347            
3348 0 0       0 unless (exists $self->{namespaces}{$ns}) {
3349 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Use of undefined namespace '$ns'";
3350             }
3351            
3352 0         0 my $iri = $self->{namespaces}{$ns};
3353 0         0 $self->_add_stack( RDF::Query::Node::Resource->new( $iri, $self->__base ) );
3354             }
3355             }
3356              
3357             # [69] BlankNode ::= BLANK_NODE_LABEL | ANON
3358             sub _BlankNode {
3359 10     10   19 my $self = shift;
3360 10 50       42 if (my $where = $self->{__no_bnodes}) {
3361 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Blank nodes not allowed in $where";
3362             }
3363 10 100       34 if ($self->_test( $r_BLANK_NODE_LABEL )) {
3364 5         19 my $label = $self->_eat( $r_BLANK_NODE_LABEL );
3365 5         37 my $id = substr($label,2);
3366 5         31 $self->_add_stack( $self->new_blank($id) );
3367             } else {
3368 5         19 $self->_eat( $r_ANON );
3369 5         32 $self->_add_stack( $self->new_blank );
3370             }
3371             }
3372              
3373             sub _NIL {
3374 0     0   0 my $self = shift;
3375 0         0 $self->_eat( $r_NIL );
3376 0         0 my $nil = RDF::Query::Node::Resource->new( $rdf->nil->uri_value );
3377 0         0 $self->_add_stack( $nil );
3378             }
3379              
3380             sub __solution_modifiers {
3381 85     85   175 my $self = shift;
3382 85         151 my $star = shift;
3383            
3384 85         126 my $having_expr;
3385 85         229 my $aggdata = delete( $self->{build}{__aggregate} );
3386 85 100       149 my @aggkeys = keys %{ $aggdata || {} };
  85         558  
3387 85 100       326 if (scalar(@aggkeys)) {
3388 17   100     84 my $groupby = delete( $self->{build}{__group_by} ) || [];
3389 17         39 my $pattern = $self->{build}{triples};
3390 17         34 my $ggp = shift(@$pattern);
3391 17 100       68 if (my $having = delete( $self->{build}{__having} )) {
3392 3         7 $having_expr = $having;
3393             }
3394            
3395 17         185 my $agg = RDF::Query::Algebra::Aggregate->new( $ggp, $groupby, { expressions => [%$aggdata] } );
3396 17         55 push(@{ $self->{build}{triples} }, $agg);
  17         55  
3397             }
3398            
3399 85         143 my $vars = [ @{ $self->{build}{variables} } ];
  85         295  
3400            
3401             {
3402 85         153 my @vars = grep { $_->isa('RDF::Query::Expression::Alias') } @$vars;
  85         193  
  127         614  
3403 85 100       321 if (scalar(@vars)) {
3404 25         47 my $pattern = pop(@{ $self->{build}{triples} });
  25         69  
3405 25         143 my @bound = $pattern->potentially_bound;
3406 25         64 my %bound = map { $_ => 1 } @bound;
  27         81  
3407 25         82 foreach my $v (@vars) {
3408 29         107 my $name = $v->name;
3409 29 50       215 if ($bound{ $name }) {
3410 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Already-bound variable ($name) used in project expression";
3411             }
3412             }
3413            
3414            
3415 25         188 my $proj = RDF::Query::Algebra::Extend->new( $pattern, $vars );
3416 25         41 push(@{ $self->{build}{triples} }, $proj);
  25         108  
3417             }
3418             }
3419            
3420 85 100       276 if ($having_expr) {
3421 3         6 my $pattern = pop(@{ $self->{build}{triples} });
  3         8  
3422 3         26 my $filter = RDF::Query::Algebra::Filter->new( $having_expr, $pattern );
3423 3         5 push(@{ $self->{build}{triples} }, $filter);
  3         32  
3424             }
3425            
3426 85 100       375 if ($self->{build}{options}{orderby}) {
3427 8         25 my $order = delete $self->{build}{options}{orderby};
3428 8         17 my $pattern = pop(@{ $self->{build}{triples} });
  8         25  
3429 8         64 my $sort = RDF::Query::Algebra::Sort->new( $pattern, @$order );
3430 8         18 push(@{ $self->{build}{triples} }, $sort);
  8         27  
3431             }
3432              
3433             {
3434 85         136 my $pattern = pop(@{ $self->{build}{triples} });
  85         136  
  85         249  
3435 85         555 my $proj = RDF::Query::Algebra::Project->new( $pattern, $vars );
3436 85         161 push(@{ $self->{build}{triples} }, $proj);
  85         229  
3437             }
3438            
3439 85 100       319 if ($self->{build}{options}{distinct}) {
3440 2         6 delete $self->{build}{options}{distinct};
3441 2         3 my $pattern = pop(@{ $self->{build}{triples} });
  2         6  
3442 2         13 my $sort = RDF::Query::Algebra::Distinct->new( $pattern );
3443 2         3 push(@{ $self->{build}{triples} }, $sort);
  2         6  
3444             }
3445            
3446 85 100       308 if (exists $self->{build}{options}{offset}) {
3447 1         4 my $offset = delete $self->{build}{options}{offset};
3448 1         3 my $pattern = pop(@{ $self->{build}{triples} });
  1         4  
3449 1         9 my $offseted = RDF::Query::Algebra::Offset->new( $pattern, $offset );
3450 1         2 push(@{ $self->{build}{triples} }, $offseted);
  1         4  
3451             }
3452            
3453 85 100       400 if (exists $self->{build}{options}{limit}) {
3454 3         11 my $limit = delete $self->{build}{options}{limit};
3455 3         7 my $pattern = pop(@{ $self->{build}{triples} });
  3         9  
3456 3         27 my $limited = RDF::Query::Algebra::Limit->new( $pattern, $limit );
3457 3         6 push(@{ $self->{build}{triples} }, $limited);
  3         14  
3458             }
3459             }
3460              
3461             ################################################################################
3462              
3463             =item C<< error >>
3464              
3465             Returns the error encountered during the last parse.
3466              
3467             =cut
3468              
3469             sub error {
3470 0     0 1 0 my $self = shift;
3471 0         0 return $self->{error};
3472             }
3473              
3474             sub _add_patterns {
3475 477     477   730 my $self = shift;
3476 477         825 my @triples = @_;
3477 477         850 my $container = $self->{ pattern_container_stack }[0];
3478 477         657 push( @{ $container }, @triples );
  477         1613  
3479             }
3480              
3481             sub _remove_pattern {
3482 70     70   109 my $self = shift;
3483 70         128 my $container = $self->{ pattern_container_stack }[0];
3484 70         103 my $pattern = pop( @{ $container } );
  70         131  
3485 70         150 return $pattern;
3486             }
3487              
3488             sub _peek_pattern {
3489 91     91   201 my $self = shift;
3490 91         202 my $container = $self->{ pattern_container_stack }[0];
3491 91         180 my $pattern = $container->[-1];
3492 91         196 return $pattern;
3493             }
3494              
3495             sub _push_pattern_container {
3496 367     367   568 my $self = shift;
3497 367         613 my $cont = [];
3498 367         536 unshift( @{ $self->{ pattern_container_stack } }, $cont );
  367         989  
3499 367         654 return $cont;
3500             }
3501              
3502             sub _pop_pattern_container {
3503 265     265   396 my $self = shift;
3504 265         345 my $cont = shift( @{ $self->{ pattern_container_stack } } );
  265         592  
3505 265         540 return $cont;
3506             }
3507              
3508             sub _add_stack {
3509 1845     1845   8970 my $self = shift;
3510 1845         3437 my @items = @_;
3511 1845         2205 push( @{ $self->{stack} }, @items );
  1845         6320  
3512             }
3513              
3514             sub _add_filter {
3515 18     18   35 my $self = shift;
3516 18         42 my @filters = shift;
3517 18         31 push( @{ $self->{filters} }, @filters );
  18         78  
3518             }
3519              
3520             sub _eat {
3521 5786     5786   7610 my $self = shift;
3522 5786         7432 my $thing = shift;
3523 5786 50       13300 if (not(length($self->{tokens}))) {
3524 0         0 $self->_syntax_error("No tokens left");
3525             }
3526              
3527             # if (substr($self->{tokens}, 0, 1) eq '^') {
3528             # Carp::cluck( "eating $thing with input $self->{tokens}" );
3529             # }
3530              
3531 5786 100 66     31932 if (ref($thing) and $thing->isa('Regexp')) {
    50          
3532 5051 50       189920 if ($self->{tokens} =~ /^($thing)/) {
3533 5051         9821 my $match = $1;
3534 5051         9460 substr($self->{tokens}, 0, length($match)) = '';
3535 5051         14201 return $match;
3536             }
3537              
3538 0         0 $self->_syntax_error( "Expected $thing" );
3539             } elsif (looks_like_number( $thing )) {
3540 0         0 my ($token) = substr( $self->{tokens}, 0, $thing, '' );
3541 0         0 return $token
3542             } else {
3543             ### thing is a string
3544 735 50       1849 if (substr($self->{tokens}, 0, length($thing)) eq $thing) {
3545 735         1281 substr($self->{tokens}, 0, length($thing)) = '';
3546 735         1327 return $thing;
3547             } else {
3548 0         0 $self->_syntax_error( "Expected $thing" );
3549             }
3550             }
3551 0         0 print $thing;
3552 0         0 throw RDF::Query::Error;
3553             }
3554              
3555             sub _syntax_error {
3556 0     0   0 my $self = shift;
3557 0         0 my $thing = shift;
3558 0         0 my $expect = $thing;
3559              
3560 0         0 my $level = 2;
3561 0         0 while (my $sub = (caller($level++))[3]) {
3562 0 0       0 if ($sub =~ m/::_([A-Z]\w*)$/) {
3563 0         0 $expect = $1;
3564 0         0 last;
3565             }
3566             }
3567              
3568 0         0 my $l = Log::Log4perl->get_logger("rdf.query.parser.sparql");
3569 0 0       0 if ($l->is_debug) {
3570 0         0 $l->logcluck("Syntax error eating $thing with input <<$self->{tokens}>>");
3571             }
3572              
3573 0         0 my $near = "'" . substr($self->{tokens}, 0, 20) . "...'";
3574 0         0 $near =~ s/[\r\n ]+/ /g;
3575 0 0       0 if ($thing) {
3576             # Carp::cluck Dumper($self->{tokens}); # XXX
3577 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: $thing in $expect near $near";
3578             } else {
3579 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Expected $expect near $near";
3580             }
3581             }
3582              
3583             sub _test {
3584 12795     12795   16473 my $self = shift;
3585 12795         17089 my $thing = shift;
3586 12795 100 66     64394 if (blessed($thing) and $thing->isa('Regexp')) {
3587 7027 100       560654 if ($self->{tokens} =~ m/^$thing/) {
3588 2118         8664 return 1;
3589             } else {
3590 4909         20340 return 0;
3591             }
3592             } else {
3593 5768 100       14083 if (substr($self->{tokens}, 0, length($thing)) eq $thing) {
3594 376         1211 return 1;
3595             } else {
3596 5392         14675 return 0;
3597             }
3598             }
3599             }
3600              
3601             sub _ws_test {
3602 7951     7951   10235 my $self = shift;
3603 7951 100       18600 unless (length($self->{tokens})) {
3604 298         936 return 0;
3605             }
3606              
3607 7653 100       21256 if ($self->{tokens} =~ m/^[\t\r\n #]/) {
3608 3381         9010 return 1;
3609             } else {
3610 4272         13275 return 0;
3611             }
3612             }
3613              
3614             sub _ws {
3615 3485     3485   4512 my $self = shift;
3616             ### #x9 | #xA | #xD | #x20 | comment
3617 3485 50       6796 if ($self->_test('#')) {
3618 0         0 $self->_eat(qr/#[^\x0d\x0a]*.?/);
3619             } else {
3620 3485         12700 $self->_eat(qr/[\n\r\t ]/);
3621             }
3622             }
3623              
3624             sub __consume_ws_opt {
3625 4469     4469   6038 my $self = shift;
3626 4469 100       8884 if ($self->_ws_test) {
3627 1948         3958 $self->__consume_ws;
3628             }
3629             }
3630              
3631             sub __consume_ws {
3632 2049     2049   2685 my $self = shift;
3633 2049         3964 $self->_ws;
3634 2049         6588 while ($self->_ws_test()) {
3635 1433         2990 $self->_ws()
3636             }
3637             }
3638              
3639             sub __base {
3640 273     273   424 my $self = shift;
3641 273         511 my $build = $self->{build};
3642 273 100       760 if (defined($build->{base})) {
3643 2         14 return $build->{base};
3644             } else {
3645 271         1320 return;
3646             }
3647             }
3648              
3649             sub __new_statement {
3650 208     208   318 my $self = shift;
3651 208         418 my @nodes = @_;
3652 208 100 100     994 if ($self->{_modify_template} and my $graph = $self->{named_graph} and $self->{named_graph}->isa('RDF::Trine::Node::Resource')) {
      66        
3653 18         285 return RDF::Query::Algebra::Quad->new( @nodes, $graph );
3654             } else {
3655 190         903 return RDF::Query::Algebra::Triple->_new( @nodes );
3656             }
3657             }
3658              
3659             sub __new_path {
3660 5     5   10 my $self = shift;
3661 5         8 my $start = shift;
3662 5         9 my $pdata = shift;
3663 5         10 my $end = shift;
3664 5         15 (undef, my $op, my @nodes) = @$pdata;
3665 5         11 @nodes = map { $self->__strip_path( $_ ) } @nodes;
  10         23  
3666             # if (my $graph = $self->{named_graph} and $self->{named_graph}->isa('RDF::Trine::Node::Resource')) {
3667             # return RDF::Query::Algebra::Path->new( $start, [$op, @nodes], $end, $graph );
3668             # } else {
3669 5         50 return RDF::Query::Algebra::Path->new( $start, [$op, @nodes], $end );
3670             # }
3671             }
3672              
3673             sub __strip_path {
3674 12     12   18 my $self = shift;
3675 12         21 my $path = shift;
3676 12 100 33     60 if (blessed($path)) {
    50          
3677 10         35 return $path;
3678             } elsif (reftype($path) eq 'ARRAY' and $path->[0] eq 'PATH') {
3679 2         6 (undef, my $op, my @nodes) = @$path;
3680 2         5 return [$op, map { $self->__strip_path($_) } @nodes];
  2         8  
3681             } else {
3682 0         0 return $path;
3683             }
3684             }
3685              
3686             sub __new_bgp {
3687             # fix up BGPs that might actually have property paths in them. split those
3688             # out as their own path algebra objects, and join them with the bgp with a
3689             # ggp if necessary
3690 120     120   204 my $self = shift;
3691 120         275 my @patterns = @_;
3692 120 50       252 my @paths = grep { reftype($_->predicate) eq 'ARRAY' and $_->predicate->[0] eq 'PATH' } @patterns;
  206         2567  
3693 120         2144 my @triples = grep { blessed($_->predicate) } @patterns;
  206         951  
3694 120 50       1102 if (scalar(@patterns) > scalar(@paths) + scalar(@triples)) {
3695 0         0 Carp::cluck "more than just triples and paths passed to __new_bgp: " . Dumper(\@patterns);
3696             }
3697 120         775 my $bgp = RDF::Query::Algebra::BasicGraphPattern->new( @triples );
3698 120 100       323 if (@paths) {
3699 5         8 my @p;
3700 5         12 foreach my $p (@paths) {
3701 5         20 my $start = $p->subject;
3702 5         39 my $end = $p->object;
3703 5         36 my $pdata = $p->predicate;
3704 5         36 push(@p, $self->__new_path( $start, $pdata, $end ));
3705             }
3706 5 50       17 my $pgroup = (scalar(@p) == 1)
3707             ? $p[0]
3708             : RDF::Query::Algebra::GroupGraphPattern->new( @p );
3709 5 100       19 if (scalar(@triples)) {
3710 2         15 return RDF::Query::Algebra::GroupGraphPattern->new( $bgp, $pgroup );
3711             } else {
3712 3         16 return $pgroup;
3713             }
3714             } else {
3715 115         336 return $bgp;
3716             }
3717             }
3718              
3719             1;
3720              
3721             __END__
3722              
3723             =back
3724              
3725             =cut