File Coverage

blib/lib/RDF/Query/Parser/RDQL.pm
Criterion Covered Total %
statement 113 114 99.1
branch 8 12 66.6
condition n/a
subroutine 27 27 100.0
pod 2 2 100.0
total 150 155 96.7


line stmt bran cond sub pod time code
1             # RDF::Query::Parser::RDQL
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Parser::RDQL - An RDQL parser for RDF::Query
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Parser::RDQL version 2.916.
11              
12             =cut
13              
14             package RDF::Query::Parser::RDQL;
15              
16 35     35   193 use strict;
  35         79  
  35         995  
17 35     35   184 use warnings;
  35         79  
  35         1212  
18 35     35   183 no warnings 'redefine';
  35         75  
  35         1264  
19 35     35   206 use base qw(RDF::Query::Parser);
  35         73  
  35         3291  
20              
21 35     35   221 use Data::Dumper;
  35         89  
  35         1878  
22 35     35   65066 use Parse::RecDescent;
  35         1326789  
  35         318  
23 35     35   2012 use Carp qw(carp croak confess);
  35         83  
  35         2473  
24 35     35   218 use RDF::Query::Error qw(:try);
  35         79  
  35         381  
25 35     35   6040 use Scalar::Util qw(blessed);
  35         81  
  35         3783  
26              
27             ######################################################################
28              
29             our ($VERSION, $lang, $languri);
30             BEGIN {
31 35     35   101 $::RD_TRACE = undef;
32 35         85 $::RD_HINT = undef;
33 35         89 $VERSION = '2.916';
34 35         84 $lang = 'rdql';
35 35         4028 $languri = 'http://jena.hpl.hp.com/2003/07/query/RDQL';
36             }
37              
38             our($RDQL_GRAMMAR);
39             BEGIN {
40 35     35   18786 our $RDQL_GRAMMAR = <<'END';
41             query: 'SELECT' variable(s) SourceClause(?) 'WHERE' triplepattern(s) constraints(?) OptOrderBy(?) prefixes(?)
42             {
43             my $triples = RDF::Query::Algebra::GroupGraphPattern->new( @{ $item[5] } );
44             my $filter = ($item[6][0] || []);
45            
46             if (scalar(@$filter)) {
47             $triples = RDF::Query::Parser->new_filter( $filter, $triples );
48             }
49            
50             $return = {
51             method => 'SELECT',
52             variables => $item[2],
53             sources => $item[3][0],
54             triples => [ $triples ],
55             namespaces => (scalar(@{$item[8]}) ? $item[8][0] : {})
56             };
57             if (@{ $item[7] }) {
58             $return->{options}{orderby} = $item[9][0];
59             }
60             }
61             prefixes: 'USING' namespaces { $return = $item[2] }
62             OptOrderBy: 'ORDER BY' orderbyvariable(s) { $return = $item[2] }
63             orderbyvariable: variable { $return = ['ASC', $item[1]] }
64             | /ASC|DESC/i '[' variable ']' { $return = [uc($item[1]), $item[3]] }
65             SourceClause: ('SOURCE' | 'FROM') Source(s) { $return = $item[2] }
66             Source: URI { $return = [$item[1]] }
67             variable: '?' identifier { $return = RDF::Query::Parser->new_variable($item[2]) }
68             triplepattern: '(' VarUri VarUri VarUriConst ')' { $return = RDF::Query::Parser::RDQL::Triple->new(@item[2,3,4]) }
69             constraints: 'AND' Expression OptExpression(s?) {
70             if (scalar(@{ $item[3] })) {
71             my ($op, $expr) = @{ $item[3][0] };
72             $return = RDF::Query::Parser->new_function_expression( $op, $item[2], $expr );
73             } else {
74             $return = $item[2];
75             }
76             }
77             OptExpression: (',' | 'AND') Expression {
78             $return = [ 'sparql:logical-and', $item[2] ];
79             }
80             Expression: CondOrExpr {
81             $return = $item[1]
82             }
83             CondOrExpr: CondAndExpr CondOrExprOrPart(?) {
84             if (scalar(@{ $item[2] })) {
85             my ($op, $expr) = @{ $item[2][0] };
86             $return = RDF::Query::Parser->new_function_expression( $op, $item[1], $expr );
87             } else {
88             $return = $item[1];
89             }
90             }
91             CondOrExprOrPart: '||' CondAndExpr { $return = [ 'sparql:logical-or', $item[2] ] }
92             CondAndExpr: ValueLogical CondAndExprAndPart(?) {
93             if (scalar(@{ $item[2] })) {
94             $return = RDF::Query::Parser->new_function_expression( 'sparql:logical-and', $item[1], $item[2][0][1] );
95             } else {
96             $return = $item[1];
97             }
98             }
99             CondAndExprAndPart: '&&' ValueLogical { $return = [ @item[1,2] ] }
100             ValueLogical: StringEqualityExpression { $return = $item[1] }
101             StringEqualityExpression: NumericalLogical StrEqExprPart(s?) {
102             if (scalar(@{ $item[2] })) {
103             my ($op, $expr) = @{ $item[2][0] };
104             if ($op eq '~~') {
105             $return = RDF::Query::Parser->new_function_expression( 'sparql:regex', $item[1], $expr );
106             } else {
107             $return = RDF::Query::Parser->new_binary_expression( $op, $item[1], $expr );
108             }
109             } else {
110             $return = $item[1];
111             }
112             }
113             StrEqExprPart: ('==' | '!=' | '=~' | '~~') NumericalLogical { $return = [ @item[1,2] ] }
114             NumericalLogical: InclusiveOrExpression { $return = $item[1] }
115             InclusiveOrExpression: ExclusiveOrExpression InclusiveOrExprPart(s?) {
116             if (scalar(@{ $item[2] })) {
117             $return = [ $item[2][0][0], $item[1], $item[2][0][1] ];
118             } else {
119             $return = $item[1];
120             }
121             }
122             InclusiveOrExprPart: '|' ExclusiveOrExpression { $return = [ @item[1,2] ] }
123             ExclusiveOrExpression: AndExpression ExclusiveOrExprPart(s?) {
124             if (scalar(@{ $item[2] })) {
125             $return = [ $item[2][0][0], $item[1], map { $_->[1] } @{ $item[2] } ];
126             } else {
127             $return = $item[1];
128             }
129             }
130             ExclusiveOrExprPart: '^' AndExpression { $return = [ @item[1,2] ] }
131             AndExpression: ArithmeticCondition AndExprPart(s?) {
132             if (scalar(@{ $item[2] })) {
133             my ($op, $expr) = @{ $item[2][0] };
134             $return = RDF::Query::Parser->new_binary_expression( $op, $item[1], $expr );
135             } else {
136             $return = $item[1];
137             }
138             }
139             AndExprPart: '&' ArithmeticCondition { $return = [ @item[1,2] ] }
140             ArithmeticCondition: EqualityExpression { $return = $item[1]; }
141             EqualityExpression: RelationalExpression EqualityExprPart(?) {
142             if (scalar(@{ $item[2] })) {
143             my ($op, $expr) = @{ $item[2][0] };
144             $return = RDF::Query::Parser->new_binary_expression( $op, $item[1], $expr );
145             } else {
146             $return = $item[1];
147             }
148             }
149             EqualityExprPart: /(==|!=)/ RelationalExpression { $return = [ @item[1,2] ] }
150             RelationalExpression: NumericExpression RelationalExprPart(?) {
151             if (scalar(@{ $item[2] })) {
152             my ($op, $expr) = @{ $item[2][0] };
153             $return = RDF::Query::Parser->new_binary_expression( $op, $item[1], $expr );
154             } else {
155             $return = $item[1];
156             }
157             }
158             RelationalExprPart: /(<|>|<=|>=)/ NumericExpression { $return = [ @item[1,2] ] }
159             NumericExpression: MultiplicativeExpression NumericExprPart(s?) {
160             if (scalar(@{ $item[2] })) {
161             my ($op, $expr) = @{ $item[2][0] };
162             $return = RDF::Query::Parser->new_binary_expression( $op, $item[1], $expr );
163             } else {
164             $return = $item[1];
165             }
166             }
167             NumericExprPart: /([-+])/ MultiplicativeExpression { $return = [ @item[1,2] ] }
168             MultiplicativeExpression: UnaryExpression MultExprPart(s?) {
169             if (scalar(@{ $item[2] })) {
170             my ($op, $expr) = @{ $item[2][0] };
171             $return = RDF::Query::Parser->new_binary_expression( $op, $item[1], $expr );
172             } else {
173             $return = $item[1];
174             }
175             }
176             MultExprPart: /([\/*])/ UnaryExpression { $return = [ @item[1,2] ] }
177             UnaryExpression: UnaryExprNotPlusMinus { $return = $item[1] }
178             | /([-+])/ UnaryExpression { $return = [ @item[1,2] ] }
179             UnaryExprNotPlusMinus: /([~!])/ UnaryExpression { $return = [ @item[1,2] ] }
180             | PrimaryExpression { $return = $item[1] }
181             PrimaryExpression: (VarUriConst | FunctionCall) { $return = $item[1] }
182             | '(' Expression ')' {
183             $return = $item[2];
184             }
185             FunctionCall: identifier '(' ArgList ')' { $return = [ 'function', map { @{ $_ } } @item[1,3] ] }
186             ArgList: VarUriConst MoreArg(s) { $return = [ $item[1], @{ $item[2] } ] }
187            
188            
189            
190            
191             MoreArg: "," VarUriConst { $return = $item[2] }
192             Literal: (URI | CONST) { $return = $item[1] }
193             URL: qURI { $return = $item[1] }
194             VarUri: (variable | URI) { $return = $item[1] }
195             VarUriConst: (variable | CONST | URI) { $return = $item[1] }
196             namespaces: namespace morenamespace(s?) { $return = { map { %{ $_ } } ($item[1], @{ $item[2] }) } }
197             morenamespace: OptComma namespace { $return = $item[2] }
198             namespace: identifier 'FOR' qURI { $return = {@item[1,3]} }
199             OptComma: ',' | ''
200             identifier: /(([a-zA-Z0-9_.-])+)/ { $return = $1 }
201             URI: qURI { $return = RDF::Query::Parser->new_uri( $item[1] ) }
202             | QName { $return = RDF::Query::Parser::RDQL::URI->new( $item[1] ) }
203             qURI: '<' /[A-Za-z0-9_.!~*'()%;\/?:@&=+,#\$-]+/ '>' { $return = $item[2] }
204             QName: identifier ':' /([^ \t<>()]+)/ { $return = [@item[1,3]] }
205             CONST: Text { $return = RDF::Query::Parser->new_literal($item[1]) }
206             | Number { $return = RDF::Query::Parser->new_literal($item[1], undef, ($item[1] =~ /[.]/ ? 'http://www.w3.org/2001/XMLSchema#float' : 'http://www.w3.org/2001/XMLSchema#integer')) }
207             Number: /([0-9]+(\.[0-9]+)?)/ { $return = $item[1] }
208             Text: dQText | sQText | Pattern { $return = $item[1] }
209             sQText: "'" /([^']+)/ '"' { $return = $item[2] }
210             dQText: '"' /([^"]+)/ '"' { $return = $item[2] }
211             Pattern: '/' /([^\/]+(?:\\.[^\/]*)*)/ '/' { $return = $item[2] }
212             END
213             }
214              
215             ######################################################################
216              
217             =head1 METHODS
218              
219             =over 4
220              
221             =item C<new ( $query_object ) >
222              
223             Returns a new RDF::Query object.
224              
225             =cut
226              
227             { my $parser;
228             sub new {
229 18     18 1 48 my $class = shift;
230 18 100       89 unless ($parser) {
231 5         77 $parser = new Parse::RecDescent ($RDQL_GRAMMAR);
232             }
233 18         1996175 my $self = bless( {
234             parser => $parser
235             }, $class );
236 18         84 return $self;
237             } }
238              
239             =item C<parse ( $query ) >
240              
241             Parses the supplied RDQL query string, returning a parse tree.
242              
243             =cut
244              
245             sub parse {
246 18     18 1 41 my $self = shift;
247 18         46 my $query = shift;
248 18         258 my $parser = $self->parser;
249 18         227 my $parsed = $parser->query( $query );
250            
251 18 100       3528 if ($parsed) {
252 17         56 my $pattern = $parsed->{triples}[0];
253 17 50       90 if (blessed($pattern)) {
254 17         55 my $ns = $parsed->{namespaces};
255 17         91 $pattern = $self->_fixup_pattern( $pattern, $ns );
256 17         113 my $fixed = $pattern->qualify_uris( $ns );
257 17         53 $parsed->{triples}[0] = $fixed;
258             }
259 17         175 $pattern = RDF::Query::Algebra::Project->new( $parsed->{triples}[0], $parsed->{variables} );
260 17         117 $parsed->{triples}[0] = $pattern;
261            
262            
263 17         88 return $parsed;
264             } else {
265 1         14 return $self->fail( "Failed to parse: '$query'" );
266             }
267             }
268              
269             sub _fixup_pattern {
270 17     17   40 my $self = shift;
271 17         41 my $pattern = shift;
272 17         34 my $ns = shift;
273            
274 17         172 my @uris = $pattern->subpatterns_of_type('RDF::Query::Parser::RDQL::URI');
275 17         50 foreach my $u (@uris) {
276 27         75 my $ns = $ns->{ $u->[0] };
277 27         94 my $uri = join('', $ns, $u->[1]);
278 27         45 @{ $u } = ( 'URI', $uri );
  27         82  
279 27         96 bless($u, 'RDF::Query::Node::Resource'); # evil
280             }
281            
282 17         72 my @triples = $pattern->subpatterns_of_type('RDF::Query::Parser::RDQL::Triple');
283 17         50 foreach my $t (@triples) {
284 25         93 bless($t, 'RDF::Query::Algebra::Triple'); # evil
285             }
286 17         48 return $pattern;
287             }
288              
289             sub AUTOLOAD {
290 5     5   15 my $self = $_[0];
291 5 50       56 throw RDF::Query::Error::MethodInvocationError unless (blessed($self));
292            
293 5         16 my $class = ref($_[0]);
294 5         13 our $AUTOLOAD;
295 5 50       35 return if ($AUTOLOAD =~ /DESTROY$/);
296 5         15 my $method = $AUTOLOAD;
297 5         54 $method =~ s/^.*://;
298            
299 5 50       69 if (exists($self->{ $method })) {
300 35     35   229 no strict 'refs';
  35         141  
  35         4952  
301             *$AUTOLOAD = sub {
302 18     18   49 my $self = shift;
303 18         44 my $class = ref($self);
304 18         89 return $self->{ $method };
305 5         50 };
306 5         37 goto &$method;
307             } else {
308 0         0 throw RDF::Query::Error::MethodError ( -text => qq[Can't locate object method "$method" via package $class] );
309             }
310             }
311              
312              
313             package RDF::Query::Parser::RDQL::URI;
314              
315 35     35   215 use strict;
  35         77  
  35         848  
316 35     35   200 use warnings;
  35         74  
  35         1367  
317 35     35   199 use base qw(RDF::Query::Algebra);
  35         90  
  35         6649  
318              
319             sub new {
320 27     27   39746 my $class = shift;
321 27         66 my $data = shift;
322 27         51 my ($ns, $local) = @{ $data };
  27         77  
323 27         680 return bless([$ns, $local], $class);
324             }
325              
326             sub construct_args {
327 27     27   53 my $self = shift;
328 27         120 return [ @$self ];
329             }
330              
331             package RDF::Query::Parser::RDQL::Triple;
332              
333 35     35   210 use strict;
  35         86  
  35         1326  
334 35     35   196 use warnings;
  35         81  
  35         1084  
335 35     35   196 use base qw(RDF::Query::Algebra);
  35         87  
  35         4901  
336              
337             sub new {
338 25     25   4352 my $class = shift;
339 25         94 my @nodes = @_;
340 25         605 return bless([@nodes], $class);
341             }
342              
343             sub construct_args {
344 50     50   86 my $self = shift;
345 50         162 return @$self;
346             }
347              
348             1;
349              
350             __END__
351              
352             =back
353              
354             =head1 REVISION HISTORY
355              
356             $Log$
357             Revision 1.5 2006/01/11 06:03:45 greg
358             - Removed use of Data::Dumper::Simple.
359              
360             Revision 1.4 2005/05/08 08:26:09 greg
361             - Added initial support for SPARQL ASK, DESCRIBE and CONSTRUCT queries.
362             - Added new test files for new query types.
363             - Added methods to bridge classes for creating statements and blank nodes.
364             - Added as_string method to bridge classes for getting string versions of nodes.
365             - Broke out triple fixup code into fixup_triple_bridge_variables().
366             - Updated FILTER test to use new Geo::Distance API.
367              
368             Revision 1.3 2005/04/26 02:54:40 greg
369             - added core support for custom function constraints support
370             - added initial SPARQL support for custom function constraints
371             - SPARQL variables may now begin with the '$' sigil
372             - broke out URL fixups into its own method
373             - added direction support for ORDER BY (ascending/descending)
374             - added 'next', 'current', and 'end' to Stream API
375              
376             Revision 1.2 2005/04/25 00:59:29 greg
377             - streams are now objects usinig the Redland QueryResult API
378             - RDF namespace is now always available in queries
379             - row() now uses a stream when calling execute()
380             - check_constraints() now copies args for recursive calls (instead of pass-by-ref)
381             - added ORDER BY support to RDQL parser
382             - SPARQL constraints now properly use the 'FILTER' keyword
383             - SPARQL constraints can now use '&&' as an operator
384             - SPARQL namespace declaration is now optional
385              
386             Revision 1.1 2005/04/21 02:21:44 greg
387             - major changes (resurecting the project)
388             - broke out the query parser into it's own RDQL class
389             - added initial support for a SPARQL parser
390             - added support for blank nodes
391             - added lots of syntactic sugar (with blank nodes, multiple predicates and objects)
392             - moved model-specific code into RDF::Query::Model::*
393             - cleaned up the model-bridge code
394             - moving over to redland's query API (pass in the model when query is executed)
395              
396              
397             =head1 AUTHOR
398              
399             Gregory Williams <gwilliams@cpan.org>
400              
401             =cut