File Coverage

blib/lib/RDF/Query/Plan/ComputedStatement.pm
Criterion Covered Total %
statement 117 173 67.6
branch 22 50 44.0
condition 4 8 50.0
subroutine 17 22 77.2
pod 13 13 100.0
total 173 266 65.0


line stmt bran cond sub pod time code
1             # RDF::Query::Plan::ComputedStatement
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Plan::ComputedStatement - Executable query plan for computed triples.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Plan::ComputedStatement version 2.916.
11              
12             =head1 METHODS
13              
14             Beyond the methods documented below, this class inherits methods from the
15             L<RDF::Query::Plan> class.
16              
17             =over 4
18              
19             =cut
20              
21             package RDF::Query::Plan::ComputedStatement;
22              
23 35     35   221 use strict;
  35         77  
  35         988  
24 35     35   185 use warnings;
  35         77  
  35         966  
25 35     35   180 use base qw(RDF::Query::Plan);
  35         70  
  35         2509  
26              
27 35     35   208 use Log::Log4perl;
  35         72  
  35         359  
28 35     35   1887 use Scalar::Util qw(blessed);
  35         95  
  35         1938  
29 35     35   201 use Time::HiRes qw(gettimeofday tv_interval);
  35         84  
  35         363  
30              
31 35     35   4324 use RDF::Query::ExecutionContext;
  35         85  
  35         935  
32 35     35   195 use RDF::Query::VariableBindings;
  35         70  
  35         1576  
33              
34             ######################################################################
35              
36             our ($VERSION);
37             BEGIN {
38 35     35   60940 $VERSION = '2.916';
39             }
40              
41             ######################################################################
42              
43             =item C<< new ( @triple ) >>
44              
45             =cut
46              
47             sub new {
48 2     2 1 4 my $class = shift;
49 2         6 my @nodes = splice(@_, 0, 4);
50 2         4 my $quad = shift;
51 2   50     14 my $keys = shift || {};
52 2         13 my $self = $class->SUPER::new( \@nodes, $quad );
53 2         15 $self->[0]{logging_keys} = $keys;
54            
55 2         4 my %var_to_position;
56 2         5 my @methodmap = qw(subject predicate object);
57 2         3 my %counts;
58             my $dup_var;
59 2         6 foreach my $idx (0 .. 3) {
60 8         11 my $node = $nodes[ $idx ];
61 8 100 100     53 if (blessed($node) and $node->isa('RDF::Trine::Node::Variable')) {
62 4         12 my $name = $node->name;
63 4         22 $var_to_position{ $name } = $methodmap[ $idx ];
64 4         12 $counts{ $name }++;
65 4 50       15 if ($counts{ $name } >= 2) {
66 0         0 $dup_var = $name;
67             }
68             }
69             }
70 2         14 $self->[0]{referenced_variables} = [ keys %counts ];
71            
72 2         4 my @positions;
73 2 50       6 if (defined($dup_var)) {
74 0         0 foreach my $idx (0 .. 2) {
75 0         0 my $var = $nodes[ $idx ];
76 0 0 0     0 if (blessed($var) and $var->isa('RDF::Trine::Node::Variable')) {
77 0         0 my $name = $var->name;
78 0 0       0 if ($name eq $dup_var) {
79 0         0 push(@positions, $methodmap[ $idx ]);
80             }
81             }
82             }
83             }
84            
85 2         5 $self->[0]{mappings} = \%var_to_position;
86            
87 2 50       6 if (@positions) {
88 0         0 $self->[0]{dups} = \@positions;
89             }
90            
91 2         9 return $self;
92             }
93              
94             =item C<< execute ( $execution_context ) >>
95              
96             =cut
97              
98             sub execute ($) {
99 1     1 1 3 my $self = shift;
100 1         1 my $context = shift;
101 1         5 $self->[0]{delegate} = $context->delegate;
102 1 50       5 if ($self->state == $self->OPEN) {
103 0         0 throw RDF::Query::Error::ExecutionError -text => "COMPUTEDSTATEMENT plan can't be executed while already open";
104             }
105            
106 1         6 my $l = Log::Log4perl->get_logger("rdf.query.plan.computedstatement");
107 1         385 $l->trace( "executing RDF::Query::Plan::ComputedStatement" );
108            
109 1         12 $self->[0]{start_time} = [gettimeofday];
110 1         2 my @nodes = @{ $self->[1] };
  1         4  
111 1 50       5 unless ($self->[2]) {
112 1         2 pop(@nodes);
113             }
114            
115 1         5 my $bound = $context->bound;
116 1 50       23 if (%$bound) {
117 1         4 foreach my $i (0 .. $#nodes) {
118 3 100       20 next unless ($nodes[$i]->isa('RDF::Trine::Node::Variable'));
119 2 100       7 next unless (blessed($bound->{ $nodes[$i]->name }));
120 1         12 $nodes[ $i ] = $bound->{ $nodes[$i]->name };
121             }
122             }
123              
124 1         11 $l->trace( "computed statement pattern after pre-binding: " . join(' ', map { $_->as_string } @nodes));
  3         163  
125            
126 1         47 my $query = $context->query;
127 1         5 my $csg = $query->get_computed_statement_generators( $nodes[1]->uri_value );
128 1 50       4 unless (scalar(@$csg)) {
129 0         0 throw RDF::Query::Error::ExecutionError -text => "No computed statement generator found for predicate " . $nodes[1]->uri_value;
130             }
131 1         3 my $iter;
132             {
133 1         6 local($query->{model}) = $context->model;
  1         4  
134 1         6 $iter = $csg->[0]->( $query, $bound, @nodes );
135             }
136 1 50       2021 if (blessed($iter)) {
137 1         4 $self->[0]{iter} = $iter;
138 1         2 $self->[0]{bound} = $bound;
139 1         6 $self->[0]{logger} = $context->logger;
140 1         3 $self->[0]{count} = 0;
141 1         6 $self->state( $self->OPEN );
142             } else {
143 0         0 warn "no iterator in execute()";
144             }
145 1         12 $self;
146             }
147              
148             =item C<< next >>
149              
150             =cut
151              
152             sub next {
153 4     4 1 5 my $self = shift;
154 4 50       13 unless ($self->state == $self->OPEN) {
155 0         0 throw RDF::Query::Error::ExecutionError -text => "next() cannot be called on an un-open COMPUTEDSTATEMENT";
156             }
157            
158 4         14 my $l = Log::Log4perl->get_logger("rdf.query.plan.computedstatement");
159 4         75 my $iter = $self->[0]{iter};
160 4         14 LOOP: while (my $row = $iter->next) {
161 3 50       81 if ($l->is_trace) {
162 0         0 $l->trace( "- got triple from model: " . $row->as_string );
163             }
164 3 50       28 if (my $pos = $self->[0]{dups}) {
165 0         0 $l->trace( "- checking for duplicate variables in triple" );
166 0         0 my @pos = @$pos;
167 0         0 my $first_method = shift(@pos);
168 0         0 my $first = $row->$first_method();
169 0         0 foreach my $p (@pos) {
170 0 0       0 unless ($first->equal( $row->$p() )) {
171 0         0 next LOOP;
172             }
173             }
174             }
175            
176 3         7 my $binding = {};
177            
178 3         4 foreach my $key (keys %{ $self->[0]{mappings} }) {
  3         13  
179 6         24 my $method = $self->[0]{mappings}{ $key };
180 6         22 $binding->{ $key } = $row->$method();
181             }
182 3         21 my $pre_bound = $self->[0]{bound};
183 3         12 my $bindings = RDF::Query::VariableBindings->new( $binding );
184 3 50       20 if ($row->can('label')) {
185 3 50       10 if (my $o = $row->label('origin')) {
186 0         0 $bindings->label( origin => [ $o ] );
187             }
188             }
189 3         7 @{ $bindings }{ keys %$pre_bound } = values %$pre_bound;
  3         9  
190 3         6 $self->[0]{count}++;
191 3 50       18 if (my $d = $self->delegate) {
192 0         0 $d->log_result( $self, $bindings );
193             }
194 3         17 return $bindings;
195             }
196 1         16 return;
197             }
198              
199             =item C<< close >>
200              
201             =cut
202              
203             sub close {
204 1     1 1 2 my $self = shift;
205 1 50       5 unless ($self->state == $self->OPEN) {
206 0         0 throw RDF::Query::Error::ExecutionError -text => "close() cannot be called on an un-open TRIPLE";
207             }
208            
209             # my $l = Log::Log4perl->get_logger("rdf.query.plan.computedstatement");
210 1         3 my $t0 = delete $self->[0]{start_time};
211 1         3 my $count = delete $self->[0]{count};
212 1         12 delete $self->[0]{iter};
213 1         20 $self->SUPER::close();
214             }
215              
216             =item C<< nodes >>
217              
218             Returns a list of the three node objects that comprise the triple pattern this plan will return.
219              
220             =cut
221              
222             sub nodes {
223 2     2 1 5 my $self = shift;
224 2 50       6 if ($self->[2]) {
225 0         0 return @{ $self->[1] }[0..3];
  0         0  
226             } else {
227 2         7 return @{ $self->[1] }[0..2];
  2         10  
228             }
229             }
230              
231             =item C<< triple >>
232              
233             Returns a RDF::Trine::Statement object representing the triple pattern this plan will return.
234              
235             =cut
236              
237             sub triple {
238 0     0 1 0 my $self = shift;
239 0         0 my @nodes = $self->nodes;
240 0 0       0 if ($self->[2]) {
241 0         0 return RDF::Trine::Statement::Quad->new( @nodes );
242             } else {
243 0         0 return RDF::Trine::Statement->new( @nodes );
244             }
245             }
246              
247             =item C<< bf () >>
248              
249             Returns a string representing the state of the nodes of the triple (bound or free).
250              
251             =cut
252              
253             sub bf {
254 0     0 1 0 my $self = shift;
255 0         0 my $context = shift;
256 0         0 my $bf = '';
257 0         0 my $bound = $context->bound;
258 0         0 foreach my $n (@{ $self->[1] }[0..3]) {
  0         0  
259 0 0       0 if ($n->isa('RDF::Trine::Node::Variable')) {
260 0 0       0 if (my $b = $bound->{ $n->name }) {
261 0         0 $bf .= 'b';
262             } else {
263 0         0 $bf .= 'f';
264             }
265             } else {
266 0         0 $bf .= 'b';
267             }
268             }
269 0         0 return $bf;
270             }
271              
272             =item C<< distinct >>
273              
274             Returns true if the pattern is guaranteed to return distinct results.
275              
276             =cut
277              
278             sub distinct {
279 0     0 1 0 return 0;
280             }
281              
282             =item C<< ordered >>
283              
284             Returns true if the pattern is guaranteed to return ordered results.
285              
286             =cut
287              
288             sub ordered {
289 0     0 1 0 return [];
290             }
291              
292             =item C<< plan_node_name >>
293              
294             Returns the string name of this plan node, suitable for use in serialization.
295              
296             =cut
297              
298             sub plan_node_name {
299 1     1 1 4 return 'computedstatement';
300             }
301              
302             =item C<< plan_prototype >>
303              
304             Returns a list of scalar identifiers for the type of the content (children)
305             nodes of this plan node. See L<RDF::Query::Plan> for a list of the allowable
306             identifiers.
307              
308             =cut
309              
310             sub plan_prototype {
311 1     1 1 2 my $self = shift;
312 1         5 return qw(N N N N i);
313             }
314              
315             =item C<< plan_node_data >>
316              
317             Returns the data for this plan node that corresponds to the values described by
318             the signature returned by C<< plan_prototype >>.
319              
320             =cut
321              
322             sub plan_node_data {
323 2     2 1 3 my $self = shift;
324 2         11 return ($self->nodes);
325             }
326              
327             =item C<< graph ( $g ) >>
328              
329             =cut
330              
331             sub graph {
332 0     0 1   my $self = shift;
333 0           my $g = shift;
334 0           my $label = $self->graph_labels;
335 0           $g->add_node( "$self", label => "Computed Statement" . $self->graph_labels );
336 0           my @names = qw(subject predicate object graph);
337 0           foreach my $i (0 .. 3) {
338 0           my $n = $self->[ $i + 1 ];
339 0           my $rel = $names[ $i ];
340 0           my $str = $n->sse( {}, '' );
341 0           $g->add_node( "${self}$n", label => $str );
342 0           $g->add_edge( "$self" => "${self}$n", label => $names[ $i ] );
343             }
344 0           return "$self";
345             }
346              
347             1;
348              
349             __END__
350              
351             =back
352              
353             =head1 AUTHOR
354              
355             Gregory Todd Williams <gwilliams@cpan.org>
356              
357             =cut