File Coverage

blib/lib/RDF/Query/Plan/Update.pm
Criterion Covered Total %
statement 96 143 67.1
branch 19 42 45.2
condition 0 3 0.0
subroutine 19 26 73.0
pod 16 16 100.0
total 150 230 65.2


line stmt bran cond sub pod time code
1             # RDF::Query::Plan::Update
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Plan::Update - Executable query plan for DELETE/INSERT operations.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Plan::Update 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::Update;
22              
23 35     35   127 use strict;
  35         48  
  35         804  
24 35     35   124 use warnings;
  35         42  
  35         749  
25 35     35   111 use base qw(RDF::Query::Plan);
  35         46  
  35         1875  
26              
27 35     35   143 use Log::Log4perl;
  35         53  
  35         190  
28 35     35   1251 use Scalar::Util qw(blessed refaddr);
  35         53  
  35         1571  
29 35     35   139 use Time::HiRes qw(gettimeofday tv_interval);
  35         54  
  35         191  
30              
31 35     35   2929 use RDF::Query::Error qw(:try);
  35         52  
  35         200  
32 35     35   3421 use RDF::Query::ExecutionContext;
  35         50  
  35         582  
33 35     35   113 use RDF::Query::VariableBindings;
  35         48  
  35         1090  
34              
35             ######################################################################
36              
37             our ($VERSION);
38             BEGIN {
39 35     35   34006 $VERSION = '2.918';
40             }
41              
42             ######################################################################
43              
44             =item C<< new ( $delete_template, $insert_template, $pattern, \%dataset ) >>
45              
46             =cut
47              
48             sub new {
49 8     8 1 10 my $class = shift;
50 8         10 my $delete = shift;
51 8         10 my $insert = shift;
52 8         10 my $pattern = shift;
53 8         9 my $dataset = shift;
54 8         31 my $self = $class->SUPER::new( $delete, $insert, $pattern, $dataset );
55 8         34 return $self;
56             }
57              
58             =item C<< execute ( $execution_context ) >>
59              
60             =cut
61              
62             sub execute ($) {
63 8     8 1 8 my $self = shift;
64 8         11 my $context = shift;
65 8         29 $self->[0]{delegate} = $context->delegate;
66 8 50       34 if ($self->state == $self->OPEN) {
67 0         0 throw RDF::Query::Error::ExecutionError -text => "UPDATE plan can't be executed while already open";
68             }
69            
70 8         23 my $insert_template = $self->insert_template;
71 8         22 my $delete_template = $self->delete_template;
72 8         20 my $plan = $self->pattern;
73 8 50       25 if ($self->dataset) {
74 0         0 my $ds = $context->model->dataset_model( %{ $self->dataset } );
  0         0  
75 0         0 $context = $context->copy( model => $ds );
76             }
77 8         30 $plan->execute( $context );
78 8 50       18 if ($plan->state == $self->OPEN) {
79 8         25 my $l = Log::Log4perl->get_logger("rdf.query.plan.update");
80 8         628 $l->trace( "executing RDF::Query::Plan::Update" );
81            
82 8         44 my @rows;
83 8         30 while (my $row = $plan->next) {
84 9         33 $l->trace("Update row: $row");
85 9         186 push(@rows, $row);
86             }
87            
88 8         31 my @operations = (
89             [$delete_template, 'remove_statements'],
90             [$insert_template, 'add_statement'],
91             );
92            
93 8         16 foreach my $data (@operations) {
94 16         1865 my ($template, $method) = @$data;
95 16         42 $l->trace("UPDATE running $method");
96 16         70 foreach my $row (@rows) {
97 18 100       2268 my @triples = blessed($template) ? $template->quads : ();
98            
99 18         29 TRIPLE: foreach my $t (@triples) {
100 35         7926 my @nodes = $t->nodes;
101 35         151 for my $i (0 .. $#nodes) {
102 140 100       629 if ($nodes[$i]->isa('RDF::Trine::Node::Variable')) {
    100          
103 6         21 my $name = $nodes[$i]->name;
104 6 100       31 if ($method eq 'remove_statements') {
105 3 50       9 if (exists($row->{ $name })) {
106 3         6 $nodes[$i] = $row->{ $name };
107             } else {
108 0         0 next TRIPLE;
109             }
110             } else {
111 3         8 $nodes[$i] = $row->{ $name };
112             }
113             } elsif ($nodes[$i]->isa('RDF::Trine::Node::Blank')) {
114 1         4 my $id = $nodes[$i]->blank_identifier;
115 1 50       6 unless (exists($self->[0]{blank_map}{ $id })) {
116 1 50       3 if ($method eq 'remove_statements') {
117 0         0 $self->[0]{blank_map}{ $id } = RDF::Query::Node::Variable->new();
118             } else {
119 1         4 $self->[0]{blank_map}{ $id } = RDF::Query::Node::Blank->new();
120             }
121             }
122 1         8 $nodes[$i] = $self->[0]{blank_map}{ $id };
123             }
124             }
125             # my $ok = 1;
126 35         48 foreach my $i (0 .. 3) {
127 140         110 my $n = $nodes[ $i ];
128 140 50       297 if (not blessed($n)) {
129 0 0       0 if ($i == 3) {
130 0         0 $nodes[ $i ] = RDF::Trine::Node::Nil->new();
131             } else {
132 0         0 next TRIPLE;
133             # $nodes[ $i ] = RDF::Query::Node::Variable->new();
134             }
135             # $ok = 0;
136             # } elsif ($n->isa('RDF::Trine::Node::Variable')) {
137             # $ok = 0;
138             }
139             }
140             # next unless ($ok);
141 35 50       117 my $st = (scalar(@nodes) == 4)
142             ? RDF::Trine::Statement::Quad->new( @nodes )
143             : RDF::Trine::Statement->new( @nodes );
144 35         469 $l->trace( "$method: " . $st->as_string );
145 35 100       1682 if ($method eq 'remove_statements') {
146 3         14 $context->model->$method( $st->nodes );
147             } else {
148 32         82 $context->model->$method( $st );
149             }
150             }
151             }
152             }
153 8         2324 $self->[0]{ok} = 1;
154 8         42 $self->state( $self->OPEN );
155             } else {
156 0         0 warn "could not execute Update pattern plan";
157             }
158 8         72 $self;
159             }
160              
161             =item C<< next >>
162              
163             =cut
164              
165             sub next {
166 0     0 1 0 my $self = shift;
167 0 0       0 unless ($self->state == $self->OPEN) {
168 0         0 throw RDF::Query::Error::ExecutionError -text => "next() cannot be called on an un-open UPDATE";
169             }
170            
171 0         0 my $l = Log::Log4perl->get_logger("rdf.query.plan.update");
172 0         0 $self->close();
173 0 0       0 if (my $d = $self->delegate) {
174 0         0 $d->log_result( $self, $self->[0]{ok} );
175             }
176 0         0 return $self->[0]{ok};
177             }
178              
179             =item C<< close >>
180              
181             =cut
182              
183             sub close {
184 8     8 1 15 my $self = shift;
185 8 50       21 unless ($self->state == $self->OPEN) {
186 0         0 throw RDF::Query::Error::ExecutionError -text => "close() cannot be called on an un-open UPDATE";
187             }
188            
189 8         17 delete $self->[0]{ok};
190 8         32 $self->SUPER::close();
191             }
192              
193             =item C<< delete_template >>
194              
195             Returns the algebra object representing the RDF template to delete.
196              
197             =cut
198              
199             sub delete_template {
200 8     8 1 12 my $self = shift;
201 8         13 return $self->[1];
202             }
203              
204             =item C<< insert_template >>
205              
206             Returns the algebra object representing the RDF template to insert.
207              
208             =cut
209              
210             sub insert_template {
211 8     8 1 11 my $self = shift;
212 8         13 return $self->[2];
213             }
214              
215             =item C<< pattern >>
216              
217             Returns the pattern plan object.
218              
219             =cut
220              
221             sub pattern {
222 8     8 1 11 my $self = shift;
223 8         11 return $self->[3];
224             }
225              
226             =item C<< dataset >>
227              
228             Returns the dataset HASH reference.
229              
230             =cut
231              
232             sub dataset {
233 8     8 1 11 my $self = shift;
234 8         24 return $self->[4];
235             }
236              
237             =item C<< distinct >>
238              
239             Returns true if the pattern is guaranteed to return distinct results.
240              
241             =cut
242              
243             sub distinct {
244 8     8 1 23 return 1;
245             }
246              
247             =item C<< ordered >>
248              
249             Returns true if the pattern is guaranteed to return ordered results.
250              
251             =cut
252              
253             sub ordered {
254 8     8 1 58 return [];
255             }
256              
257             =item C<< plan_node_name >>
258              
259             Returns the string name of this plan node, suitable for use in serialization.
260              
261             =cut
262              
263             sub plan_node_name {
264 0     0 1   return 'update';
265             }
266              
267             =item C<< plan_prototype >>
268              
269             Returns a list of scalar identifiers for the type of the content (children)
270             nodes of this plan node. See L<RDF::Query::Plan> for a list of the allowable
271             identifiers.
272              
273             =cut
274              
275             sub plan_prototype {
276 0     0 1   my $self = shift;
277 0           return qw(A A P);
278             }
279              
280             =item C<< plan_node_data >>
281              
282             Returns the data for this plan node that corresponds to the values described by
283             the signature returned by C<< plan_prototype >>.
284              
285             =cut
286              
287             sub plan_node_data {
288 0     0 1   my $self = shift;
289 0           return ($self->delete_template, $self->insert_template, $self->pattern);
290             }
291              
292             =item C<< explain >>
293              
294             Returns a string serialization of the algebra appropriate for display on the
295             command line.
296              
297             =cut
298              
299             sub explain {
300 0     0 1   my $self = shift;
301 0           my $s = shift;
302 0           my $count = shift;
303 0           my $indent = $s x $count;
304 0           my $type = $self->plan_node_name;
305 0           my $string = sprintf("%s%s (0x%x)\n", $indent, $type, refaddr($self));
306            
307 0 0         if (my $d = $self->delete_template) {
308 0           $string .= "${indent}${s}delete:\n";
309 0           $string .= $d->explain( $s, $count+2 );
310             }
311              
312 0 0         if (my $i = $self->insert_template) {
313 0           $string .= "${indent}${s}insert:\n";
314 0           $string .= $i->explain( $s, $count+2 );
315             }
316              
317 0 0         if (my $p = $self->pattern) {
318 0 0 0       if ($p->isa('RDF::Query::Plan::Constant') and $p->is_unit) {
319            
320             } else {
321 0           $string .= "${indent}${s}where:\n";
322 0           $string .= $p->explain( $s, $count+2 );
323             }
324             }
325            
326 0           return $string;
327             }
328              
329             =item C<< graph ( $g ) >>
330              
331             =cut
332              
333             sub graph {
334 0     0 1   my $self = shift;
335 0           my $g = shift;
336 0           my $label = $self->graph_labels;
337 0           my $url = $self->url->uri_value;
338 0           throw RDF::Query::Error::ExecutionError -text => "RDF::Query::Plan::Update->graph not implemented.";
339             # $g->add_node( "$self", label => "delete" . $self->graph_labels );
340             # $g->add_node( "${self}$url", label => $url );
341             # $g->add_edge( "$self" => "${self}$url", label => 'url' );
342             # return "$self";
343             }
344              
345             =item C<< is_update >>
346              
347             Returns true if the plan represents an update operation.
348              
349             =cut
350              
351             sub is_update {
352 0     0 1   return 1;
353             }
354              
355              
356             1;
357              
358             __END__
359              
360             =back
361              
362             =head1 AUTHOR
363              
364             Gregory Todd Williams <gwilliams@cpan.org>
365              
366             =cut