File Coverage

blib/lib/RDF/Query/Algebra/Path.pm
Criterion Covered Total %
statement 79 122 64.7
branch 15 56 26.7
condition 3 4 75.0
subroutine 18 24 75.0
pod 14 14 100.0
total 129 220 58.6


line stmt bran cond sub pod time code
1             # RDF::Query::Algebra::Path
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Algebra::Path - Algebra class for path patterns
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Algebra::Path version 2.918.
11              
12             =cut
13              
14             package RDF::Query::Algebra::Path;
15              
16 36     36   144 use strict;
  36         49  
  36         858  
17 36     36   119 use warnings;
  36         43  
  36         731  
18 36     36   133 no warnings 'redefine';
  36         44  
  36         877  
19 36     36   120 use base qw(RDF::Query::Algebra);
  36         58  
  36         2122  
20              
21 36     36   154 use Set::Scalar;
  36         46  
  36         1114  
22 36     36   133 use Scalar::Util qw(blessed);
  36         55  
  36         1327  
23 36     36   126 use Carp qw(carp croak confess);
  36         57  
  36         2594  
24              
25             ######################################################################
26              
27             our ($VERSION, $debug, $lang, $languri);
28             BEGIN {
29 36     36   63 $debug = 0;
30 36         38428 $VERSION = '2.918';
31             }
32              
33             ######################################################################
34              
35             =head1 METHODS
36              
37             Beyond the methods documented below, this class inherits methods from the
38             L<RDF::Query::Algebra> class.
39              
40             =over 4
41              
42             =cut
43              
44             =item C<new ( $start, [ $op, @paths ], $end, $graph )>
45              
46             Returns a new Path structure.
47              
48             =cut
49              
50             sub new {
51 5     5 1 8 my $class = shift;
52 5         6 my $start = shift;
53 5         5 my $path = shift;
54 5         6 my $end = shift;
55 5         7 my $graph = shift;
56 5         20 return bless( [ $start, $path, $end, $graph ], $class );
57             }
58              
59             =item C<< construct_args >>
60              
61             Returns a list of arguments that, passed to this class' constructor,
62             will produce a clone of this algebra pattern.
63              
64             =cut
65              
66             sub construct_args {
67 30     30 1 27 my $self = shift;
68 30         44 return ($self->start, $self->path, $self->end, $self->graph);
69             }
70              
71             =item C<< path >>
72              
73             Returns the path description for this path expression.
74              
75             =cut
76              
77             sub path {
78 60     60 1 38 my $self = shift;
79 60         84 return $self->[1];
80             }
81              
82             =item C<< start >>
83              
84             Returns the path origin node.
85              
86             =cut
87              
88             sub start {
89 64     64 1 46 my $self = shift;
90 64         126 return $self->[0];
91             }
92              
93             =item C<< end >>
94              
95             Returns the path destination node.
96              
97             =cut
98              
99             sub end {
100 64     64 1 47 my $self = shift;
101 64         93 return $self->[2];
102             }
103              
104             =item C<< graph >>
105              
106             Returns the named graph.
107              
108             =cut
109              
110             sub graph {
111 51     51 1 48 my $self = shift;
112 51         71 return $self->[3];
113             }
114              
115             =item C<< distinguish_bnode_variables >>
116              
117             Returns a new Path object with blank nodes replaced by distinguished variables.
118              
119             =cut
120              
121             sub distinguish_bnode_variables {
122 0     0 1 0 my $self = shift;
123 0         0 my $class = ref($self);
124 0         0 my @nodes = ($self->start, $self->end);
125 0         0 foreach my $i (0 .. $#nodes) {
126 0 0       0 if ($nodes[$i]->isa('RDF::Query::Node::Blank')) {
127 0         0 $nodes[$i] = $nodes[$i]->make_distinguished_variable;
128             }
129             }
130 0         0 return $class->new( $nodes[0], $self->path, $nodes[1] );
131             }
132              
133             =item C<< bounded_length >>
134              
135             Returns true if the path is of bounded length.
136              
137             =cut
138              
139             sub bounded_length {
140 0     0 1 0 my $self = shift;
141 0         0 return $self->_bounded_length( $self->path );
142             }
143              
144             sub _bounded_length {
145 0     0   0 my $self = shift;
146 0         0 my $array = shift;
147 0 0       0 return 1 if blessed($array);
148 0         0 my ($op, @nodes) = @$array;
149 0 0       0 return 1 if ($op eq '?');
150 0 0       0 return 0 if ($op =~ /^[*+]$/);
151 0 0       0 return 1 if ($op =~ /^\d+(-\d+)?$/);
152 0 0       0 return 0 if ($op =~ /^\d+-$/);
153 0 0       0 if ($op =~ m<^[/|^]$>) {
154 0         0 my @fixed = map { $self->_bounded_length($_) } @nodes;
  0         0  
155 0         0 foreach my $f (@fixed) {
156 0 0       0 return 0 unless ($f);
157             }
158 0         0 return 1;
159             }
160             }
161              
162             =item C<< sse >>
163              
164             Returns the SSE string for this algebra expression.
165              
166             =cut
167              
168             sub sse {
169 21     21 1 23 my $self = shift;
170 21         17 my $context = shift;
171 21   100     45 my $prefix = shift || '';
172 21         23 my $indent = $context->{indent};
173 21         31 my $start = $self->start->sse( $context, $prefix );
174 21         106 my $end = $self->end->sse( $context, $prefix );
175 21         84 my $path = $self->path;
176 21         37 my $psse = $self->_expand_path( $path, 'sse' );
177 21 50       31 if ($self->graph) {
178 0         0 my $graph = $self->graph->sse( $context, $prefix );
179 0         0 return sprintf( '(path %s %s %s %s)', $start, $psse, $end, $graph );
180             } else {
181 21         150 return sprintf( '(path %s %s %s)', $start, $psse, $end );
182             }
183             }
184              
185             =item C<< as_sparql >>
186              
187             Returns the SPARQL string for this algebra expression.
188              
189             =cut
190              
191             sub as_sparql {
192 4     4 1 5 my $self = shift;
193 4         1 my $context = shift;
194 4   50     11 my $prefix = shift || '';
195 4         4 my $indent = $context->{indent};
196 4         7 my $start = $self->start->as_sparql( $context, $prefix );
197 4         23 my $end = $self->end->as_sparql( $context, $prefix );
198 4         19 my $path = $self->path;
199 4         8 my $psse = $self->_expand_path( $path, 'as_sparql' );
200 4         19 return sprintf( '%s %s %s .', $start, $psse, $end );
201             }
202              
203             sub _expand_path {
204 87     87   65 my $self = shift;
205 87         59 my $array = shift;
206 87         60 my $method = shift;
207 87 100       145 if (blessed($array)) {
208 50         115 my $string = $array->$method({}, '');
209 50 50       1644 if ($string eq '<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>') {
210 0         0 return 'a';
211             } else {
212 50         115 return $string;
213             }
214             } else {
215 37         72 my ($op, @nodes) = @$array;
216 37         40 my @nodessse = map { $self->_expand_path($_, $method) } @nodes;
  62         81  
217 37         28 my $psse;
218             # if ($op eq 'DISTINCT') {
219             # $psse = 'DISTINCT(' . join('/', @nodessse) . ')';
220             # }
221 37 100       113 if ($op eq '+') {
    100          
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
222 6 50       15 $psse = (scalar(@nodessse) == 1) ? $nodessse[0] . $op : '(' . join('/', @nodessse) . ')' . $op;
223             } elsif ($op eq '*') {
224 6 50       15 $psse = (scalar(@nodessse) == 1) ? $nodessse[0] . $op : '(' . join('/', @nodessse) . ')' . $op;
225             } elsif ($op eq '?') {
226 0 0       0 $psse = (scalar(@nodessse) == 1) ? $nodessse[0] . $op : '(' . join('/', @nodessse) . ')' . $op;
227             } elsif ($op eq '!') {
228 0 0       0 $psse = (scalar(@nodessse) == 1) ? '!' . $nodessse[0] : '!(' . join('|', @nodessse) . ')';
229             } elsif ($op eq '^') {
230 0 0       0 $psse = (scalar(@nodessse) == 1) ? $op . $nodessse[0] : '(' . join('/', map { "${op}$_" } @nodessse) . ')';
  0         0  
231             } elsif ($op eq '/') {
232 25 50       71 $psse = (scalar(@nodessse) == 1) ? $nodessse[0] : '(' . join('/', @nodessse) . ')';
233             } elsif ($op eq '|') {
234 0 0       0 $psse = (scalar(@nodessse) == 1) ? $nodessse[0] : '(' . join('|', @nodessse) . ')';
235             } elsif ($op =~ /^(\d+)$/) {
236 0         0 $psse = join('/', @nodessse) . '{' . $op . '}';
237             } elsif ($op =~ /^(\d+)-(\d+)$/) {
238 0         0 $psse = join('/', @nodessse) . "{$1,$2}";
239             } elsif ($op =~ /^(\d+)-$/) {
240 0         0 $psse = join('/', @nodessse) . "{$1,}";
241             } else {
242 0         0 confess "Serialization of unknown path type $op";
243             }
244 37         69 return $psse;
245             }
246             }
247              
248             =item C<< type >>
249              
250             Returns the type of this algebra expression.
251              
252             =cut
253              
254             sub type {
255 0     0 1 0 return 'PATH';
256             }
257              
258             =item C<< referenced_variables >>
259              
260             Returns a list of the variable names used in this algebra expression.
261              
262             =cut
263              
264             sub referenced_variables {
265 0     0 1 0 my $self = shift;
266 0         0 my @vars = grep { $_->isa('RDF::Query::Node::Variable') } ($self->start, $self->end);
  0         0  
267 0         0 return RDF::Query::_uniq(map { $_->name } @vars);
  0         0  
268             }
269              
270             =item C<< potentially_bound >>
271              
272             Returns a list of the variable names used in this algebra expression that will
273             bind values during execution.
274              
275             =cut
276              
277             sub potentially_bound {
278 4     4 1 6 my $self = shift;
279 4         10 my @vars = grep { $_->isa('RDF::Query::Node::Variable') } ($self->start, $self->end);
  8         24  
280 4         6 return RDF::Query::_uniq(map { $_->name } @vars);
  8         26  
281             }
282              
283             =item C<< definite_variables >>
284              
285             Returns a list of the variable names that will be bound after evaluating this algebra expression.
286              
287             =cut
288              
289             sub definite_variables {
290 0     0 1   my $self = shift;
291 0           return $self->referenced_variables;
292             }
293              
294             1;
295              
296             __END__
297              
298             =back
299              
300             =head1 AUTHOR
301              
302             Gregory Todd Williams <gwilliams@cpan.org>
303              
304             =cut