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.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::Extend;
22              
23 35     35   126 use strict;
  35         47  
  35         836  
24 35     35   118 use warnings;
  35         42  
  35         752  
25 35     35   112 use base qw(RDF::Query::Plan);
  35         40  
  35         2072  
26 35     35   152 use RDF::Query::Error qw(:try);
  35         47  
  35         215  
27 35     35   4227 use Scalar::Util qw(blessed refaddr);
  35         57  
  35         1396  
28 35     35   133 use Data::Dumper;
  35         44  
  35         1852  
29              
30             ######################################################################
31              
32             our ($VERSION);
33             BEGIN {
34 35     35   34784 $VERSION = '2.918';
35             }
36              
37             ######################################################################
38              
39             =item C<< new ( $plan, \@keys ) >>
40              
41             =cut
42              
43             sub new {
44 24     24 1 35 my $class = shift;
45 24         36 my $plan = shift;
46 24         31 my $keys = shift;
47 24         29 my (@vars, @exprs);
48 24         44 foreach my $k (@$keys) {
49 28 50       114 push(@exprs, $k) if ($k->isa('RDF::Query::Expression'));
50 28 50       113 push(@vars, $k->name) if ($k->isa('RDF::Query::Node::Variable'));
51 28 50       73 push(@vars, $k) if (not(ref($k)));
52             }
53 24         93 my $self = $class->SUPER::new( $plan, \@vars, \@exprs );
54 24         74 $self->[0]{referenced_variables} = [ $plan->referenced_variables ];
55 24         78 return $self;
56             }
57              
58             =item C<< execute ( $execution_context ) >>
59              
60             =cut
61              
62             sub execute ($) {
63 24     24 1 34 my $self = shift;
64 24         49 my $context = shift;
65 24         65 $self->[0]{delegate} = $context->delegate;
66 24         79 my $l = Log::Log4perl->get_logger("rdf.query.plan.extend");
67 24         1509 $l->trace( "executing extend plan: " . $self->sse );
68 24 50       221 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         54 my $plan = $self->[1];
72 24         100 $plan->execute( $context );
73            
74 24 50       72 if ($plan->state == $self->OPEN) {
75 24         61 $self->[0]{context} = $context;
76 24         90 $self->state( $self->OPEN );
77             } else {
78 0         0 warn "could not execute plan in PROJECT";
79             }
80 24         89 $self;
81             }
82              
83             =item C<< next >>
84              
85             =cut
86              
87             sub next {
88 65     65 1 74 my $self = shift;
89 65         96 my $ctx = $self->[0]{context};
90 65 50       126 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         163 my $l = Log::Log4perl->get_logger("rdf.query.plan.extend");
95 65         890 my $plan = $self->[1];
96 65         69 while (1) {
97 65         213 my $result = $plan->next;
98 65 100       153 unless (defined($result)) {
99 23         70 $l->trace("no remaining rows in extend");
100 23 50       152 if ($self->[1]->state == $self->[1]->OPEN) {
101 23         82 $self->[1]->close();
102             }
103 23         67 return;
104             }
105 42         259 my $row = RDF::Query::VariableBindings->new( { %$result } );
106 42 50       146 if ($l->is_trace) {
107 0         0 $l->trace( "extend on row $row" );
108             }
109            
110 42         256 my $keys = $self->[2];
111 42         62 my $exprs = $self->[3];
112 42         137 my $query = $self->[0]{context}->query;
113            
114 42         131 local($query->{_query_row_cache}) = {};
115             # my $proj = $row->project( @{ $keys } );
116 42         53 my $ok = 1;
117 42         80 foreach my $e (@$exprs) {
118 46         208 my $name = $e->name;
119 46         232 my $var_or_expr = $e->expression;
120 46 50       110 if ($l->is_trace) {
121 0         0 $l->trace( "- extend alias " . $var_or_expr->sse . " -> $name" );
122             }
123             try {
124 46     46   1281 my $value = $query->var_or_expr_value( $row, $var_or_expr, $ctx );
125 46 50       263 if ($l->is_trace) {
126 0         0 $l->trace( "- extend value $name -> $value" );
127             }
128 46         280 $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         592 };
135             }
136 42 50       670 next unless ($ok);
137 42         189 $l->trace( "Extended result: $row" );
138 42 50       1764 if (my $d = $self->delegate) {
139 0         0 $d->log_result( $self, $row );
140             }
141 42         192 return $row;
142             }
143             }
144              
145             =item C<< close >>
146              
147             =cut
148              
149             sub close {
150 24     24 1 45 my $self = shift;
151 24 50       57 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         182 delete $self->[0]{context};
155 24 100 66     154 if (blessed($self->[1]) and $self->[1]->state == $self->OPEN) {
156 1         6 $self->[1]->close();
157             }
158 24         109 $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 353 my $self = shift;
169 67         222 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 39 my $self = shift;
180 24         75 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 25 my $self = shift;
191 19         42 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 54 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 36 my $self = shift;
214 24         82 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 39 my $self = shift;
226 24         42 my @vars = map { RDF::Query::Node::Variable->new( $_ ) } @{$self->[2]};
  0         0  
  24         73  
227 24         35 my @exprs = @{$self->[3]};
  24         754  
228 24         108 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