File Coverage

blib/lib/RDF/Query/Parser/SPARQL.pm
Criterion Covered Total %
statement 965 1144 84.3
branch 187 264 70.8
condition 12 29 41.3
subroutine 125 134 93.2
pod 5 5 100.0
total 1294 1576 82.1


line stmt bran cond sub pod time code
1             # RDF::Query::Parser::SPARQL
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Parser::SPARQL - SPARQL Parser.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Parser::SPARQL version 2.916.
11              
12             =head1 SYNOPSIS
13              
14             use RDF::Query::Parser::SPARQL;
15             my $parser = RDF::Query::Parser::SPARQL->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::SPARQL;
32              
33 36     36   193 use strict;
  36         75  
  36         920  
34 36     36   183 use warnings;
  36         64  
  36         947  
35 36     36   191 no warnings 'redefine';
  36         78  
  36         1244  
36 36     36   202 use base qw(RDF::Query::Parser);
  36         73  
  36         21029  
37              
38 36     36   208 use URI;
  36         80  
  36         772  
39 36     36   180 use Data::Dumper;
  36         63  
  36         1591  
40 36     36   190 use RDF::Query::Error qw(:try);
  36         72  
  36         176  
41 36     36   4441 use RDF::Query::Parser;
  36         70  
  36         851  
42 36     36   196 use RDF::Query::Algebra;
  36         72  
  36         1301  
43 36     36   218 use RDF::Trine::Namespace qw(rdf);
  36         86  
  36         427  
44 36     36   3485 use Scalar::Util qw(blessed looks_like_number);
  36         84  
  36         2548  
45              
46             ######################################################################
47              
48             our ($VERSION);
49             BEGIN {
50 36     36   503479 $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 = qr/((${r_PN_CHARS_U}|[0-9])((${r_PN_CHARS}|[.])*${r_PN_CHARS})?)/o;
73             our $r_PNAME_NS = qr/((${r_PN_PREFIX})?:)/o;
74             our $r_PNAME_LN = qr/(${r_PNAME_NS}${r_PN_LOCAL})/o;
75             our $r_EXPONENT = qr/[eE][-+]?\d+/o;
76             our $r_DOUBLE = qr/\d+[.]\d*${r_EXPONENT}|[.]\d+${r_EXPONENT}|\d+${r_EXPONENT}/o;
77             our $r_DECIMAL = qr/(\d+[.]\d*)|([.]\d+)/o;
78             our $r_INTEGER = qr/\d+/o;
79             our $r_BLANK_NODE_LABEL = qr/_:${r_PN_LOCAL}/o;
80             our $r_ANON = qr/\[[\t\r\n ]*\]/o;
81             our $r_NIL = qr/\([\n\r\t ]*\)/o;
82              
83             =item C<< new >>
84              
85             Returns a new Turtle parser.
86              
87             =cut
88              
89             sub new {
90 89     89 1 218 my $class = shift;
91 89         529 my $self = bless({
92             bindings => {},
93             bnode_id => 0,
94             }, $class);
95 89         302 return $self;
96             }
97              
98             ################################################################################
99              
100             =item C<< parse ( $query, $base_uri ) >>
101              
102             Parses the C<< $query >>, using the given C<< $base_uri >>.
103              
104             =cut
105              
106             sub parse {
107 88     88 1 295 my $self = shift;
108 88         192 my $input = shift;
109 88         173 my $baseuri = shift;
110            
111 88         286 $input =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/ge;
  0         0  
112 88         225 $input =~ s/\\U([0-9A-Fa-f]{8})/chr(hex($1))/ge;
  0         0  
113            
114 88         341 delete $self->{error};
115 88         362 local($self->{namespaces}) = {};
116 88         296 local($self->{blank_ids}) = 1;
117 88         319 local($self->{baseURI}) = $baseuri;
118 88         297 local($self->{tokens}) = $input;
119 88         346 local($self->{stack}) = [];
120 88         387 local($self->{filters}) = [];
121 88         296 local($self->{pattern_container_stack}) = [];
122 88         468 my $triples = $self->_push_pattern_container();
123 88         566 $self->{build} = { sources => [], triples => $triples };
124 88 50       318 if ($baseuri) {
125 0         0 $self->{build}{base} = $baseuri;
126             }
127            
128             try {
129 88     88   3265 $self->_Query();
130             } catch RDF::Query::Error with {
131 1     1   176 my $e = shift;
132 1         3 $self->{build} = undef;
133 1         13 $self->{error} = $e->text;
134 88         987 };
135 88         1784 my $data = delete $self->{build};
136             # $data->{triples} = $self->_pop_pattern_container();
137 88         787 return $data;
138             }
139              
140             =item C<< parse_pattern ( $pattern, $base_uri, \%namespaces ) >>
141              
142             Parses the C<< $pattern >>, using the given C<< $base_uri >> and returns a
143             RDF::Query::Algebra pattern.
144              
145             =cut
146              
147             sub parse_pattern {
148 7     7 1 89 my $self = shift;
149 7         15 my $input = shift;
150 7         10 my $baseuri = shift;
151 7         16 my $ns = shift;
152            
153 7         16 $input =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/ge;
  0         0  
154 7         13 $input =~ s/\\U([0-9A-Fa-f]{8})/chr(hex($1))/ge;
  0         0  
155            
156 7         20 delete $self->{error};
157 7         22 local($self->{namespaces}) = $ns;
158 7         23 local($self->{blank_ids}) = 1;
159 7         18 local($self->{baseURI}) = $baseuri;
160 7         21 local($self->{tokens}) = $input;
161 7         24 local($self->{stack}) = [];
162 7         23 local($self->{filters}) = [];
163 7         21 local($self->{pattern_container_stack}) = [];
164 7         22 my $triples = $self->_push_pattern_container();
165 7         34 $self->{build} = { sources => [], triples => $triples };
166 7 50       23 if ($baseuri) {
167 0         0 $self->{build}{base} = $baseuri;
168             }
169            
170             try {
171 7     7   205 $self->_GroupGraphPattern();
172             } catch RDF::Query::Error with {
173 0     0   0 my $e = shift;
174 0         0 $self->{build} = undef;
175 0         0 $self->{error} = $e->text;
176 7         53 };
177 7         127 my $data = delete $self->{build};
178            
179 7         68 return $data->{triples}[0];
180             }
181              
182             =item C<< parse_expr ( $pattern, $base_uri, \%namespaces ) >>
183              
184             Parses the C<< $pattern >>, using the given C<< $base_uri >> and returns a
185             RDF::Query::Expression pattern.
186              
187             =cut
188              
189             sub parse_expr {
190 0     0 1 0 my $self = shift;
191 0         0 my $input = shift;
192 0         0 my $baseuri = shift;
193 0         0 my $ns = shift;
194            
195 0         0 $input =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/ge;
  0         0  
196 0         0 $input =~ s/\\U([0-9A-Fa-f]{8})/chr(hex($1))/ge;
  0         0  
197            
198 0         0 delete $self->{error};
199 0         0 local($self->{namespaces}) = $ns;
200 0         0 local($self->{blank_ids}) = 1;
201 0         0 local($self->{baseURI}) = $baseuri;
202 0         0 local($self->{tokens}) = $input;
203 0         0 local($self->{stack}) = [];
204 0         0 local($self->{filters}) = [];
205 0         0 local($self->{pattern_container_stack}) = [];
206 0         0 my $triples = $self->_push_pattern_container();
207 0         0 $self->{build} = { sources => [], triples => $triples };
208 0 0       0 if ($baseuri) {
209 0         0 $self->{build}{base} = $baseuri;
210             }
211            
212             try {
213 0     0   0 $self->_Expression();
214             } catch RDF::Query::Error with {
215 0     0   0 my $e = shift;
216 0         0 $self->{build} = undef;
217 0         0 $self->{error} = $e->text;
218 0         0 };
219            
220 0         0 my $data = splice(@{ $self->{stack} });
  0         0  
221 0         0 return $data;
222             }
223              
224             =item C<< error >>
225              
226             Returns the error encountered during the last parse.
227              
228             =cut
229              
230             sub error {
231 2     2 1 4 my $self = shift;
232 2         10 return $self->{error};
233             }
234              
235             sub _add_patterns {
236 390     390   601 my $self = shift;
237 390         723 my @triples = @_;
238 390         674 my $container = $self->{ pattern_container_stack }[0];
239 390         474 push( @{ $container }, @triples );
  390         1290  
240             }
241              
242             sub _remove_pattern {
243 22     22   38 my $self = shift;
244 22         44 my $container = $self->{ pattern_container_stack }[0];
245 22         35 my $pattern = pop( @{ $container } );
  22         49  
246 22         73 return $pattern;
247             }
248              
249             sub _peek_pattern {
250 88     88   157 my $self = shift;
251 88         183 my $container = $self->{ pattern_container_stack }[0];
252 88         170 my $pattern = $container->[-1];
253 88         192 return $pattern;
254             }
255              
256             sub _push_pattern_container {
257 323     323   491 my $self = shift;
258 323         567 my $cont = [];
259 323         554 unshift( @{ $self->{ pattern_container_stack } }, $cont );
  323         860  
260 323         594 return $cont;
261             }
262              
263             sub _pop_pattern_container {
264 228     228   356 my $self = shift;
265 228         311 my $cont = shift( @{ $self->{ pattern_container_stack } } );
  228         508  
266 228         491 return $cont;
267             }
268              
269             sub _add_stack {
270 1586     1586   10034 my $self = shift;
271 1586         2960 my @items = @_;
272 1586         1974 push( @{ $self->{stack} }, @items );
  1586         5377  
273             }
274              
275             sub _add_filter {
276 25     25   48 my $self = shift;
277 25         53 my @filters = shift;
278 25         47 push( @{ $self->{filters} }, @filters );
  25         84  
279             }
280              
281             sub _eat {
282 6344     6344   8169 my $self = shift;
283 6344         8113 my $thing = shift;
284 6344 50       14484 if (not(length($self->{tokens}))) {
285 0         0 $self->_syntax_error("no tokens left");
286             }
287            
288             # if (substr($self->{tokens}, 0, 1) eq '^') {
289             # Carp::cluck( "eating $thing with input $self->{tokens}" );
290             # }
291            
292 6344 100 66     39746 if (blessed($thing) and $thing->isa('Regexp')) {
    50          
293 5758 50       189708 if ($self->{tokens} =~ /^($thing)/) {
294 5758         10826 my $match = $1;
295 5758         10063 substr($self->{tokens}, 0, length($match)) = '';
296 5758         17865 return $match;
297             }
298            
299 0         0 $self->_syntax_error( $thing );
300             } elsif (looks_like_number( $thing )) {
301 0         0 my ($token) = substr( $self->{tokens}, 0, $thing, '' );
302 0         0 return $token
303             } else {
304             ### thing is a string
305 586 50       1488 if (substr($self->{tokens}, 0, length($thing)) eq $thing) {
306 586         1041 substr($self->{tokens}, 0, length($thing)) = '';
307 586         1041 return $thing;
308             } else {
309 0         0 $self->_syntax_error( $thing );
310             }
311             }
312 0         0 print $thing;
313 0         0 throw RDF::Query::Error;
314             }
315              
316             sub _syntax_error {
317 0     0   0 my $self = shift;
318 0         0 my $thing = shift;
319 0         0 my $expect = $thing;
320              
321 0         0 my $level = 2;
322 0         0 while (my $sub = (caller($level++))[3]) {
323 0 0       0 if ($sub =~ m/::_([A-Z]\w*)$/) {
324 0         0 $expect = $1;
325 0         0 last;
326             }
327             }
328            
329 0         0 my $l = Log::Log4perl->get_logger("rdf.query.parser.sparql");
330 0 0       0 if ($l->is_debug) {
331 0         0 $l->logcluck("Syntax error eating $thing with input <<$self->{tokens}>>");
332             }
333 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Expected $expect";
334             }
335              
336             sub _test {
337 9941     9941   12703 my $self = shift;
338 9941         12919 my $thing = shift;
339 9941 100 66     45664 if (blessed($thing) and $thing->isa('Regexp')) {
340 4103 100       270057 if ($self->{tokens} =~ m/^$thing/) {
341 1584         6227 return 1;
342             } else {
343 2519         10817 return 0;
344             }
345             } else {
346 5838 100       14308 if (substr($self->{tokens}, 0, length($thing)) eq $thing) {
347 288         960 return 1;
348             } else {
349 5550         14373 return 0;
350             }
351             }
352             }
353              
354             sub _ws_test {
355 7270     7270   9460 my $self = shift;
356 7270 100       16788 unless (length($self->{tokens})) {
357 81         295 return 0;
358             }
359            
360 7189 100       19444 if ($self->{tokens} =~ m/^[\t\r\n #]/) {
361 4035         10458 return 1;
362             } else {
363 3154         10358 return 0;
364             }
365             }
366              
367             sub _ws {
368 4225     4225   5425 my $self = shift;
369             ### #x9 | #xA | #xD | #x20 | comment
370 4225 50       8188 if ($self->_test('#')) {
371 0         0 $self->_eat(qr/#[^\x0d\x0a]*.?/);
372             } else {
373 4225         15538 $self->_eat(qr/[\n\r\t ]/);
374             }
375             }
376              
377             sub __consume_ws_opt {
378 3057     3057   4017 my $self = shift;
379 3057 100       5901 if ($self->_ws_test) {
380 1822         3691 $self->__consume_ws;
381             }
382             }
383              
384             sub __consume_ws {
385 2000     2000   2524 my $self = shift;
386 2000         3892 $self->_ws;
387 2000         6729 while ($self->_ws_test()) {
388 2213         4732 $self->_ws()
389             }
390             }
391              
392             sub __base {
393 235     235   381 my $self = shift;
394 235         407 my $build = $self->{build};
395 235 50       631 if (defined($build->{base})) {
396 0         0 return $build->{base};
397             } else {
398 235         1223 return;
399             }
400             }
401              
402             sub __new_statement {
403 208     208   323 my $self = shift;
404 208         418 my @nodes = @_;
405 208 100       671 if (my $graph = $self->{named_graph}) {
406 10         153 return RDF::Query::Algebra::Quad->new( @nodes, $graph );
407             } else {
408 198         1009 return RDF::Query::Algebra::Triple->new( @nodes );
409             }
410             }
411              
412             ################################################################################
413              
414              
415             # [1] Query ::= Prologue ( SelectQuery | ConstructQuery | DescribeQuery | AskQuery )
416             sub _Query {
417 88     88   191 my $self = shift;
418 88         339 $self->__consume_ws_opt;
419 88         363 $self->_Prologue;
420 88         249 $self->__consume_ws_opt;
421 88 100       396 if ($self->_test(qr/SELECT/i)) {
    100          
    100          
    100          
422 71         291 $self->_SelectQuery();
423             } elsif ($self->_test(qr/CONSTRUCT/i)) {
424 4         19 $self->_ConstructQuery();
425             } elsif ($self->_test(qr/DESCRIBE/i)) {
426 4         19 $self->_DescribeQuery();
427             } elsif ($self->_test(qr/ASK/i)) {
428 8         40 $self->_AskQuery();
429             } else {
430 1         6 my $l = Log::Log4perl->get_logger("rdf.query");
431 1 50       26 if ($l->is_debug) {
432 0         0 $l->logcluck("Syntax error: Expected query type with input <<$self->{tokens}>>");
433             }
434 1         25 throw RDF::Query::Error::ParseError -text => 'Syntax error: Expected query type';
435             }
436            
437 87         337 my $remaining = $self->{tokens};
438 87 50       463 if ($remaining =~ m/\S/) {
439 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Remaining input after query: $remaining";
440             }
441            
442             # my %query = (%p, %body);
443             # return \%query;
444             }
445              
446              
447             # [2] Prologue ::= BaseDecl? PrefixDecl*
448             # [3] BaseDecl ::= 'BASE' IRI_REF
449             # [4] PrefixDecl ::= 'PREFIX' PNAME_NS IRI_REF
450             sub _Prologue {
451 88     88   162 my $self = shift;
452            
453 88         163 my $base;
454             my @base;
455 88 50       420 if ($self->_test( qr/BASE/i )) {
456 0         0 $self->_eat( qr/BASE/i );
457 0         0 $self->__consume_ws_opt;
458 0         0 my $iriref = $self->_eat( $r_IRI_REF );
459 0         0 my $iri = substr($iriref,1,length($iriref)-2);
460 0         0 $base = RDF::Query::Node::Resource->new( $iri );
461 0         0 @base = $base;
462 0         0 $self->__consume_ws_opt;
463 0         0 $self->{base} = $base;
464             }
465            
466 88         236 my %namespaces;
467 88         442 while ($self->_test( qr/PREFIX/i )) {
468 155         716 $self->_eat( qr/PREFIX/i );
469 155         548 $self->__consume_ws_opt;
470 155         443 my $prefix = $self->_eat( $r_PNAME_NS );
471 155         1705 my $ns = substr($prefix, 0, length($prefix) - 1);
472 155 100       480 if ($ns eq '') {
473 3         9 $ns = '__DEFAULT__';
474             }
475 155         415 $self->__consume_ws_opt;
476 155         447 my $iriref = $self->_eat( $r_IRI_REF );
477 155         546 my $iri = substr($iriref,1,length($iriref)-2);
478 155 50       547 if (@base) {
479 0         0 my $r = RDF::Query::Node::Resource->new( $iri, @base );
480 0         0 $iri = $r->uri_value;
481             }
482 155         436 $self->__consume_ws_opt;
483 155         487 $namespaces{ $ns } = $iri;
484 155         754 $self->{namespaces}{$ns} = $iri;
485             }
486            
487 88         375 $self->{build}{namespaces} = \%namespaces;
488 88 50       396 $self->{build}{base} = $base if (defined($base));
489            
490             # push(@data, (base => $base)) if (defined($base));
491             # return @data;
492             }
493              
494              
495             # [5] SelectQuery ::= 'SELECT' ( 'DISTINCT' | 'REDUCED' )? ( Var+ | '*' ) DatasetClause* WhereClause SolutionModifier
496             sub _SelectQuery {
497 71     71   145 my $self = shift;
498 71         325 $self->_eat(qr/SELECT/i);
499 71         283 $self->__consume_ws;
500            
501 71 100       453 if ($self->{tokens} =~ m/^(DISTINCT|REDUCED)/i) {
502 10         69 my $mod = $self->_eat( qr/DISTINCT|REDUCED/i );
503 10         61 $self->__consume_ws;
504 10         78 $self->{build}{options}{lc($mod)} = 1;
505             }
506            
507 71         293 my $star = $self->__SelectVars;
508            
509 71         329 $self->_DatasetClause();
510            
511 71         275 $self->__consume_ws_opt;
512 71         353 $self->_WhereClause;
513              
514 71 100       274 if ($star) {
515 1   50     6 my $triples = $self->{build}{triples} || [];
516 1         3 my @vars = RDF::Query::_uniq( map { $_->referenced_variables } @$triples );
  1         6  
517 1         4 $self->{build}{variables} = [ map { $self->new_variable($_) } @vars ];
  2         18  
518             }
519              
520 71         204 $self->__consume_ws_opt;
521 71         273 $self->_SolutionModifier();
522            
523 71 100       468 if ($self->{build}{options}{orderby}) {
524 7         24 my $order = delete $self->{build}{options}{orderby};
525 7         17 my $pattern = pop(@{ $self->{build}{triples} });
  7         21  
526 7         65 my $sort = RDF::Query::Algebra::Sort->new( $pattern, @$order );
527 7         16 push(@{ $self->{build}{triples} }, $sort);
  7         24  
528             }
529 71         335 $self->__solution_modifiers( $star );
530            
531 71         190 delete $self->{build}{options};
532 71         266 $self->{build}{method} = 'SELECT';
533             }
534              
535             sub __SelectVars {
536 71     71   139 my $self = shift;
537 71         147 my $star = 0;
538 71 100       189 if ($self->_test('*')) {
539 1         6 $self->_eat('*');
540 1         2 $star = 1;
541 1         5 $self->__consume_ws_opt;
542             } else {
543 70         115 my @vars;
544 70         276 $self->__SelectVar;
545 70         187 push( @vars, splice(@{ $self->{stack} }));
  70         262  
546 70         208 $self->__consume_ws_opt;
547 70         271 while ($self->__SelectVar_test) {
548 55         155 $self->__SelectVar;
549 55         138 push( @vars, splice(@{ $self->{stack} }));
  55         140  
550 55         1073 $self->__consume_ws_opt;
551             }
552 70         292 $self->{build}{variables} = \@vars;
553             }
554 71         235 return $star;
555             }
556              
557             sub __SelectVar_test {
558 125     125   200 my $self = shift;
559 125         637 return $self->{tokens} =~ m'^[?$]';
560             }
561              
562             sub __SelectVar {
563 125     125   199 my $self = shift;
564 125         530 $self->_Var;
565             }
566              
567             # [6] ConstructQuery ::= 'CONSTRUCT' ConstructTemplate DatasetClause* WhereClause SolutionModifier
568             sub _ConstructQuery {
569 4     4   7 my $self = shift;
570 4         19 $self->_eat(qr/CONSTRUCT/i);
571 4         17 $self->__consume_ws_opt;
572 4         20 $self->_ConstructTemplate;
573 4         14 $self->__consume_ws_opt;
574 4         18 $self->_DatasetClause();
575 4         14 $self->__consume_ws_opt;
576 4         15 $self->_WhereClause;
577 4         14 $self->__consume_ws_opt;
578 4         15 $self->_SolutionModifier();
579            
580 4         18 my $pattern = $self->{build}{triples}[0];
581 4         11 my $triples = delete $self->{build}{construct_triples};
582 4         40 my $construct = RDF::Query::Algebra::Construct->new( $pattern, $triples );
583 4         12 $self->{build}{triples}[0] = $construct;
584 4         14 $self->{build}{method} = 'CONSTRUCT';
585             }
586              
587             # [7] DescribeQuery ::= 'DESCRIBE' ( VarOrIRIref+ | '*' ) DatasetClause* WhereClause? SolutionModifier
588             sub _DescribeQuery {
589 4     4   10 my $self = shift;
590 4         22 $self->_eat(qr/DESCRIBE/i);
591 4         15 $self->_ws;
592            
593 4 50       16 if ($self->_test('*')) {
594 0         0 $self->_eat('*');
595 0         0 $self->{build}{variables} = ['*'];
596 0         0 $self->__consume_ws_opt;
597             } else {
598 4         17 $self->_VarOrIRIref;
599 4         16 $self->__consume_ws_opt;
600 4         18 while ($self->_VarOrIRIref_test) {
601 0         0 $self->_VarOrIRIref;
602 0         0 $self->__consume_ws_opt;
603             }
604 4         113 $self->{build}{variables} = [ splice(@{ $self->{stack} }) ];
  4         24  
605             }
606            
607 4         20 $self->_DatasetClause();
608            
609 4         18 $self->__consume_ws_opt;
610 4 100       19 if ($self->_WhereClause_test) {
611 3         12 $self->_WhereClause;
612 3         10 $self->__consume_ws_opt;
613             }
614            
615 4         23 $self->_SolutionModifier();
616 4         21 $self->{build}{method} = 'DESCRIBE';
617             }
618              
619             # [8] AskQuery ::= 'ASK' DatasetClause* WhereClause
620             sub _AskQuery {
621 8     8   15 my $self = shift;
622 8         39 $self->_eat(qr/ASK/i);
623 8         35 $self->_ws;
624            
625 8         39 $self->_DatasetClause();
626            
627 8         29 $self->__consume_ws_opt;
628 8         29 $self->_WhereClause;
629            
630 8         26 $self->{build}{variables} = [];
631 8         31 $self->{build}{method} = 'ASK';
632             }
633              
634             # [9] DatasetClause ::= 'FROM' ( DefaultGraphClause | NamedGraphClause )
635             sub _DatasetClause {
636 87     87   165 my $self = shift;
637            
638             # my @dataset;
639 87         323 $self->{build}{sources} = [];
640 87         558 while ($self->_test( qr/FROM/i )) {
641 22         111 $self->_eat( qr/FROM/i );
642 22         77 $self->__consume_ws;
643 22 100       88 if ($self->_test( qr/NAMED/i )) {
644 16         52 $self->_NamedGraphClause;
645             } else {
646 6         29 $self->_DefaultGraphClause;
647             }
648 22         85 $self->__consume_ws_opt;
649             }
650             }
651              
652             # [10] DefaultGraphClause ::= SourceSelector
653             sub _DefaultGraphClause {
654 6     6   12 my $self = shift;
655 6         765 $self->_SourceSelector;
656 6         16 my ($source) = splice(@{ $self->{stack} });
  6         19  
657 6         13 push( @{ $self->{build}{sources} }, [$source] );
  6         27  
658             }
659              
660             # [11] NamedGraphClause ::= 'NAMED' SourceSelector
661             sub _NamedGraphClause {
662 16     16   26 my $self = shift;
663 16         67 $self->_eat( qr/NAMED/i );
664 16         61 $self->__consume_ws_opt;
665 16         52 $self->_SourceSelector;
666 16         38 my ($source) = splice(@{ $self->{stack} });
  16         39  
667 16         33 push( @{ $self->{build}{sources} }, [$source, 'NAMED'] );
  16         87  
668             }
669              
670             # [12] SourceSelector ::= IRIref
671             sub _SourceSelector {
672 22     22   36 my $self = shift;
673 22         122 $self->_IRIref;
674             }
675              
676             # [13] WhereClause ::= 'WHERE'? GroupGraphPattern
677             sub _WhereClause_test {
678 4     4   6 my $self = shift;
679 4         22 return $self->_test( qr/WHERE|{/i );
680             }
681             sub _WhereClause {
682 86     86   171 my $self = shift;
683 86 100       405 if ($self->_test( qr/WHERE/i )) {
684 77         312 $self->_eat( qr/WHERE/i );
685             }
686 86         436 $self->__consume_ws_opt;
687 86         451 $self->_GroupGraphPattern;
688            
689 86         280 my $ggp = $self->_peek_pattern;
690 86         493 $ggp->check_duplicate_blanks;
691             }
692              
693             # [14] SolutionModifier ::= OrderClause? LimitOffsetClauses?
694             sub _SolutionModifier {
695 79     79   139 my $self = shift;
696            
697 79 100       302 if ($self->_OrderClause_test) {
698 7         36 $self->_OrderClause;
699 7         24 $self->__consume_ws_opt;
700             }
701            
702 79 100       381 if ($self->_LimitOffsetClauses_test) {
703 8         30 $self->_LimitOffsetClauses;
704             }
705             }
706              
707             # [15] LimitOffsetClauses ::= ( LimitClause OffsetClause? | OffsetClause LimitClause? )
708             sub _LimitOffsetClauses_test {
709 79     79   152 my $self = shift;
710 79         354 return $self->_test( qr/LIMIT|OFFSET/i );
711             }
712              
713             sub _LimitOffsetClauses {
714 8     8   14 my $self = shift;
715 8 100       33 if ($self->_LimitClause_test) {
716 6         22 $self->_LimitClause;
717 6         21 $self->__consume_ws;
718 6 100       21 if ($self->_OffsetClause_test) {
719 1         5 $self->_OffsetClause;
720             }
721             } else {
722 2         6 $self->_OffsetClause;
723 2         6 $self->__consume_ws;
724 2 50       7 if ($self->_LimitClause_test) {
725 0         0 $self->_LimitClause;
726             }
727             }
728             }
729              
730             # [16] OrderClause ::= 'ORDER' 'BY' OrderCondition+
731             sub _OrderClause_test {
732 79     79   168 my $self = shift;
733 79         369 return $self->_test( qr/ORDER[\n\r\t ]+BY/i );
734             }
735              
736             sub _OrderClause {
737 7     7   15 my $self = shift;
738 7         30 $self->_eat( qr/ORDER/i );
739 7         30 $self->__consume_ws;
740 7         33 $self->_eat( qr/BY/i );
741 7         27 $self->__consume_ws_opt;
742 7         15 my @order;
743 7         27 $self->_OrderCondition;
744 7         22 $self->__consume_ws_opt;
745 7         13 push(@order, splice(@{ $self->{stack} }));
  7         22  
746 7         29 while ($self->_OrderCondition_test) {
747 0         0 $self->_OrderCondition;
748 0         0 $self->__consume_ws_opt;
749 0         0 push(@order, splice(@{ $self->{stack} }));
  0         0  
750             }
751 7         38 $self->{build}{options}{orderby} = \@order;
752             }
753              
754             # [17] OrderCondition ::= ( ( 'ASC' | 'DESC' ) BrackettedExpression ) | ( Constraint | Var )
755             sub _OrderCondition_test {
756 7     7   15 my $self = shift;
757 7 50       29 return 1 if $self->_test( qr/ASC|DESC|[?\$]/i );
758 7 50       42 return 1 if $self->_Constraint_test;
759 7         30 return 0;
760             }
761              
762             sub _OrderCondition {
763 7     7   15 my $self = shift;
764 7         17 my $dir = 'ASC';
765 7 100       30 if ($self->_test( qr/ASC|DESC/i )) {
    50          
766 2         10 $dir = uc( $self->_eat( qr/ASC|DESC/i ) );
767 2         10 $self->__consume_ws_opt;
768 2         9 $self->_BrackettedExpression;
769             } elsif ($self->_test( qr/[?\$]/ )) {
770 5         15 $self->_Var;
771             } else {
772 0         0 $self->_Constraint;
773             }
774 7         46 my ($expr) = splice(@{ $self->{stack} });
  7         20  
775 7         30 $self->_add_stack( [ $dir, $expr ] );
776             }
777              
778             # [18] LimitClause ::= 'LIMIT' INTEGER
779             sub _LimitClause_test {
780 10     10   15 my $self = shift;
781 10         46 return $self->_test( qr/LIMIT/i );
782             }
783              
784             sub _LimitClause {
785 6     6   13 my $self = shift;
786 6         27 $self->_eat( qr/LIMIT/i );
787 6         27 $self->__consume_ws;
788 6         21 my $limit = $self->_eat( $r_INTEGER );
789 6         31 $self->{build}{options}{limit} = $limit;
790             }
791              
792             # [19] OffsetClause ::= 'OFFSET' INTEGER
793             sub _OffsetClause_test {
794 6     6   14 my $self = shift;
795 6         27 return $self->_test( qr/OFFSET/i );
796             }
797              
798             sub _OffsetClause {
799 3     3   8 my $self = shift;
800 3         13 $self->_eat( qr/OFFSET/i );
801 3         11 $self->__consume_ws;
802 3         8 my $off = $self->_eat( $r_INTEGER );
803 3         14 $self->{build}{options}{offset} = $off;
804             }
805              
806             # [20] GroupGraphPattern ::= '{' TriplesBlock? ( ( GraphPatternNotTriples | Filter ) '.'? TriplesBlock? )* '}'
807             sub _GroupGraphPattern {
808 115     115   199 my $self = shift;
809 115         324 $self->_push_pattern_container;
810            
811 115         651 $self->_eat('{');
812 115         314 $self->__consume_ws_opt;
813            
814 115         215 my $got_pattern = 0;
815 115         205 my $need_dot = 0;
816 115 100       418 if ($self->_TriplesBlock_test) {
817 99         174 $need_dot = 1;
818 99         181 $got_pattern++;
819 99         375 $self->_TriplesBlock;
820 99         251 $self->__consume_ws_opt;
821             }
822            
823 115         1838 my $pos = length($self->{tokens});
824 115         353 while (not $self->_test('}')) {
825 45 100       222 if ($self->_GraphPatternNotTriples_test) {
    50          
826 20         46 $need_dot = 0;
827 20         47 $got_pattern++;
828 20         88 $self->_GraphPatternNotTriples;
829 20         75 $self->__consume_ws_opt;
830 20         41 my ($data) = splice(@{ $self->{stack} });
  20         60  
831 20         77 $self->__handle_GraphPatternNotTriples( $data );
832 20         52 $self->__consume_ws_opt;
833             } elsif ($self->_test( qr/FILTER/i )) {
834 25         45 $got_pattern++;
835 25         54 $need_dot = 0;
836 25         101 $self->_Filter;
837 25         68 $self->__consume_ws_opt;
838             }
839            
840 45 100 66     334 if ($need_dot or $self->_test('.')) {
841 26         80 $self->_eat('.');
842 26 50       72 if ($got_pattern) {
843 26         44 $need_dot = 0;
844 26         48 $got_pattern = 0;
845             } else {
846 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Extra dot found without preceding pattern";
847             }
848 26         70 $self->__consume_ws_opt;
849             }
850            
851 45 100       151 if ($self->_TriplesBlock_test) {
852 2         10 my $peek = $self->_peek_pattern;
853 2 50 33     35 if (blessed($peek) and $peek->isa('RDF::Query::Algebra::BasicGraphPattern')) {
854 0         0 $self->_TriplesBlock;
855 0         0 my $rhs = $self->_remove_pattern;
856 0         0 my $lhs = $self->_remove_pattern;
857 0         0 my $merged = RDF::Query::Algebra::BasicGraphPattern->new( map { $_->triples } ($lhs, $rhs) );
  0         0  
858 0         0 $self->_add_patterns( $merged );
859             } else {
860 2         6 $self->_TriplesBlock;
861             }
862 2         10 $self->__consume_ws_opt;
863             }
864            
865 45         615 $self->__consume_ws_opt;
866 45 50       222 last unless ($self->_test( qr/\S/ ));
867            
868 45         145 my $new = length($self->{tokens});
869 45 50       136 if ($pos == $new) {
870             # we haven't progressed, and so would infinite loop if we don't break out and throw an error.
871 0         0 $self->_syntax_error('');
872             } else {
873 45         138 $pos = $new;
874             }
875             }
876            
877 115         322 $self->_eat('}');
878              
879 115         308 my $cont = $self->_pop_pattern_container;
880            
881 115         233 my @filters = splice(@{ $self->{filters} });
  115         335  
882 115         189 my @patterns;
883 115         812 my $pattern = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
884 115         478 while (my $f = shift @filters) {
885 25         175 $pattern = RDF::Query::Algebra::Filter->new( $f, $pattern );
886             }
887 115         293 $self->_add_patterns( $pattern );
888             }
889              
890             sub __handle_GraphPatternNotTriples {
891 20     20   38 my $self = shift;
892 20         34 my $data = shift;
893 20         48 my ($class, @args) = @$data;
894 20 100       107 if ($class eq 'RDF::Query::Algebra::Optional') {
    100          
    50          
    0          
895 8         18 my $cont = $self->_pop_pattern_container;
896 8         32 my $ggp = RDF::Query::Algebra::GroupGraphPattern->new( @$cont );
897 8         23 $self->_push_pattern_container;
898             # my $ggp = $self->_remove_pattern();
899 8 50       31 unless ($ggp) {
900 0         0 $ggp = RDF::Query::Algebra::GroupGraphPattern->new();
901             }
902 8         60 my $opt = $class->new( $ggp, @args );
903 8         23 $self->_add_patterns( $opt );
904             } elsif ($class eq 'RDF::Query::Algebra::Union') {
905             # no-op
906             } elsif ($class eq 'RDF::Query::Algebra::NamedGraph') {
907             # no-op
908             } elsif ($class eq 'RDF::Query::Algebra::GroupGraphPattern') {
909             # no-op
910             } else {
911 0         0 Carp::confess Dumper($class, \@args);
912             }
913             }
914              
915             # [21] TriplesBlock ::= TriplesSameSubject ( '.' TriplesBlock? )?
916             sub _TriplesBlock_test {
917 254     254   365 my $self = shift;
918             # VarOrTerm | TriplesNode -> (Var | GraphTerm) | (Collection | BlankNodePropertyList) -> Var | IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL | Collection | BlankNodePropertyList
919             # but since a triple can't start with a literal, this is reduced to:
920             # Var | IRIref | BlankNode | NIL
921 254         7858 return $self->_test(qr/[\$?]|<|_:|\[[\n\r\t ]*\]|\([\n\r\t ]*\)|\[|[[(]|${r_PNAME_NS}/);
922             }
923              
924             sub _TriplesBlock {
925 101     101   190 my $self = shift;
926 101         280 $self->_push_pattern_container;
927 101         338 $self->__TriplesBlock;
928 101         336 my $triples = $self->_pop_pattern_container;
929 101         867 my $bgp = RDF::Query::Algebra::BasicGraphPattern->new( @$triples );
930 101         298 $self->_add_patterns( $bgp );
931             }
932              
933             ## this one (with two underscores) doesn't pop patterns off the stack and make a BGP.
934             ## instead, things are left on the stack so we can recurse without doing the wrong thing.
935             ## the one with one underscore (_TriplesBlock) will pop everything off and make the BGP.
936             sub __TriplesBlock {
937 145     145   232 my $self = shift;
938 145         501 $self->_TriplesSameSubject;
939 145         356 $self->__consume_ws_opt;
940 145         338 my $got_dot = 0;
941 145         376 while ($self->_test('.')) {
942 90 50       247 if ($got_dot) {
943 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: found extra DOT after TriplesBlock";
944             }
945 90         239 $self->_eat('.');
946 90         131 $got_dot++;
947 90         233 $self->__consume_ws_opt;
948 90 100       264 if ($self->_TriplesBlock_test) {
949 44         80 $got_dot = 0;
950 44         153 $self->__TriplesBlock;
951 44         109 $self->__consume_ws_opt;
952             }
953             }
954             }
955              
956             # [22] GraphPatternNotTriples ::= OptionalGraphPattern | GroupOrUnionGraphPattern | GraphGraphPattern
957             sub _GraphPatternNotTriples_test {
958 45     45   96 my $self = shift;
959 45         301 return $self->_test(qr/OPTIONAL|{|GRAPH/i);
960             }
961              
962             sub _GraphPatternNotTriples {
963 20     20   46 my $self = shift;
964 20 100       76 if ($self->_OptionalGraphPattern_test) {
    100          
965 8         27 $self->_OptionalGraphPattern;
966             } elsif ($self->_GroupOrUnionGraphPattern_test) {
967 2         7 $self->_GroupOrUnionGraphPattern;
968             } else {
969 10         41 $self->_GraphGraphPattern;
970             }
971             }
972              
973             # [23] OptionalGraphPattern ::= 'OPTIONAL' GroupGraphPattern
974             sub _OptionalGraphPattern_test {
975 20     20   48 my $self = shift;
976 20         93 return $self->_test( qr/OPTIONAL/i );
977             }
978              
979             sub _OptionalGraphPattern {
980 8     8   13 my $self = shift;
981 8         32 $self->_eat( qr/OPTIONAL/i );
982 8         28 $self->__consume_ws_opt;
983 8         36 $self->_GroupGraphPattern;
984 8         30 my $ggp = $self->_remove_pattern;
985 8         18 my $opt = ['RDF::Query::Algebra::Optional', $ggp];
986 8         23 $self->_add_stack( $opt );
987             }
988              
989             # [24] GraphGraphPattern ::= 'GRAPH' VarOrIRIref GroupGraphPattern
990             sub _GraphGraphPattern {
991 10     10   23 my $self = shift;
992 10         74 $self->_eat( qr/GRAPH/i );
993 10         40 $self->__consume_ws;
994 10         44 $self->_VarOrIRIref;
995 10         27 my ($graph) = splice(@{ $self->{stack} });
  10         30  
996 10         36 $self->__consume_ws_opt;
997            
998             # if ($graph->isa('RDF::Trine::Node::Resource')) {
999 10         48 local($self->{named_graph}) = $graph;
1000 10         61 $self->_GroupGraphPattern;
1001             # } else {
1002             # $self->_GroupGraphPattern;
1003             # }
1004            
1005 10         35 my $ggp = $self->_remove_pattern;
1006 10         129 my $pattern = RDF::Query::Algebra::NamedGraph->new( $graph, $ggp );
1007 10         27 $self->_add_patterns( $pattern );
1008 10         50 $self->_add_stack( [ 'RDF::Query::Algebra::NamedGraph' ] );
1009             }
1010              
1011             # [25] GroupOrUnionGraphPattern ::= GroupGraphPattern ( 'UNION' GroupGraphPattern )*
1012             sub _GroupOrUnionGraphPattern_test {
1013 12     12   25 my $self = shift;
1014 12         35 return $self->_test('{');
1015             }
1016              
1017             sub _GroupOrUnionGraphPattern {
1018 2     2   5 my $self = shift;
1019 2         115 $self->_GroupGraphPattern;
1020 2         7 my $ggp = $self->_remove_pattern;
1021 2         6 $self->__consume_ws_opt;
1022            
1023 2 50       11 if ($self->_test( qr/UNION/i )) {
1024 2         10 while ($self->_test( qr/UNION/i )) {
1025 2         11 $self->_eat( qr/UNION/i );
1026 2         8 $self->__consume_ws_opt;
1027 2         6 $self->_GroupGraphPattern;
1028 2         6 $self->__consume_ws_opt;
1029 2         5 my $rhs = $self->_remove_pattern;
1030 2         19 $ggp = RDF::Query::Algebra::Union->new( $ggp, $rhs );
1031             }
1032 2         11 $self->_add_patterns( $ggp );
1033 2         6 $self->_add_stack( [ 'RDF::Query::Algebra::Union' ] );
1034             } else {
1035 0         0 $self->_add_patterns( $ggp );
1036 0         0 $self->_add_stack( [ 'RDF::Query::Algebra::GroupGraphPattern' ] );
1037             }
1038             }
1039              
1040             # [26] Filter ::= 'FILTER' Constraint
1041             sub _Filter {
1042 25     25   54 my $self = shift;
1043 25         118 $self->_eat( qr/FILTER/i );
1044 25         94 $self->__consume_ws_opt;
1045 25         96 $self->_Constraint;
1046 25         85 my ($expr) = splice(@{ $self->{stack} });
  25         74  
1047 25         84 $self->_add_filter( $expr );
1048             }
1049              
1050             # [27] Constraint ::= BrackettedExpression | BuiltInCall | FunctionCall
1051             sub _Constraint_test {
1052 7     7   12 my $self = shift;
1053 7 50       37 return 1 if $self->_test( qr/[(]/ );
1054 7 50       56 return 1 if $self->_BuiltInCall_test;
1055 7 50       53 return 1 if $self->_FunctionCall_test;
1056 7         159 return 0;
1057             }
1058              
1059             sub _Constraint {
1060 25     25   49 my $self = shift;
1061 25 100       100 if ($self->_BrackettedExpression_test) {
    100          
1062 18         61 $self->_BrackettedExpression();
1063             } elsif ($self->_BuiltInCall_test) {
1064 6         28 $self->_BuiltInCall();
1065             } else {
1066 1         8 $self->_FunctionCall();
1067             }
1068             }
1069              
1070             # [28] FunctionCall ::= IRIref ArgList
1071             sub _FunctionCall_test {
1072 7     7   15 my $self = shift;
1073 7         25 return $self->_IRIref_test;
1074             }
1075              
1076             sub _FunctionCall {
1077 1     1   3 my $self = shift;
1078 1         3 $self->_IRIref;
1079 1         16 my ($iri) = splice(@{ $self->{stack} });
  1         4  
1080            
1081 1         5 $self->__consume_ws_opt;
1082            
1083 1         4 $self->_ArgList;
1084 1         3 my @args = splice(@{ $self->{stack} });
  1         4  
1085 1         9 my $func = $self->new_function_expression( $iri, @args );
1086 1         5 $self->_add_stack( $func );
1087             }
1088              
1089             # [29] ArgList ::= ( NIL | '(' Expression ( ',' Expression )* ')' )
1090             sub _ArgList_test {
1091 13     13   23 my $self = shift;
1092 13         38 return $self->_test('(');
1093             }
1094              
1095             sub _ArgList {
1096 12     12   23 my $self = shift;
1097 12         34 $self->_eat('(');
1098 12         33 $self->__consume_ws_opt;
1099 12         25 my @args;
1100 12 50       34 unless ($self->_test(')')) {
1101 12         37 $self->_Expression;
1102 12         21 push( @args, splice(@{ $self->{stack} }) );
  12         30  
1103 12         33 while ($self->_test(',')) {
1104 9         21 $self->_eat(',');
1105 9         21 $self->__consume_ws_opt;
1106 9         22 $self->_Expression;
1107 9         16 push( @args, splice(@{ $self->{stack} }) );
  9         25  
1108             }
1109             }
1110 12         33 $self->_eat(')');
1111 12         34 $self->_add_stack( @args );
1112             }
1113              
1114             # [30] ConstructTemplate ::= '{' ConstructTriples? '}'
1115             sub _ConstructTemplate {
1116 4     4   7 my $self = shift;
1117 4         14 $self->_push_pattern_container;
1118 4         11 $self->_eat( '{' );
1119 4         11 $self->__consume_ws_opt;
1120            
1121 4 50       15 if ($self->_ConstructTriples_test) {
1122 4         15 $self->_ConstructTriples;
1123             }
1124              
1125 4         67 $self->__consume_ws_opt;
1126 4         13 $self->_eat( '}' );
1127 4         14 my $cont = $self->_pop_pattern_container;
1128 4         11 $self->{build}{construct_triples} = $cont;
1129             }
1130              
1131             # [31] ConstructTriples ::= TriplesSameSubject ( '.' ConstructTriples? )?
1132             sub _ConstructTriples_test {
1133 4     4   10 my $self = shift;
1134 4         17 return $self->_TriplesBlock_test;
1135             }
1136              
1137             sub _ConstructTriples {
1138 4     4   9 my $self = shift;
1139 4         17 $self->_TriplesSameSubject;
1140 4         13 $self->__consume_ws_opt;
1141 4         19 while ($self->_test(qr/[.]/)) {
1142 0         0 $self->_eat( qr/[.]/ );
1143 0         0 $self->__consume_ws_opt;
1144 0 0       0 if ($self->_ConstructTriples_test) {
1145 0         0 $self->_TriplesSameSubject;
1146             }
1147             }
1148             }
1149              
1150             # [32] TriplesSameSubject ::= VarOrTerm PropertyListNotEmpty | TriplesNode PropertyList
1151             sub _TriplesSameSubject {
1152 149     149   217 my $self = shift;
1153 149         224 my @triples;
1154 149 100       460 if ($self->_TriplesNode_test) {
1155 4         19 $self->_TriplesNode;
1156 4         16 my ($s) = splice(@{ $self->{stack} });
  4         13  
1157 4         15 $self->__consume_ws_opt;
1158 4         16 $self->_PropertyList;
1159 4         110 $self->__consume_ws_opt;
1160            
1161 4         8 my @list = splice(@{ $self->{stack} });
  4         15  
1162 4         16 foreach my $data (@list) {
1163 0         0 push(@triples, $self->__new_statement( $s, @$data ));
1164             }
1165             } else {
1166 145         503 $self->_VarOrTerm;
1167 145         385 my ($s) = splice(@{ $self->{stack} });
  145         414  
1168              
1169 145         388 $self->__consume_ws_opt;
1170 145         1230 $self->_PropertyListNotEmpty;
1171 145         354 $self->__consume_ws_opt;
1172 145         242 my (@list) = splice(@{ $self->{stack} });
  145         394  
1173 145         353 foreach my $data (@list) {
1174 185         1290 push(@triples, $self->__new_statement( $s, @$data ));
1175             }
1176             }
1177            
1178 149         3373 $self->_add_patterns( @triples );
1179             # return @triples;
1180             }
1181              
1182             # [33] PropertyListNotEmpty ::= Verb ObjectList ( ';' ( Verb ObjectList )? )*
1183             sub _PropertyListNotEmpty {
1184 148     148   253 my $self = shift;
1185 148         508 $self->_Verb;
1186 148         1677 my ($v) = splice(@{ $self->{stack} });
  148         392  
1187 148         446 $self->__consume_ws_opt;
1188 148         525 $self->_ObjectList;
1189 148         232 my @l = splice(@{ $self->{stack} });
  148         378  
1190 148         341 my @props = map { [$v, $_] } @l;
  149         538  
1191 148         651 while ($self->_test(qr'\s*;')) {
1192 45         206 $self->_eat(';');
1193 45         123 $self->__consume_ws_opt;
1194 45 50       149 if ($self->_Verb_test) {
1195 45         197 $self->_Verb;
1196 45         640 my ($v) = splice(@{ $self->{stack} });
  45         201  
1197 45         150 $self->__consume_ws_opt;
1198 45         135 $self->_ObjectList;
1199 45         79 my @l = splice(@{ $self->{stack} });
  45         119  
1200 45         102 push(@props, map { [$v, $_] } @l);
  45         1387  
1201             }
1202             }
1203 148         593 $self->_add_stack( @props );
1204             }
1205              
1206             # [34] PropertyList ::= PropertyListNotEmpty?
1207             sub _PropertyList {
1208 4     4   8 my $self = shift;
1209 4 50       14 if ($self->_Verb_test) {
1210 0         0 $self->_PropertyListNotEmpty;
1211             }
1212             }
1213              
1214             # [35] ObjectList ::= Object ( ',' Object )*
1215             sub _ObjectList {
1216 193     193   297 my $self = shift;
1217            
1218 193         279 my @list;
1219 193         592 $self->_Object;
1220 193         1425 push(@list, splice(@{ $self->{stack} }));
  193         491  
1221            
1222 193         523 $self->__consume_ws_opt;
1223 193         498 while ($self->_test(',')) {
1224 1         4 $self->_eat(',');
1225 1         3 $self->__consume_ws_opt;
1226 1         3 $self->_Object;
1227 1         6 push(@list, splice(@{ $self->{stack} }));
  1         4  
1228 1         3 $self->__consume_ws_opt;
1229             }
1230 193         499 $self->_add_stack( @list );
1231             }
1232              
1233             # [36] Object ::= GraphNode
1234             sub _Object {
1235 194     194   309 my $self = shift;
1236 194         560 $self->_GraphNode;
1237             }
1238              
1239             # [37] Verb ::= VarOrIRIref | 'a'
1240             sub _Verb_test {
1241 49     49   83 my $self = shift;
1242 49         6807 return $self->_test( qr/a[\n\t\r <]|[?\$]|<|${r_PNAME_LN}|${r_PNAME_NS}/ );
1243             }
1244              
1245             sub _Verb {
1246 193     193   319 my $self = shift;
1247 193 100       940 if ($self->_test(qr/a[\n\t\r <]/)) {
1248 41         148 $self->_eat('a');
1249 41         120 $self->__consume_ws;
1250 41         503 my $type = RDF::Query::Node::Resource->new( $rdf->type->uri_value );
1251 41         2715 $self->_add_stack( $type );
1252             } else {
1253 152         433 $self->_VarOrIRIref;
1254             }
1255             }
1256              
1257             # [38] TriplesNode ::= Collection | BlankNodePropertyList
1258             sub _TriplesNode_test {
1259 349     349   495 my $self = shift;
1260 349         1418 return $self->_test(qr/[[(](?![\n\r\t ]*\])(?![\n\r\t ]*\))/);
1261             }
1262              
1263             sub _TriplesNode {
1264 5     5   8 my $self = shift;
1265 5 100       25 if ($self->_test(qr/\(/)) {
1266 2         9 $self->_Collection;
1267             } else {
1268 3         13 $self->_BlankNodePropertyList;
1269             }
1270             }
1271              
1272             # [39] BlankNodePropertyList ::= '[' PropertyListNotEmpty ']'
1273             sub _BlankNodePropertyList {
1274 3     3   6 my $self = shift;
1275 3         13 $self->_eat('[');
1276 3         9 $self->__consume_ws_opt;
1277 3         13 $self->_PropertyListNotEmpty;
1278 3         10 $self->__consume_ws_opt;
1279 3         11 $self->_eat(']');
1280            
1281 3         6 my @props = splice(@{ $self->{stack} });
  3         12  
1282 3         27 my $subj = $self->new_blank;
1283 3         26 my @triples = map { $self->__new_statement( $subj, @$_ ) } @props;
  9         136  
1284 3         59 $self->_add_patterns( @triples );
1285 3         10 $self->_add_stack( $subj );
1286             }
1287              
1288             # [40] Collection ::= '(' GraphNode+ ')'
1289             sub _Collection {
1290 2     2   3 my $self = shift;
1291 2         6 $self->_eat('(');
1292 2         4 $self->__consume_ws_opt;
1293 2         10 $self->_GraphNode;
1294 2         13 $self->__consume_ws_opt;
1295            
1296 2         3 my @nodes;
1297 2         5 push(@nodes, splice(@{ $self->{stack} }));
  2         6  
1298            
1299 2         8 while ($self->_GraphNode_test) {
1300 4         30 $self->_GraphNode;
1301 4         22 $self->__consume_ws_opt;
1302 4         6 push(@nodes, splice(@{ $self->{stack} }));
  4         14  
1303             }
1304            
1305 2         15 $self->_eat(')');
1306            
1307 2         15 my $subj = $self->new_blank;
1308 2         15 my $cur = $subj;
1309 2         4 my $last;
1310              
1311 2         31 my $first = RDF::Query::Node::Resource->new( $rdf->first->uri_value );
1312 2         123 my $rest = RDF::Query::Node::Resource->new( $rdf->rest->uri_value );
1313 2         109 my $nil = RDF::Query::Node::Resource->new( $rdf->nil->uri_value );
1314              
1315            
1316 2         99 my @triples;
1317 2         16 foreach my $node (@nodes) {
1318 6         18 push(@triples, $self->__new_statement( $cur, $first, $node ) );
1319 6         111 my $new = $self->new_blank;
1320 6         42 push(@triples, $self->__new_statement( $cur, $rest, $new ) );
1321 6         93 $last = $cur;
1322 6         10 $cur = $new;
1323             }
1324 2         5 pop(@triples);
1325 2         8 push(@triples, $self->__new_statement( $last, $rest, $nil ));
1326 2         36 $self->_add_patterns( @triples );
1327            
1328 2         7 $self->_add_stack( $subj );
1329             }
1330              
1331             # [41] GraphNode ::= VarOrTerm | TriplesNode
1332             sub _GraphNode_test {
1333 6     6   10 my $self = shift;
1334             # VarOrTerm | TriplesNode -> (Var | GraphTerm) | (Collection | BlankNodePropertyList) -> Var | IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL | Collection | BlankNodePropertyList
1335             # but since a triple can't start with a literal, this is reduced to:
1336             # Var | IRIref | BlankNode | NIL
1337 6         97 return $self->_test(qr/[\$?]|<|['"]|(true\b|false\b)|([+-]?\d)|_:|${r_ANON}|${r_NIL}|\[|[[(]/);
1338             }
1339              
1340             sub _GraphNode {
1341 200     200   399 my $self = shift;
1342 200 100       578 if ($self->_TriplesNode_test) {
1343 1         5 $self->_TriplesNode;
1344             } else {
1345 199         532 $self->_VarOrTerm;
1346             }
1347             }
1348              
1349             # [42] VarOrTerm ::= Var | GraphTerm
1350             sub _VarOrTerm_test {
1351 0     0   0 my $self = shift;
1352 0 0       0 return 1 if ($self->_test(qr/[\$?]/));
1353 0 0       0 return 1 if ($self->_test(qr/[<'".0-9]|(true|false)\b|_:|\([\n\r\t ]*\)/));
1354 0         0 return 0;
1355             }
1356              
1357             sub _VarOrTerm {
1358 344     344   514 my $self = shift;
1359 344 100       1109 if ($self->{tokens} =~ m'^[?$]') {
1360 250         784 $self->_Var;
1361             } else {
1362 94         338 $self->_GraphTerm;
1363             }
1364             }
1365              
1366             # [43] VarOrIRIref ::= Var | IRIref
1367             sub _VarOrIRIref_test {
1368 4     4   9 my $self = shift;
1369 4         890 return $self->_test(qr/[\$?]|<|${r_PNAME_LN}|${r_PNAME_NS}/);
1370             }
1371              
1372             sub _VarOrIRIref {
1373 166     166   270 my $self = shift;
1374 166 100       585 if ($self->{tokens} =~ m'^[?$]') {
1375 20         63 $self->_Var;
1376             } else {
1377 146         426 $self->_IRIref;
1378             }
1379             }
1380              
1381             # [44] Var ::= VAR1 | VAR2
1382             sub _Var {
1383 426     426   590 my $self = shift;
1384 426 50       956 my $var = ($self->_test( $r_VAR1 )) ? $self->_eat( $r_VAR1 ) : $self->_eat( $r_VAR2 );
1385 426         4498 $self->_add_stack( RDF::Query::Node::Variable->new( substr($var,1) ) );
1386             }
1387              
1388             # [45] GraphTerm ::= IRIref | RDFLiteral | NumericLiteral | BooleanLiteral | BlankNode | NIL
1389             sub _GraphTerm {
1390 94     94   156 my $self = shift;
1391 94 50 66     418 if ($self->_test(qr/(true|false)\b/)) {
    50          
    100          
    50          
    100          
1392 0         0 $self->_BooleanLiteral;
1393             } elsif ($self->_test('(')) {
1394 0         0 $self->_NIL;
1395             } elsif ($self->_test( $r_ANON ) or $self->_test('_:')) {
1396 2         12 $self->_BlankNode;
1397             } elsif ($self->_test(qr/[-+]?\d/)) {
1398 0         0 $self->_NumericLiteral;
1399             } elsif ($self->_test(qr/['"]/)) {
1400 46         208 $self->_RDFLiteral;
1401             } else {
1402 46         194 $self->_IRIref;
1403             }
1404             }
1405              
1406             # [46] Expression ::= ConditionalOrExpression
1407             sub _Expression {
1408 68     68   108 my $self = shift;
1409 68         196 $self->_ConditionalOrExpression;
1410             }
1411              
1412             # [47] ConditionalOrExpression ::= ConditionalAndExpression ( '||' ConditionalAndExpression )*
1413             sub _ConditionalOrExpression {
1414 68     68   93 my $self = shift;
1415 68         88 my @list;
1416            
1417 68         181 $self->_ConditionalAndExpression;
1418 68         116 push(@list, splice(@{ $self->{stack} }));
  68         145  
1419            
1420 68         165 $self->__consume_ws_opt;
1421 68         163 while ($self->_test('||')) {
1422 1         4 $self->_eat('||');
1423 1         3 $self->__consume_ws_opt;
1424 1         4 $self->_ConditionalAndExpression;
1425 1         3 push(@list, splice(@{ $self->{stack} }));
  1         5  
1426             }
1427            
1428 68 100       176 if (scalar(@list) > 1) {
1429 1         9 $self->_add_stack( $self->new_function_expression( 'sparql:logical-or', @list ) );
1430             } else {
1431 67         153 $self->_add_stack( @list );
1432             }
1433 68 50       97 Carp::confess $self->{tokens} if (scalar(@{ $self->{stack} }) == 0);
  68         278  
1434             }
1435              
1436             # [48] ConditionalAndExpression ::= ValueLogical ( '&&' ValueLogical )*
1437             sub _ConditionalAndExpression {
1438 69     69   101 my $self = shift;
1439 69         85 my @list;
1440            
1441 69         177 $self->_ValueLogical;
1442 69         231 push(@list, splice(@{ $self->{stack} }));
  69         176  
1443 69 50       221 Carp::confess Dumper(\@list) if (scalar(@list) > 1);
1444            
1445 69         173 $self->__consume_ws_opt;
1446 69         173 while ($self->_test('&&')) {
1447 0         0 $self->_eat('&&');
1448 0         0 $self->__consume_ws_opt;
1449 0         0 $self->_ValueLogical;
1450 0         0 push(@list, splice(@{ $self->{stack} }));
  0         0  
1451             }
1452            
1453 69 50       159 if (scalar(@list) > 1) {
1454 0         0 $self->_add_stack( $self->new_function_expression( 'sparql:logical-and', @list ) );
1455             } else {
1456 69         168 $self->_add_stack( @list );
1457             }
1458             }
1459              
1460             # [49] ValueLogical ::= RelationalExpression
1461             sub _ValueLogical {
1462 69     69   106 my $self = shift;
1463 69         191 $self->_RelationalExpression;
1464             }
1465              
1466             # [50] RelationalExpression ::= NumericExpression ( '=' NumericExpression | '!=' NumericExpression | '<' NumericExpression | '>' NumericExpression | '<=' NumericExpression | '>=' NumericExpression )?
1467             sub _RelationalExpression {
1468 69     69   95 my $self = shift;
1469 69         166 $self->_NumericExpression;
1470            
1471 69         167 $self->__consume_ws_opt;
1472 69 100       284 if ($self->_test(qr/[!<>]?=|[<>]/)) {
1473 13 50       43 if ($self->_test( $r_IRI_REF )) {
1474 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: IRI found where expression expected";
1475             }
1476 13         33 my @list = splice(@{ $self->{stack} });
  13         44  
1477 13         56 my $op = $self->_eat(qr/[!<>]?=|[<>]/);
1478 13 100       71 $op = '==' if ($op eq '=');
1479 13         39 $self->__consume_ws_opt;
1480 13         35 $self->_NumericExpression;
1481 13         27 push(@list, splice(@{ $self->{stack} }));
  13         32  
1482 13         78 $self->_add_stack( $self->new_binary_expression( $op, @list ) );
1483             }
1484             }
1485              
1486             # [51] NumericExpression ::= AdditiveExpression
1487             sub _NumericExpression {
1488 82     82   121 my $self = shift;
1489 82         201 $self->_AdditiveExpression;
1490             }
1491              
1492             # [52] AdditiveExpression ::= MultiplicativeExpression ( '+' MultiplicativeExpression | '-' MultiplicativeExpression | NumericLiteralPositive | NumericLiteralNegative )*
1493             sub _AdditiveExpression {
1494 82     82   166 my $self = shift;
1495 82         218 $self->_MultiplicativeExpression;
1496 82         120 my ($expr) = splice(@{ $self->{stack} });
  82         192  
1497            
1498 82         200 $self->__consume_ws_opt;
1499 82         374 while ($self->_test(qr/[-+]/)) {
1500 0         0 my $op = $self->_eat(qr/[-+]/);
1501 0         0 $self->__consume_ws_opt;
1502 0         0 $self->_MultiplicativeExpression;
1503 0         0 my ($rhs) = splice(@{ $self->{stack} });
  0         0  
1504 0         0 $expr = $self->new_binary_expression( $op, $expr, $rhs );
1505             }
1506 82         266 $self->_add_stack( $expr );
1507             }
1508              
1509             # [53] MultiplicativeExpression ::= UnaryExpression ( '*' UnaryExpression | '/' UnaryExpression )*
1510             sub _MultiplicativeExpression {
1511 82     82   102 my $self = shift;
1512 82         229 $self->_UnaryExpression;
1513 82         2093 my ($expr) = splice(@{ $self->{stack} });
  82         210  
1514            
1515 82         218 $self->__consume_ws_opt;
1516 82         374 while ($self->_test(qr#[*/]#)) {
1517 2         10 my $op = $self->_eat(qr#[*/]#);
1518 2         9 $self->__consume_ws_opt;
1519 2         6 $self->_UnaryExpression;
1520 2         5 my ($rhs) = splice(@{ $self->{stack} });
  2         6  
1521 2         12 $expr = $self->new_binary_expression( $op, $expr, $rhs );
1522             }
1523 82         280 $self->_add_stack( $expr );
1524             }
1525              
1526             # [54] UnaryExpression ::= '!' PrimaryExpression | '+' PrimaryExpression | '-' PrimaryExpression | PrimaryExpression
1527             sub _UnaryExpression {
1528 84     84   155 my $self = shift;
1529 84 50       186 if ($self->_test('!')) {
    50          
    100          
1530 0         0 $self->_eat('!');
1531 0         0 $self->__consume_ws_opt;
1532 0         0 $self->_PrimaryExpression;
1533 0         0 my ($expr) = splice(@{ $self->{stack} });
  0         0  
1534 0         0 my $not = $self->new_unary_expression( '!', $expr );
1535 0         0 $self->_add_stack( $not );
1536             } elsif ($self->_test('+')) {
1537 0         0 $self->_eat('+');
1538 0         0 $self->__consume_ws_opt;
1539 0         0 $self->_PrimaryExpression;
1540 0         0 my ($expr) = splice(@{ $self->{stack} });
  0         0  
1541            
1542             ### if it's just a literal, force the positive down into the literal
1543 0 0 0     0 if (blessed($expr) and $expr->isa('RDF::Trine::Node::Literal') and $expr->is_numeric_type) {
      0        
1544 0         0 my $value = '+' . $expr->literal_value;
1545 0         0 $expr->literal_value( $value );
1546 0         0 $self->_add_stack( $expr );
1547             } else {
1548 0         0 $self->_add_stack( $expr );
1549             }
1550             } elsif ($self->_test('-')) {
1551 4         12 $self->_eat('-');
1552 4         13 $self->__consume_ws_opt;
1553 4         11 $self->_PrimaryExpression;
1554 4         139 my ($expr) = splice(@{ $self->{stack} });
  4         15  
1555            
1556             ### if it's just a literal, force the negative down into the literal instead of make an unnecessary multiplication.
1557 4 50 33     65 if (blessed($expr) and $expr->isa('RDF::Trine::Node::Literal') and $expr->is_numeric_type) {
      33        
1558 4         18 my $value = -1 * $expr->literal_value;
1559 4         45 $expr->literal_value( $value );
1560 4         30 $self->_add_stack( $expr );
1561             } else {
1562 0         0 my $int = $xsd->integer->uri_value;
1563 0         0 my $neg = $self->new_binary_expression( '*', $self->new_literal('-1', undef, $int), $expr );
1564 0         0 $self->_add_stack( $neg );
1565             }
1566             } else {
1567 80         216 $self->_PrimaryExpression;
1568             }
1569             }
1570              
1571             # [55] PrimaryExpression ::= BrackettedExpression | BuiltInCall | IRIrefOrFunction | RDFLiteral | NumericLiteral | BooleanLiteral | Var
1572             sub _PrimaryExpression {
1573 84     84   121 my $self = shift;
1574 84 50       194 if ($self->_BrackettedExpression_test) {
    100          
    100          
    100          
    50          
    100          
1575 0         0 $self->_BrackettedExpression;
1576             } elsif ($self->_BuiltInCall_test) {
1577 15         72 $self->_BuiltInCall;
1578             } elsif ($self->_IRIref_test) {
1579 13         59 $self->_IRIrefOrFunction;
1580             } elsif ($self->_test(qr/[\$?]/)) {
1581 25         75 $self->_Var;
1582             } elsif ($self->_test(qr/(true|false)\b/)) {
1583 0         0 $self->_BooleanLiteral;
1584             } elsif ($self->_test(qr/[-+]?\d/)) {
1585 8         29 $self->_NumericLiteral;
1586             } else { # if ($self->_test(qr/['"]/)) {
1587 23         85 $self->_RDFLiteral;
1588             }
1589             }
1590              
1591             # [56] BrackettedExpression ::= '(' Expression ')'
1592             sub _BrackettedExpression_test {
1593 109     109   188 my $self = shift;
1594 109         233 return $self->_test('(');
1595             }
1596              
1597             sub _BrackettedExpression {
1598 20     20   35 my $self = shift;
1599 20         51 $self->_eat('(');
1600 20         49 $self->__consume_ws_opt;
1601 20         73 $self->_Expression;
1602 20         55 $self->__consume_ws_opt;
1603 20         54 $self->_eat(')');
1604             }
1605              
1606             # [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
1607             sub _BuiltInCall_test {
1608 98     98   155 my $self = shift;
1609 98         428 return $self->_test(qr/STR|LANG|LANGMATCHES|DATATYPE|BOUND|sameTerm|isIRI|isURI|isBLANK|isLITERAL|REGEX/i);
1610             }
1611              
1612             sub _BuiltInCall {
1613 21     21   47 my $self = shift;
1614 21 100       69 if ($self->_RegexExpression_test) {
1615 6         34 $self->_RegexExpression;
1616             } else {
1617 15         76 my $op = $self->_eat( qr/\w+/ );
1618 15         124 my $iri = RDF::Query::Node::Resource->new( 'sparql:' . lc($op) );
1619 15         251 $self->__consume_ws_opt;
1620 15         49 $self->_eat('(');
1621 15         49 $self->__consume_ws_opt;
1622 15 100       100 if ($op =~ /^(STR|LANG|DATATYPE|isIRI|isURI|isBLANK|isLITERAL)$/i) {
    100          
1623             ### one-arg functions that take an expression
1624 13         47 $self->_Expression;
1625 13         25 my ($expr) = splice(@{ $self->{stack} });
  13         35  
1626 13         107 $self->_add_stack( $self->new_function_expression($iri, $expr) );
1627             } elsif ($op =~ /^(LANGMATCHES|sameTerm)$/i) {
1628             ### two-arg functions that take expressions
1629 1         4 $self->_Expression;
1630 1         3 my ($arg1) = splice(@{ $self->{stack} });
  1         4  
1631 1         4 $self->__consume_ws_opt;
1632 1         4 $self->_eat(',');
1633 1         3 $self->__consume_ws_opt;
1634 1         3 $self->_Expression;
1635 1         2 my ($arg2) = splice(@{ $self->{stack} });
  1         4  
1636 1         5 $self->_add_stack( $self->new_function_expression($iri, $arg1, $arg2) );
1637             } else {
1638             ### BOUND(Var)
1639 1         4 $self->_Var;
1640 1         3 my ($expr) = splice(@{ $self->{stack} });
  1         3  
1641 1         13 $self->_add_stack( $self->new_function_expression($iri, $expr) );
1642             }
1643 15         48 $self->__consume_ws_opt;
1644 15         47 $self->_eat(')');
1645             }
1646             }
1647              
1648             # [58] RegexExpression ::= 'REGEX' '(' Expression ',' Expression ( ',' Expression )? ')'
1649             sub _RegexExpression_test {
1650 21     21   38 my $self = shift;
1651 21         99 return $self->_test( qr/REGEX/i );
1652             }
1653              
1654             sub _RegexExpression {
1655 6     6   16 my $self = shift;
1656 6         28 $self->_eat( qr/REGEX/i );
1657 6         25 $self->__consume_ws_opt;
1658 6         18 $self->_eat('(');
1659 6         22 $self->__consume_ws_opt;
1660 6         24 $self->_Expression;
1661 6         9 my $string = splice(@{ $self->{stack} });
  6         23  
1662            
1663 6         20 $self->__consume_ws_opt;
1664 6         21 $self->_eat(',');
1665 6         19 $self->__consume_ws_opt;
1666 6         25 $self->_Expression;
1667 6         11 my $pattern = splice(@{ $self->{stack} });
  6         18  
1668            
1669 6         19 my @args = ($string, $pattern);
1670 6 50       23 if ($self->_test(',')) {
1671 0         0 $self->_eat(',');
1672 0         0 $self->__consume_ws_opt;
1673 0         0 $self->_Expression;
1674 0         0 push(@args, splice(@{ $self->{stack} }));
  0         0  
1675             }
1676            
1677 6         24 $self->__consume_ws_opt;
1678 6         20 $self->_eat(')');
1679            
1680 6         28 my $iri = RDF::Query::Node::Resource->new( 'sparql:regex' );
1681 6         113 $self->_add_stack( $self->new_function_expression( $iri, @args ) );
1682             }
1683              
1684             # [59] IRIrefOrFunction ::= IRIref ArgList?
1685             sub _IRIrefOrFunction_test {
1686 0     0   0 my $self = shift;
1687 0         0 $self->_IRIref_test;
1688             }
1689              
1690             sub _IRIrefOrFunction {
1691 13     13   25 my $self = shift;
1692 13         40 $self->_IRIref;
1693 13 100       216 if ($self->_ArgList_test) {
1694 11         20 my ($iri) = splice(@{ $self->{stack} });
  11         31  
1695 11         43 $self->_ArgList;
1696 11         23 my @args = splice(@{ $self->{stack} });
  11         29  
1697 11         64 my $func = $self->new_function_expression( $iri, @args );
1698 11         36 $self->_add_stack( $func );
1699             }
1700             }
1701              
1702             # [60] RDFLiteral ::= String ( LANGTAG | ( '^^' IRIref ) )?
1703             sub _RDFLiteral {
1704 69     69   158 my $self = shift;
1705 69         257 $self->_String;
1706 69         129 my @args = splice(@{ $self->{stack} });
  69         211  
1707 69 100       214 if ($self->_test('@')) {
    100          
1708 1         4 my $lang = $self->_eat( $r_LANGTAG );
1709 1         4 substr($lang,0,1) = ''; # remove '@'
1710 1         3 push(@args, lc($lang));
1711             } elsif ($self->_test('^^')) {
1712 7         17 $self->_eat('^^');
1713 7         12 push(@args, undef);
1714 7         18 $self->_IRIref;
1715 7         88 my ($iri) = splice(@{ $self->{stack} });
  7         17  
1716 7         34 push(@args, $iri->uri_value);
1717             }
1718 69         603 $self->_add_stack( RDF::Query::Node::Literal->new( @args ) );
1719             }
1720              
1721             # [61] NumericLiteral ::= NumericLiteralUnsigned | NumericLiteralPositive | NumericLiteralNegative
1722             # [62] NumericLiteralUnsigned ::= INTEGER | DECIMAL | DOUBLE
1723             # [63] NumericLiteralPositive ::= INTEGER_POSITIVE | DECIMAL_POSITIVE | DOUBLE_POSITIVE
1724             # [64] NumericLiteralNegative ::= INTEGER_NEGATIVE | DECIMAL_NEGATIVE | DOUBLE_NEGATIVE
1725             sub _NumericLiteral {
1726 8     8   13 my $self = shift;
1727 8         16 my $sign = 0;
1728 8 50       22 if ($self->_test('+')) {
    50          
1729 0         0 $self->_eat('+');
1730 0         0 $sign = '+';
1731             } elsif ($self->_test('-')) {
1732 0         0 $self->_eat('-');
1733 0         0 $sign = '-';
1734             }
1735            
1736 8         16 my $value;
1737             my $type;
1738 8 50       20 if ($self->_test( $r_DOUBLE )) {
    100          
1739 0         0 $value = $self->_eat( $r_DOUBLE );
1740 0         0 my $double = RDF::Query::Node::Resource->new( $xsd->double->uri_value );
1741 0         0 $type = $double
1742             } elsif ($self->_test( $r_DECIMAL )) {
1743 4         13 $value = $self->_eat( $r_DECIMAL );
1744 4         54 my $decimal = RDF::Query::Node::Resource->new( $xsd->decimal->uri_value );
1745 4         216 $type = $decimal;
1746             } else {
1747 4         15 $value = $self->_eat( $r_INTEGER );
1748 4         52 my $integer = RDF::Query::Node::Resource->new( $xsd->integer->uri_value );
1749 4         201 $type = $integer;
1750             }
1751            
1752 8 50       112 if ($sign) {
1753 0         0 $value = $sign . $value;
1754             }
1755 8         30 $self->_add_stack( RDF::Query::Node::Literal->new( $value, undef, $type->uri_value ) );
1756             }
1757              
1758             # [65] BooleanLiteral ::= 'true' | 'false'
1759             sub _BooleanLiteral {
1760 0     0   0 my $self = shift;
1761 0         0 my $bool = $self->_eat(qr/(true|false)\b/);
1762 0         0 $self->_add_stack( RDF::Query::Node::Literal->new( $bool, undef, $xsd->boolean->uri_value ) );
1763             }
1764              
1765             # [66] String ::= STRING_LITERAL1 | STRING_LITERAL2 | STRING_LITERAL_LONG1 | STRING_LITERAL_LONG2
1766             sub _String {
1767 69     69   133 my $self = shift;
1768 69         123 my $value;
1769 69 50       195 if ($self->_test( $r_STRING_LITERAL_LONG1 )) {
    50          
    100          
1770 0         0 my $string = $self->_eat( $r_STRING_LITERAL_LONG1 );
1771 0         0 $value = substr($string, 3, length($string) - 6);
1772             } elsif ($self->_test( $r_STRING_LITERAL_LONG2 )) {
1773 0         0 my $string = $self->_eat( $r_STRING_LITERAL_LONG2 );
1774 0         0 $value = substr($string, 3, length($string) - 6);
1775             } elsif ($self->_test( $r_STRING_LITERAL1 )) {
1776 1         4 my $string = $self->_eat( $r_STRING_LITERAL1 );
1777 1         4 $value = substr($string, 1, length($string) - 2);
1778             } else { # ($self->_test( $r_STRING_LITERAL2 )) {
1779 68         240 my $string = $self->_eat( $r_STRING_LITERAL2 );
1780 68         266 $value = substr($string, 1, length($string) - 2);
1781             }
1782             # $value =~ s/(${r_ECHAR})/"$1"/ge;
1783 69         282 $value =~ s/\\t/\t/g;
1784 69         142 $value =~ s/\\b/\x08/g;
1785 69         148 $value =~ s/\\n/\n/g;
1786 69         138 $value =~ s/\\r/\r/g;
1787 69         138 $value =~ s/\\"/"/g;
1788 69         130 $value =~ s/\\'/'/g;
1789 69         136 $value =~ s/\\\\/\\/g; # backslash must come last, so it doesn't accidentally create a new escape
1790 69         194 $self->_add_stack( $value );
1791             }
1792              
1793             # [67] IRIref ::= IRI_REF | PrefixedName
1794             sub _IRIref_test {
1795 76     76   128 my $self = shift;
1796 76         3205 return $self->_test(qr/<|${r_PNAME_LN}|${r_PNAME_NS}/);
1797             }
1798              
1799             sub _IRIref {
1800 235     235   353 my $self = shift;
1801 235 100       573 if ($self->_test( $r_IRI_REF )) {
1802 28         79 my $iri = $self->_eat( $r_IRI_REF );
1803 28         130 my $node = RDF::Query::Node::Resource->new( substr($iri,1,length($iri)-2), $self->__base );
1804 28         606 $self->_add_stack( $node );
1805             } else {
1806 207         704 $self->_PrefixedName;
1807             }
1808             }
1809              
1810             # [68] PrefixedName ::= PNAME_LN | PNAME_NS
1811             sub _PrefixedName {
1812 207     207   325 my $self = shift;
1813 207 50       524 if ($self->_test( $r_PNAME_LN )) {
1814 207         578 my $ln = $self->_eat( $r_PNAME_LN );
1815 207         3000 my ($ns,$local) = split(/:/, $ln);
1816 207 100       633 if ($ns eq '') {
1817 3         10 $ns = '__DEFAULT__';
1818             }
1819            
1820 207 50       713 unless (exists $self->{namespaces}{$ns}) {
1821 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Use of undefined namespace '$ns'";
1822             }
1823            
1824 207         584 my $iri = $self->{namespaces}{$ns} . $local;
1825 207         610 $self->_add_stack( RDF::Query::Node::Resource->new( $iri, $self->__base ) );
1826             } else {
1827 0         0 my $ns = $self->_eat( $r_PNAME_NS );
1828 0 0       0 if ($ns eq ':') {
1829 0         0 $ns = '__DEFAULT__';
1830             } else {
1831 0         0 chop($ns);
1832             }
1833            
1834 0 0       0 unless (exists $self->{namespaces}{$ns}) {
1835 0         0 throw RDF::Query::Error::ParseError -text => "Syntax error: Use of undefined namespace '$ns'";
1836             }
1837            
1838 0         0 my $iri = $self->{namespaces}{$ns};
1839 0         0 $self->_add_stack( RDF::Query::Node::Resource->new( $iri, $self->__base ) );
1840             }
1841             }
1842              
1843             # [69] BlankNode ::= BLANK_NODE_LABEL | ANON
1844             sub _BlankNode {
1845 2     2   5 my $self = shift;
1846 2 50       7 if ($self->_test( $r_BLANK_NODE_LABEL )) {
1847 2         8 my $label = $self->_eat( $r_BLANK_NODE_LABEL );
1848 2         15 my $id = substr($label,2);
1849 2         21 $self->_add_stack( $self->new_blank($id) );
1850             } else {
1851 0         0 $self->_eat( $r_ANON );
1852 0         0 $self->_add_stack( $self->new_blank );
1853             }
1854             }
1855              
1856             sub _NIL {
1857 0     0   0 my $self = shift;
1858 0         0 $self->_eat( $r_NIL );
1859 0         0 my $nil = RDF::Query::Node::Resource->new( $rdf->nil->uri_value );
1860 0         0 $self->_add_stack( $nil );
1861             }
1862              
1863             sub __solution_modifiers {
1864 71     71   144 my $self = shift;
1865 71         137 my $star = shift;
1866            
1867 71         186 my $vars = $self->{build}{variables};
1868 71         129 my $pattern = pop(@{ $self->{build}{triples} });
  71         238  
1869 71         627 my $proj = RDF::Query::Algebra::Project->new( $pattern, $vars );
1870 71         142 push(@{ $self->{build}{triples} }, $proj);
  71         208  
1871            
1872 71 100       267 if ($self->{build}{options}{distinct}) {
1873 10         35 delete $self->{build}{options}{distinct};
1874 10         23 my $pattern = pop(@{ $self->{build}{triples} });
  10         36  
1875 10         103 my $sort = RDF::Query::Algebra::Distinct->new( $pattern );
1876 10         21 push(@{ $self->{build}{triples} }, $sort);
  10         35  
1877             }
1878            
1879 71 100       283 if (exists $self->{build}{options}{offset}) {
1880 3         10 my $offset = delete $self->{build}{options}{offset};
1881 3         6 my $pattern = pop(@{ $self->{build}{triples} });
  3         9  
1882 3         26 my $offseted = RDF::Query::Algebra::Offset->new( $pattern, $offset );
1883 3         7 push(@{ $self->{build}{triples} }, $offseted);
  3         9  
1884             }
1885            
1886 71 100       287 if (exists $self->{build}{options}{limit}) {
1887 6         18 my $limit = delete $self->{build}{options}{limit};
1888 6         14 my $pattern = pop(@{ $self->{build}{triples} });
  6         22  
1889 6         54 my $limited = RDF::Query::Algebra::Limit->new( $pattern, $limit );
1890 6         13 push(@{ $self->{build}{triples} }, $limited);
  6         22  
1891             }
1892             }
1893              
1894             1;
1895              
1896             __END__
1897              
1898             =back
1899              
1900             =cut