File Coverage

blib/lib/RDF/Query/Parser.pm
Criterion Covered Total %
statement 95 109 87.1
branch 8 12 66.6
condition n/a
subroutine 25 28 89.2
pod 14 14 100.0
total 142 163 87.1


line stmt bran cond sub pod time code
1             # RDF::Query::Parser
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Parser - Parser base class
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Parser version 2.916.
11              
12             =cut
13              
14             package RDF::Query::Parser;
15              
16 36     36   210 use strict;
  36         78  
  36         893  
17 36     36   176 use warnings;
  36         70  
  36         986  
18 36     36   187 no warnings 'redefine';
  36         68  
  36         1086  
19              
20 36     36   201 use RDF::Query::Node::Resource;
  36         69  
  36         1868  
21 36     36   198 use RDF::Query::Node::Literal;
  36         81  
  36         1446  
22 36     36   189 use RDF::Query::Node::Blank;
  36         79  
  36         1411  
23 36     36   20503 use RDF::Query::Node::Variable;
  36         99  
  36         1633  
24 36     36   1454 use RDF::Query::Algebra;
  36         77  
  36         1490  
25 36     36   188 use RDF::Query::Error qw(:try);
  36         81  
  36         255  
26              
27 36     36   5398 use Data::Dumper;
  36         74  
  36         1569  
28 36     36   262 use Scalar::Util qw(blessed);
  36         79  
  36         1496  
29 36     36   191 use Carp qw(carp croak confess);
  36         82  
  36         2405  
30              
31             ######################################################################
32              
33             our ($VERSION);
34             BEGIN {
35 36     36   23433 $VERSION = '2.916';
36             }
37              
38             ######################################################################
39              
40             =head1 METHODS
41              
42             =over 4
43              
44             =cut
45              
46             =item C<new_literal ( $literal, $language, $datatype )>
47              
48             Returns a new literal structure.
49              
50             =cut
51              
52             sub new_literal {
53 10     10 1 11945 my $self = shift;
54 10         20 my $literal = shift;
55 10         25 my $lang = shift;
56 10         26 my $dt = shift;
57 10         145 return RDF::Query::Node::Literal->new( $literal, $lang, $dt );
58             }
59              
60             =item C<new_variable ( $name )>
61              
62             Returns a new variable structure.
63              
64             =cut
65              
66             sub new_variable {
67 97     97 1 54155 my $self = shift;
68 97         155 my $name;
69 97 50       263 if (@_) {
70 97         205 $name = shift;
71             } else {
72 0         0 my $count = $self->{__PRIVATE_VARIABLE_COUNT}++;
73 0         0 $name = '_____rdfquery_private_' . $count;
74             }
75 97         405 return RDF::Query::Node::Variable->new( $name );
76             }
77              
78             =item C<new_blank ( $name )>
79              
80             Returns a new blank node structure.
81              
82             =cut
83              
84             sub new_blank {
85 36     36 1 72 my $self = shift;
86 36         56 my $id;
87 36 100       120 if (@_) {
88 7         17 $id = shift;
89             } else {
90 29 50       97 if (not defined($self->{blank_ids})) {
91 0         0 $self->{blank_ids} = 1;
92             }
93 29         79 $id = 'a' . $self->{blank_ids}++;
94             }
95 36         225 return RDF::Query::Node::Blank->new( $id );
96             }
97              
98             =item C<new_uri ( $uri )>
99              
100             Returns a new variable structure.
101              
102             =cut
103              
104             sub new_uri {
105 8     8 1 16239 my $self = shift;
106 8         19 my $uri = shift;
107 8         86 return RDF::Query::Node::Resource->new( $uri );
108             }
109              
110             # =item C<new_qname ( $prefix, $localPart )>
111             #
112             # Returns a new QName URI structure.
113             #
114             # =cut
115             #
116             # sub new_qname {
117             # my $self = shift;
118             # my $prefix = shift;
119             # my $name = shift;
120             # return [ 'URI', [ $prefix, $name ] ];
121             # }
122             #
123             # =item C<new_union ( @patterns )>
124             #
125             # Returns a new UNION structure.
126             #
127             # =cut
128             #
129             # sub new_union {
130             # my $self = shift;
131             # my @patterns = @_;
132             # return RDF::Query::Algebra::Union->new( @patterns );
133             # }
134             #
135             # =item C<new_optional ( $patterns )>
136             #
137             # Returns a new OPTIONAL structure.
138             #
139             # =cut
140             #
141             # sub new_optional {
142             # my $self = shift;
143             # my $ggp = shift;
144             # my $opt = shift;
145             # return RDF::Query::Algebra::Optional->new( $ggp, $opt );
146             # }
147             #
148             # =item C<new_named_graph ( $graph, $triples )>
149             #
150             # Returns a new NAMED GRAPH structure.
151             #
152             # =cut
153             #
154             # sub new_named_graph {
155             # my $self = shift;
156             # my $graph = shift;
157             # my $triples = shift;
158             # return RDF::Query::Algebra::NamedGraph->new( $graph, $triples );
159             # }
160              
161             =item C<new_triple ( $s, $p, $o )>
162              
163             Returns a new triple structure.
164              
165             =cut
166              
167             sub new_triple {
168 0     0 1 0 my $self = shift;
169 0         0 my ($s,$p,$o) = @_;
170 0         0 return RDF::Query::Algebra::Triple->new( $s, $p, $o );
171             }
172              
173             =item C<new_unary_expression ( $operator, $operand )>
174              
175             Returns a new unary expression structure.
176              
177             =cut
178              
179             sub new_unary_expression {
180 4     4 1 9 my $self = shift;
181 4         8 my $op = shift;
182 4         7 my $operand = shift;
183 4         51 return RDF::Query::Expression::Unary->new( $op, $operand );
184             }
185              
186             =item C<new_binary_expression ( $operator, @operands )>
187              
188             Returns a new binary expression structure.
189              
190             =cut
191              
192             sub new_binary_expression {
193 30     30 1 57 my $self = shift;
194 30         62 my $op = shift;
195 30         97 my @operands = @_[0,1];
196 30         251 return RDF::Query::Expression::Binary->new( $op, @operands );
197             }
198              
199             # =item C<new_nary_expression ( $operator, @operands )>
200             #
201             # Returns a new n-ary expression structure.
202             #
203             # =cut
204             #
205             # sub new_nary_expression {
206             # my $self = shift;
207             # my $op = shift;
208             # my @operands = @_;
209             # return RDF::Query::Expression::Binary->new( $op, @operands );
210             # }
211             #
212             # =item C<new_logical_expression ( $operator, @operands )>
213             #
214             # Returns a new logical expression structure.
215             #
216             # =cut
217             #
218             # sub new_logical_expression {
219             # my $self = shift;
220             # my $op = shift;
221             # my @operands = @_;
222             # die $op;
223             # return RDF::Query::Expression->new( $op, @operands );
224             # }
225              
226             =item C<new_function_expression ( $function, @operands )>
227              
228             Returns a new function expression structure.
229              
230             =cut
231              
232             sub new_function_expression {
233 64     64 1 128 my $self = shift;
234 64         110 my $function = shift;
235 64         162 my @operands = @_;
236 64 100       316 unless (blessed($function)) {
237 7         29 $function = RDF::Query::Node::Resource->new( $function );
238             }
239 64         545 return RDF::Query::Expression::Function->new( $function, @operands );
240             }
241              
242             =item C<new_alias_expression ( $alias, $expression )>
243              
244             Returns a new alias expression structure.
245              
246             =cut
247              
248             sub new_alias_expression {
249 29     29 1 86 my $self = shift;
250 29         60 my $var = shift;
251 29         52 my $expr = shift;
252 29         193 return RDF::Query::Expression::Alias->new( 'alias', $var, $expr );
253             }
254              
255             =item C<new_filter ( $filter_expr, $pattern )>
256              
257             Returns a new filter structure.
258              
259             =cut
260              
261             sub new_filter {
262 0     0 1 0 my $self = shift;
263 0         0 my $expr = shift;
264 0         0 my $pattern = shift;
265 0         0 return RDF::Query::Algebra::Filter->new( $expr, $pattern );
266             }
267              
268              
269             ######################################################################
270              
271             =item C<fail ( $error )>
272              
273             Sets the current error to C<$error>.
274              
275             If the parser is in commit mode (by calling C<set_commit>), throws a
276             RDF::Query::Error::ParseError object. Otherwise returns C<undef>.
277              
278             =cut
279              
280             sub fail {
281 1     1 1 3 my $self = shift;
282 1         3 my $error = shift;
283 1         6 my $l = Log::Log4perl->get_logger("rdf.query.parser");
284            
285 36     36   250 no warnings 'uninitialized';
  36         77  
  36         12250  
286 1         408 my $parsed = substr($self->{input}, 0, $self->{position});
287 1         3 my $line = ($parsed =~ tr/\n//) + 1;
288 1         6 my ($lline) = $parsed =~ m/^(.*)\Z/mx;
289 1         3 my $col = length($lline);
290 1         3 my $rest = substr($self->{remaining}, 0, 10);
291            
292 1         12 $self->set_error( "Syntax error; $error at $line:$col (near '$rest')" );
293 1 50       7 if ($self->{commit}) {
294 0         0 throw RDF::Query::Error::ParseError( -text => "$error at $line:$col (near '$rest')" );
295             } else {
296 1         6 return undef;
297             }
298             }
299              
300             ######################################################################
301              
302             =item C<error ()>
303              
304             Returns the last error the parser experienced.
305              
306             =cut
307              
308             sub error {
309 2     2 1 4 my $self = shift;
310 2 50       6 if (defined $self->{error}) {
311 2         12 return $self->{error};
312             } else {
313 0         0 return '';
314             }
315             }
316              
317             =begin private
318              
319             =item C<set_error ( $error )>
320              
321             Sets the object's error variable.
322              
323             =end private
324              
325             =cut
326              
327             sub set_error {
328 1     1 1 3 my $self = shift;
329 1         3 my $error = shift;
330 1         30 $self->{error} = $error;
331             }
332              
333             =begin private
334              
335             =item C<clear_error ()>
336              
337             Clears the object's error variable.
338              
339             =end private
340              
341             =cut
342              
343             sub clear_error {
344 0     0 1   my $self = shift;
345 0           $self->{error} = undef;
346             }
347              
348             # =begin private
349             #
350             # =item C<set_commit ( [ $value ] )>
351             #
352             # Sets the object's commit state.
353             #
354             # =end private
355             #
356             # =cut
357             #
358             # sub set_commit {
359             # my $self = shift;
360             # if (@_) {
361             # $self->{commit} = shift;
362             # } else {
363             # $self->{commit} = 1;
364             # }
365             # }
366             #
367             # =begin private
368             #
369             # =item C<unset_commit ()>
370             #
371             # Clears the object's commit state.
372             #
373             # =end private
374             #
375             # =cut
376             #
377             # sub unset_commit {
378             # my $self = shift;
379             # $self->{commit} = 0;
380             # }
381             #
382             # =begin private
383             #
384             # =item C<get_commit ()>
385             #
386             # Returns the object's commit state.
387             #
388             # =end private
389             #
390             # =cut
391             #
392             # sub get_commit {
393             # my $self = shift;
394             # return $self->{commit};
395             # }
396              
397             1;
398              
399             __END__
400              
401             =back
402              
403             =head1 AUTHOR
404              
405             Gregory Williams <gwilliams@cpan.org>
406              
407             =cut