File Coverage

blib/lib/RDF/Query/Plan/Extend.pm
Criterion Covered Total %
statement 94 132 71.2
branch 17 32 53.1
condition 2 3 66.6
subroutine 18 22 81.8
pod 12 12 100.0
total 143 201 71.1


line stmt bran cond sub pod time code
1             # RDF::Query::Plan::Extend
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Plan::Extend - Executable query plan for Extends.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Plan::Extend 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::Extend;
22              
23 35     35   184 use strict;
  35         71  
  35         892  
24 35     35   178 use warnings;
  35         61  
  35         940  
25 35     35   179 use base qw(RDF::Query::Plan);
  35         67  
  35         2574  
26 35     35   206 use RDF::Query::Error qw(:try);
  35         70  
  35         278  
27 35     35   5309 use Scalar::Util qw(blessed refaddr);
  35         93  
  35         1791  
28 35     35   190 use Data::Dumper;
  35         80  
  35         2535  
29              
30             ######################################################################
31              
32             our ($VERSION);
33             BEGIN {
34 35     35   51161 $VERSION = '2.916';
35             }
36              
37             ######################################################################
38              
39             =item C<< new ( $plan, \@keys ) >>
40              
41             =cut
42              
43             sub new {
44 24     24 1 42 my $class = shift;
45 24         35 my $plan = shift;
46 24         35 my $keys = shift;
47 24         38 my (@vars, @exprs);
48 24         53 foreach my $k (@$keys) {
49 28 50       141 push(@exprs, $k) if ($k->isa('RDF::Query::Expression'));
50 28 50       150 push(@vars, $k->name) if ($k->isa('RDF::Query::Node::Variable'));
51 28 50       87 push(@vars, $k) if (not(ref($k)));
52             }
53 24         108 my $self = $class->SUPER::new( $plan, \@vars, \@exprs );
54 24         107 $self->[0]{referenced_variables} = [ $plan->referenced_variables ];
55 24         111 return $self;
56             }
57              
58             =item C<< execute ( $execution_context ) >>
59              
60             =cut
61              
62             sub execute ($) {
63 24     24 1 43 my $self = shift;
64 24         36 my $context = shift;
65 24         72 $self->[0]{delegate} = $context->delegate;
66 24         93 my $l = Log::Log4perl->get_logger("rdf.query.plan.extend");
67 24         2167 $l->trace( "executing extend plan: " . $self->sse );
68 24 50       253 if ($self->state == $self->OPEN) {
69 0         0 throw RDF::Query::Error::ExecutionError -text => "EXTEND plan can't be executed while already open";
70             }
71 24         50 my $plan = $self->[1];
72 24         105 $plan->execute( $context );
73            
74 24 50       82 if ($plan->state == $self->OPEN) {
75 24         70 $self->[0]{context} = $context;
76 24         105 $self->state( $self->OPEN );
77             } else {
78 0         0 warn "could not execute plan in PROJECT";
79             }
80 24         83 $self;
81             }
82              
83             =item C<< next >>
84              
85             =cut
86              
87             sub next {
88 65     65 1 115 my $self = shift;
89 65         158 my $ctx = $self->[0]{context};
90 65 50       195 unless ($self->state == $self->OPEN) {
91 0         0 throw RDF::Query::Error::ExecutionError -text => "next() cannot be called on an un-open PROJECT";
92             }
93            
94 65         209 my $l = Log::Log4perl->get_logger("rdf.query.plan.extend");
95 65         1228 my $plan = $self->[1];
96 65         94 while (1) {
97 65         233 my $result = $plan->next;
98 65 100       176 unless (defined($result)) {
99 23         91 $l->trace("no remaining rows in extend");
100 23 50       220 if ($self->[1]->state == $self->[1]->OPEN) {
101 23         100 $self->[1]->close();
102             }
103 23         88 return;
104             }
105 42         337 my $row = RDF::Query::VariableBindings->new( { %$result } );
106 42 50       178 if ($l->is_trace) {
107 0         0 $l->trace( "extend on row $row" );
108             }
109            
110 42         317 my $keys = $self->[2];
111 42         70 my $exprs = $self->[3];
112 42         202 my $query = $self->[0]{context}->query;
113            
114 42         158 local($query->{_query_row_cache}) = {};
115             # my $proj = $row->project( @{ $keys } );
116 42         71 my $ok = 1;
117 42         87 foreach my $e (@$exprs) {
118 46         276 my $name = $e->name;
119 46         299 my $var_or_expr = $e->expression;
120 46 50       150 if ($l->is_trace) {
121 0         0 $l->trace( "- extend alias " . $var_or_expr->sse . " -> $name" );
122             }
123             try {
124 46     46   1539 my $value = $query->var_or_expr_value( $row, $var_or_expr, $ctx );
125 46 50       314 if ($l->is_trace) {
126 0         0 $l->trace( "- extend value $name -> $value" );
127             }
128 46         379 $row->{ $name } = $value;
129             } catch RDF::Query::Error with {
130 0     0   0 $l->trace( "- evaluating extend expression resulted in an error; dropping the variable binding" );
131             } otherwise {
132 0     0   0 my $e = shift;
133 0         0 warn 'exception caught in Extend(): ' . Dumper($e);
134 46         668 };
135             }
136 42 50       809 next unless ($ok);
137 42         187 $l->trace( "Extended result: $row" );
138 42 50       2251 if (my $d = $self->delegate) {
139 0         0 $d->log_result( $self, $row );
140             }
141 42         217 return $row;
142             }
143             }
144              
145             =item C<< close >>
146              
147             =cut
148              
149             sub close {
150 24     24 1 48 my $self = shift;
151 24 50       81 unless ($self->state == $self->OPEN) {
152 0         0 throw RDF::Query::Error::ExecutionError -text => "close() cannot be called on an un-open PROJECT";
153             }
154 24         254 delete $self->[0]{context};
155 24 100 66     216 if (blessed($self->[1]) and $self->[1]->state == $self->OPEN) {
156 1         6 $self->[1]->close();
157             }
158 24         117 $self->SUPER::close();
159             }
160              
161             =item C<< pattern >>
162              
163             Returns the query plan that will be used to produce the data to be extended.
164              
165             =cut
166              
167             sub pattern {
168 67     67 1 103 my $self = shift;
169 67         326 return $self->[1];
170             }
171              
172             =item C<< distinct >>
173              
174             Returns true if the pattern is guaranteed to return distinct results.
175              
176             =cut
177              
178             sub distinct {
179 24     24 1 50 my $self = shift;
180 24         67 return $self->pattern->distinct;
181             }
182              
183             =item C<< ordered >>
184              
185             Returns true if the pattern is guaranteed to return ordered results.
186              
187             =cut
188              
189             sub ordered {
190 19     19 1 32 my $self = shift;
191 19         46 return $self->pattern->ordered;
192             }
193              
194             =item C<< plan_node_name >>
195              
196             Returns the string name of this plan node, suitable for use in serialization.
197              
198             =cut
199              
200             sub plan_node_name {
201 24     24 1 78 return 'extend';
202             }
203              
204             =item C<< plan_prototype >>
205              
206             Returns a list of scalar identifiers for the type of the content (children)
207             nodes of this plan node. See L<RDF::Query::Plan> for a list of the allowable
208             identifiers.
209              
210             =cut
211              
212             sub plan_prototype {
213 24     24 1 38 my $self = shift;
214 24         90 return qw(\J P);
215             }
216              
217             =item C<< plan_node_data >>
218              
219             Returns the data for this plan node that corresponds to the values described by
220             the signature returned by C<< plan_prototype >>.
221              
222             =cut
223              
224             sub plan_node_data {
225 24     24 1 48 my $self = shift;
226 24         37 my @vars = map { RDF::Query::Node::Variable->new( $_ ) } @{$self->[2]};
  0         0  
  24         74  
227 24         34 my @exprs = @{$self->[3]};
  24         823  
228 24         103 return ([ @vars, @exprs ], $self->pattern);
229             }
230              
231             =item C<< graph ( $g ) >>
232              
233             =cut
234              
235             sub graph {
236 0     0 1   my $self = shift;
237 0           my $g = shift;
238 0           my $c = $self->pattern->graph( $g );
239 0 0         my $expr = join(' ', @{$self->[2]}, map { blessed($_) ? $_->sse( {}, "" ) : $_ } @{$self->[3]});
  0            
  0            
  0            
240 0           $g->add_node( "$self", label => "Extend ($expr)" . $self->graph_labels );
241 0           $g->add_edge( "$self", $c );
242 0           return "$self";
243             }
244              
245             =item C<< explain >>
246              
247             Returns a string serialization of the plan appropriate for display on the
248             command line.
249              
250             =cut
251              
252             sub explain {
253 0     0 1   my $self = shift;
254 0           my $s = shift;
255 0           my $count = shift;
256 0           my $indent = $s x $count;
257 0           my $type = $self->plan_node_name;
258 0           my $string = sprintf("%s%s (0x%x)\n", $indent, $type, refaddr($self));
259 0           $string .= "${indent}${s}vars:\n";
260 0           my @vars = map { RDF::Query::Node::Variable->new( $_ ) } @{$self->[2]};
  0            
  0            
261 0           my @exprs = @{$self->[3]};
  0            
262 0           foreach my $e (@vars, @exprs) {
263 0           $string .= $e->explain($s, $count+2);
264             }
265 0           $string .= $self->pattern->explain( $s, $count+1 );
266 0           return $string;
267             }
268              
269              
270              
271             1;
272              
273             __END__
274              
275             =back
276              
277             =head1 AUTHOR
278              
279             Gregory Todd Williams <gwilliams@cpan.org>
280              
281             =cut