File Coverage

blib/lib/RDF/Query/Algebra/BasicGraphPattern.pm
Criterion Covered Total %
statement 140 192 72.9
branch 25 34 73.5
condition 5 9 55.5
subroutine 24 31 77.4
pod 18 18 100.0
total 212 284 74.6


line stmt bran cond sub pod time code
1             # RDF::Query::Algebra::BasicGraphPattern
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Algebra::BasicGraphPattern - Algebra class for BasicGraphPattern patterns
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Algebra::BasicGraphPattern version 2.916.
11              
12             =cut
13              
14             package RDF::Query::Algebra::BasicGraphPattern;
15              
16 36     36   186 use strict;
  36         79  
  36         945  
17 36     36   183 use warnings;
  36         70  
  36         1014  
18 36     36   173 no warnings 'redefine';
  36         63  
  36         1246  
19 36     36   173 use base qw(RDF::Query::Algebra);
  36         62  
  36         2824  
20              
21 36     36   198 use Data::Dumper;
  36         66  
  36         1676  
22 36     36   186 use Log::Log4perl;
  36         79  
  36         319  
23 36     36   1697 use Scalar::Util qw(blessed refaddr reftype);
  36         68  
  36         2377  
24 36     36   180 use Carp qw(carp croak confess);
  36         77  
  36         2249  
25 36     36   188 use Time::HiRes qw(gettimeofday tv_interval);
  36         78  
  36         395  
26 36     36   6348 use RDF::Trine::Iterator qw(smap swatch);
  36         2081451  
  36         2946  
27              
28             ######################################################################
29              
30             our ($VERSION);
31             my %AS_SPARQL;
32             BEGIN {
33 36     36   72347 $VERSION = '2.916';
34             }
35              
36             ######################################################################
37              
38             =head1 METHODS
39              
40             Beyond the methods documented below, this class inherits methods from the
41             L<RDF::Query::Algebra> class.
42              
43             =over 4
44              
45             =cut
46              
47             =item C<new ( @triples )>
48              
49             Returns a new BasicGraphPattern structure.
50              
51             =cut
52              
53             sub new {
54 231     231 1 554 my $class = shift;
55 231         515 my @triples = @_;
56 231         599 foreach my $t (@triples) {
57 417 50       2000 unless ($t->isa('RDF::Trine::Statement')) {
58 0         0 throw RDF::Query::Error::QueryPatternError -text => "Patterns belonging to a BGP must be graph statements";
59             }
60             }
61 231         1006 return bless( [ @triples ] );
62             }
63              
64             =item C<< construct_args >>
65              
66             Returns a list of arguments that, passed to this class' constructor,
67             will produce a clone of this algebra pattern.
68              
69             =cut
70              
71             sub construct_args {
72 542     542 1 815 my $self = shift;
73 542         1119 return ($self->triples);
74             }
75              
76             =item C<< triples >>
77              
78             Returns a list of triples belonging to this BGP.
79              
80             =cut
81              
82             sub triples {
83 1683     1683 1 2219 my $self = shift;
84 1683         4147 return @$self;
85             }
86              
87             =item C<< quads >>
88              
89             Returns a list of the (implicit) quads belonging to this BGP.
90              
91             =cut
92              
93             sub quads {
94 14     14 1 42 my $self = shift;
95 14         37 my @triples = $self->triples;
96 14         24 my @quads;
97 14         31 foreach my $t (@triples) {
98 35         101 my @nodes = $t->nodes;
99 35         178 foreach my $i (0 .. 3) {
100 140         244 my $n = $nodes[ $i ];
101 140 100       477 if (not blessed($n)) {
102 21 50       41 if ($i == 3) {
103 21         66 $nodes[ $i ] = RDF::Trine::Node::Nil->new();
104             } else {
105 0         0 $nodes[ $i ] = RDF::Query::Node::Variable->new();
106             }
107             }
108             }
109 35         242 my $st = RDF::Trine::Statement::Quad->new( @nodes );
110 35         700 push(@quads, $st);
111             }
112 14         52 return @quads;
113             }
114              
115             =item C<< sse >>
116              
117             Returns the SSE string for this algebra expression.
118              
119             =cut
120              
121             sub sse {
122 634     634 1 1429 my $self = shift;
123 634         838 my $context = shift;
124 634   100     2000 my $prefix = shift || '';
125 634   100     1650 my $indent = $context->{indent} || ' ';
126            
127 634         1513 my @triples = sort map { $_->sse( $context ) } $self->triples;
  1189         79443  
128 634         66391 return sprintf(
129             "(BGP\n${prefix}${indent}%s\n${prefix})",
130             join("\n${prefix}${indent}", @triples)
131             );
132             }
133              
134             =item C<< explain >>
135              
136             Returns a string serialization of the algebra appropriate for display on the
137             command line.
138              
139             =cut
140              
141             sub explain {
142 0     0 1 0 my $self = shift;
143 0         0 my $s = shift;
144 0         0 my $count = shift;
145 0         0 my $indent = $s x $count;
146 0         0 my $string = "${indent}basic graph pattern\n";
147            
148 0         0 foreach my $t ($self->triples) {
149 0         0 $string .= "${indent}${s}" . $t->as_sparql . "\n";
150             }
151 0         0 return $string;
152             }
153              
154              
155             =item C<< as_sparql >>
156              
157             Returns the SPARQL string for this algebra expression.
158              
159             =cut
160              
161             sub as_sparql {
162 53     53 1 93 my $self = shift;
163 53 100       199 if (exists $AS_SPARQL{ refaddr( $self ) }) {
164 11         58 return $AS_SPARQL{ refaddr( $self ) };
165             } else {
166 42         65 my $context = shift;
167             # if (ref($context)) {
168             # $context = { %$context };
169             # }
170 42   50     112 my $indent = shift || '';
171 42         53 my @triples;
172 42         102 foreach my $t ($self->triples) {
173 49         181 push(@triples, $t->as_sparql( $context, $indent ));
174             }
175 42         116 my $string = join("\n${indent}", @triples);
176 42         167 $AS_SPARQL{ refaddr( $self ) } = $string;
177 42         177 return $string;
178             }
179             }
180              
181             =item C<< as_hash >>
182              
183             Returns the query as a nested set of plain data structures (no objects).
184              
185             =cut
186              
187             sub as_hash {
188 0     0 1 0 my $self = shift;
189 0         0 my $context = shift;
190             return {
191             type => lc($self->type),
192 0         0 patterns => [ map { $_->as_hash } $self->triples ],
  0         0  
193             };
194             }
195              
196             =item C<< as_spin ( $model ) >>
197              
198             Adds statements to the given model to represent this algebra object in the
199             SPARQL Inferencing Notation (L<http://www.spinrdf.org/>).
200              
201             =cut
202              
203             sub as_spin {
204 0     0 1 0 my $self = shift;
205 0         0 my $model = shift;
206 0         0 my @t = $self->triples;
207 0         0 my @nodes = map { $_->as_spin( $model ) } @t;
  0         0  
208 0         0 return @nodes;
209             }
210              
211             =item C<< type >>
212              
213             Returns the type of this algebra expression.
214              
215             =cut
216              
217             sub type {
218 0     0 1 0 return 'BGP';
219             }
220              
221             =item C<< referenced_variables >>
222              
223             Returns a list of the variable names used in this algebra expression.
224              
225             =cut
226              
227             sub referenced_variables {
228 63     63 1 101 my $self = shift;
229 63         132 return RDF::Query::_uniq(map { $_->referenced_variables } $self->triples);
  83         820  
230             }
231              
232             =item C<< potentially_bound >>
233              
234             Returns a list of the variable names used in this algebra expression that will
235             bind values during execution.
236              
237             =cut
238              
239             sub potentially_bound {
240 31     31 1 60 my $self = shift;
241 31         85 return RDF::Query::_uniq(map { $_->potentially_bound } $self->triples);
  50         898  
242             }
243              
244             =item C<< definite_variables >>
245              
246             Returns a list of the variable names that will be bound after evaluating this algebra expression.
247              
248             =cut
249              
250             sub definite_variables {
251 4     4 1 6 my $self = shift;
252 4         10 return RDF::Query::_uniq(map { $_->definite_variables } $self->triples);
  10         176  
253             }
254              
255             sub _referenced_blanks {
256 191     191   318 my $self = shift;
257 191         301 my %seen;
258 191         617 foreach my $t ($self->triples) {
259 334         1242 my @blanks = $t->referenced_blanks;
260 334         1665 foreach my $b (@blanks) {
261 61         226 $seen{ $b }++;
262             }
263             }
264 191         1036 return [keys %seen];
265             }
266              
267             =item C<< connected >>
268              
269             Returns true if the pattern is connected through shared variables, false otherwise.
270              
271             =cut
272              
273             sub connected {
274 7     7 1 43 my $self = shift;
275 7         21 my @triples = $self->triples;
276 7 100       28 return 1 unless (scalar(@triples) > 1);
277            
278 6         9 my %index;
279             my %variables;
280 6         19 foreach my $i (0 .. $#triples) {
281 22         78 my $t = $triples[ $i ];
282 22         74 $index{ $t->as_string } = $i;
283 22         12720 foreach my $n ($t->nodes) {
284 66 100       455 next unless ($n->isa('RDF::Trine::Node::Variable'));
285 45         55 push( @{ $variables{ $n->name } }, $t );
  45         109  
286             }
287             }
288            
289 6         35 my @connected;
290 6         16 foreach my $i (0 .. $#triples) {
291 22         37 foreach my $j (0 .. $#triples) {
292 90 100       200 $connected[ $i ][ $j ] = ($i == $j) ? 1 : 0;
293             }
294             }
295            
296 6         12 my %seen;
297 6         12 my @queue = $triples[0];
298 6         18 while (my $t = shift(@queue)) {
299 77         176 my $string = $t->as_string;
300 77 100       2715 next if ($seen{ $string }++);
301 18         51 my @vars = map { $_->name } grep { $_->isa('RDF::Trine::Node::Variable') } $t->nodes;
  39         146  
  54         196  
302 18         96 my @connected_to = map { @{ $variables{ $_ } } } @vars;
  39         44  
  39         106  
303 18         38 foreach my $c (@connected_to) {
304 71         174 my $cstring = $c->as_string;
305 71         2311 my $i = $index{$string};
306            
307 71         113 my $k = $index{ $cstring };
308 71         79 my @conn = @{ $connected[$i] };
  71         180  
309 71         90 $conn[ $k ] = 1;
310 71         140 foreach my $j (0 .. $#triples) {
311 299 100       623 if ($conn[ $j ] == 1) {
312 225         274 $connected[ $k ][ $j ] = 1;
313 225         355 $connected[ $j ][ $k ] = 1;
314             }
315             }
316 71         205 push(@queue, $c);
317             }
318             }
319            
320 6         16 foreach my $i (0 .. $#triples) {
321 20 100       63 return 0 unless ($connected[0][$i] == 1);
322             }
323 4         47 return 1;
324             }
325              
326             =item C<< subsumes ( $pattern ) >>
327              
328             Returns true if the bgp subsumes the pattern, false otherwise.
329              
330             =cut
331              
332             sub subsumes {
333 5     5 1 35 my $self = shift;
334 5         6 my $pattern = shift;
335 5 100       38 if ($pattern->isa('RDF::Trine::Statement')) {
    50          
336 3         11 foreach my $t ($self->triples) {
337 5 100       16 return 1 if ($t->subsumes($pattern));
338             }
339 1         6 return 0;
340             } elsif ($pattern->isa('RDF::Query::Algebra::BasicGraphPattern')) {
341 2         7 OUTER: foreach my $p ($pattern->triples) {
342 4         11 foreach my $t ($self->triples) {
343 6 100       18 next OUTER if ($t->subsumes($p));
344             }
345 0         0 return 0;
346             }
347 2         13 return 1;
348             } else {
349 0         0 return 0;
350             }
351             }
352              
353             =item C<< bf () >>
354              
355             Returns a string representing the state of the nodes of the triple (bound or free).
356              
357             =cut
358              
359             sub bf {
360 0     0 1 0 my $self = shift;
361 0         0 my @bf;
362             my %var_to_num;
363 0         0 my %use_count;
364 0         0 my $counter = 1;
365 0         0 foreach my $t ($self->triples) {
366 0         0 my $bf = $t->bf;
367 0 0       0 if ($bf =~ /f/) {
368 0         0 $bf = '';
369 0         0 foreach my $n ($t->nodes) {
370 0 0       0 if ($n->isa('RDF::Query::Node::Variable')) {
371 0         0 my $name = $n->name;
372 0   0     0 my $num = ($var_to_num{ $name } ||= $counter++);
373 0         0 $use_count{ $name }++;
374 0         0 $bf .= "{${num}}";
375             } else {
376 0         0 $bf .= 'b';
377             }
378             }
379             }
380 0         0 push(@bf, $bf);
381             }
382 0         0 my $bf = join(',',@bf);
383 0 0       0 if ($counter <= 10) {
384 0         0 $bf =~ s/[{}]//g;
385             }
386 0         0 return $bf;
387             }
388              
389             =item C<< clone >>
390              
391             =cut
392              
393             sub clone {
394 0     0 1 0 my $self = shift;
395 0         0 my $class = ref($self);
396 0         0 return $class->new( map { $_->clone } $self->triples );
  0         0  
397             }
398              
399             =item C<< bind_variables ( \%bound ) >>
400              
401             Returns a new algebra pattern with variables named in %bound replaced by their corresponding bound values.
402              
403             =cut
404              
405             sub bind_variables {
406 0     0 1 0 my $self = shift;
407 0         0 my $class = ref($self);
408 0         0 my $bound = shift;
409 0         0 return $class->new( map { $_->bind_variables( $bound ) } $self->triples );
  0         0  
410             }
411              
412             sub DESTROY {
413 232     232   61321 my $self = shift;
414 232         1633 delete $AS_SPARQL{ refaddr( $self ) };
415             }
416              
417             1;
418              
419             __END__
420              
421             =back
422              
423             =head1 AUTHOR
424              
425             Gregory Todd Williams <gwilliams@cpan.org>
426              
427             =cut