File Coverage

blib/lib/RDF/Query/Plan/Construct.pm
Criterion Covered Total %
statement 88 125 70.4
branch 22 34 64.7
condition 1 3 33.3
subroutine 14 21 66.6
pod 14 14 100.0
total 139 197 70.5


line stmt bran cond sub pod time code
1             # RDF::Query::Plan::Construct
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Plan::Construct - Executable query plan for constructing a graph from a set of variable bindings.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Plan::Construct version 2.918.
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::Construct;
22              
23 35     35   132 use strict;
  35         57  
  35         826  
24 35     35   124 use warnings;
  35         48  
  35         761  
25 35     35   118 use base qw(RDF::Query::Plan);
  35         50  
  35         1955  
26              
27 35     35   150 use Log::Log4perl;
  35         55  
  35         261  
28 35     35   1497 use Scalar::Util qw(blessed refaddr);
  35         54  
  35         2024  
29              
30             ######################################################################
31              
32             our ($VERSION);
33             BEGIN {
34 35     35   31375 $VERSION = '2.918';
35             }
36              
37             ######################################################################
38              
39             =item C<< new ( $plan, \@triples ) >>
40              
41             =cut
42              
43             sub new {
44 4     4 1 6 my $class = shift;
45 4         5 my $plan = shift;
46 4         6 my $triples = shift;
47            
48 4 50       10 unless (@$triples) {
49 0         0 throw RDF::Query::Error::MethodInvocationError -text => "No triples passed to ::Plan::Construct constructor";
50             }
51            
52 4         21 my $self = $class->SUPER::new( $plan, $triples );
53 4         23 $self->[0]{referenced_variables} = [ $plan->referenced_variables ];
54 4         13 return $self;
55             }
56              
57             =item C<< execute ( $execution_context ) >>
58              
59             =cut
60              
61             sub execute ($) {
62 4     4 1 5 my $self = shift;
63 4         5 my $context = shift;
64 4         13 $self->[0]{delegate} = $context->delegate;
65 4 50       22 if ($self->state == $self->OPEN) {
66 0         0 throw RDF::Query::Error::ExecutionError -text => "CONSTRUCT plan can't be executed while already open";
67             }
68            
69 4         15 my $l = Log::Log4perl->get_logger("rdf.query.plan.construct");
70 4         605 $l->trace( "executing RDF::Query::Plan::Construct" );
71            
72 4         28 my $plan = $self->pattern;
73 4         17 $plan->execute( $context );
74              
75 4 50       9 if ($plan->state == $self->OPEN) {
76 4         12 $self->[0]{triples} = [];
77 4         8 $self->[0]{blank_map} = {};
78 4         15 $self->state( $self->OPEN );
79             } else {
80 0         0 warn "could not execute plan in construct";
81             }
82 4         12 $self;
83             }
84              
85             =item C<< next >>
86              
87             =cut
88              
89             sub next {
90 29     29 1 28 my $self = shift;
91 29 50       65 unless ($self->state == $self->OPEN) {
92 0         0 throw RDF::Query::Error::ExecutionError -text => "next() cannot be called on an un-open CONSTRUCT";
93             }
94            
95 29         92 my $l = Log::Log4perl->get_logger("rdf.query.plan.triple");
96 29         867 my $plan = $self->[1];
97 29         29 while (1) {
98 45         86 while (scalar(@{ $self->[0]{triples} })) {
  45         88  
99 25         23 my $t = shift(@{ $self->[0]{triples} });
  25         31  
100 25 50       63 if (my $d = $self->delegate) {
101 0         0 $d->log_result( $self, $t );
102             }
103 25         51 return $t;
104             }
105 20         87 my $row = $plan->next;
106 20 100       66 return undef unless ($row);
107 16         31 $self->[0]{blank_map} = {};
108            
109 16 50       41 if ($l->is_debug) {
110 0         0 $l->debug( "- got construct bindings from pattern: " . $row->as_string );
111             }
112 16         94 my $triples = $self->triples;
113            
114 16         24 foreach my $t (@$triples) {
115 28 50       52 if ($l->is_debug) {
116 0         0 $l->debug( "- filling-in construct triple pattern: " . $t->as_string );
117             }
118 28         129 my @triple = $t->nodes;
119 28         108 for my $i (0 .. 2) {
120 84 100       301 if ($triple[$i]->isa('RDF::Trine::Node::Variable')) {
    100          
121 36         71 my $name = $triple[$i]->name;
122 36         119 $triple[$i] = $row->{ $name };
123             } elsif ($triple[$i]->isa('RDF::Trine::Node::Blank')) {
124 16         34 my $id = $triple[$i]->blank_identifier;
125 16 100       56 unless (exists($self->[0]{blank_map}{ $id })) {
126 8         21 $self->[0]{blank_map}{ $id } = RDF::Trine::Node::Blank->new();
127             }
128 16         232 $triple[$i] = $self->[0]{blank_map}{ $id };
129             }
130             }
131 28         24 my $ok = 1;
132 28         34 foreach (@triple) {
133 84 100       179 if (not blessed($_)) {
134 3         5 $ok = 0;
135             }
136             }
137 28 100       46 next unless ($ok);
138 25         62 my $st = RDF::Trine::Statement->new( @triple );
139 25 50       306 unless ($self->[0]{seen}{ $st->as_string }++) {
140 25         2294 push(@{ $self->[0]{triples} }, $st);
  25         111  
141             }
142             }
143             }
144             }
145              
146             =item C<< close >>
147              
148             =cut
149              
150             sub close {
151 3     3 1 6 my $self = shift;
152 3 50       6 unless ($self->state == $self->OPEN) {
153 0         0 throw RDF::Query::Error::ExecutionError -text => "close() cannot be called on an un-open CONSTRUCT";
154             }
155 3         8 delete $self->[0]{blank_map};
156 3         5 delete $self->[0]{triples};
157            
158 3 50 33     17 if ($self->[1] and $self->[1]->state == $self->OPEN) {
159 3         14 $self->[1]->close();
160             }
161 3         10 $self->SUPER::close();
162             }
163              
164             =item C<< pattern >>
165              
166             Returns the query plan that will be used to produce the variable bindings for constructing the new graph.
167              
168             =cut
169              
170             sub pattern {
171 4     4 1 6 my $self = shift;
172 4         6 return $self->[1];
173             }
174              
175             =item C<< triples >>
176              
177             Returns the triples that are to be used in constructing the new graph for each variable binding.
178              
179             =cut
180              
181             sub triples {
182 16     16 1 11 my $self = shift;
183 16         24 return $self->[2];
184             }
185              
186             =item C<< distinct >>
187              
188             Returns true if the pattern is guaranteed to return distinct results.
189              
190             =cut
191              
192             sub distinct {
193 0     0 1 0 return 0;
194             }
195              
196             =item C<< ordered >>
197              
198             Returns true if the pattern is guaranteed to return ordered results.
199              
200             =cut
201              
202             sub ordered {
203 0     0 1 0 my $self = shift;
204 0         0 return [];
205             }
206              
207             =item C<< plan_node_name >>
208              
209             Returns the string name of this plan node, suitable for use in serialization.
210              
211             =cut
212              
213             sub plan_node_name {
214 0     0 1 0 return 'construct';
215             }
216              
217             =item C<< plan_prototype >>
218              
219             Returns a list of scalar identifiers for the type of the content (children)
220             nodes of this plan node. See L<RDF::Query::Plan> for a list of the allowable
221             identifiers.
222              
223             =cut
224              
225             sub plan_prototype {
226 0     0 1 0 my $self = shift;
227 0         0 return qw(P \T);
228             }
229              
230             =item C<< plan_node_data >>
231              
232             Returns the data for this plan node that corresponds to the values described by
233             the signature returned by C<< plan_prototype >>.
234              
235             =cut
236              
237             sub plan_node_data {
238 0     0 1 0 my $self = shift;
239 0         0 return ($self->pattern, [ @{ $self->triples } ]);
  0         0  
240             }
241              
242             =item C<< explain >>
243              
244             Returns a string serialization of the query plan appropriate for display
245             on the command line.
246              
247             =cut
248              
249             sub explain {
250 0     0 1 0 my $self = shift;
251 0         0 my ($s, $count) = (' ', 0);
252 0 0       0 if (@_) {
253 0         0 $s = shift;
254 0         0 $count = shift;
255             }
256 0         0 my $indent = '' . ($s x $count);
257 0         0 my $type = $self->plan_node_name;
258 0         0 my $string = sprintf("%s%s (0x%x)\n", $indent, $type, refaddr($self));
259 0         0 $string .= $self->pattern->explain( $s, $count+1 );
260 0         0 $string .= "${indent}${s}pattern\n";
261 0         0 foreach my $t (@{ $self->triples }) {
  0         0  
262 0         0 $string .= "${indent}${s}${s}" . $t->as_sparql . "\n";
263             }
264 0         0 return $string;
265             }
266              
267             =item C<< graph ( $g ) >>
268              
269             =cut
270              
271             sub graph {
272 0     0 1 0 my $self = shift;
273 0         0 my $g = shift;
274 0         0 my $c = $self->pattern->graph( $g );
275 0         0 $g->add_node( "$self", label => "Construct" . $self->graph_labels );
276 0         0 $g->add_edge( "$self", $c );
277 0         0 return "$self";
278             }
279              
280             =item C<< as_iterator ( $context ) >>
281              
282             Returns an RDF::Trine::Iterator object for the current (already executed) plan.
283              
284             =cut
285              
286             sub as_iterator {
287 4     4 1 7 my $self = shift;
288 4         6 my $context = shift;
289 4     29   21 my $stream = RDF::Trine::Iterator::Graph->new( sub { $self->next } );
  29         12022  
290 4         94 return $stream;
291             }
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