File Coverage

blib/lib/RDF/Query/Plan/Clear.pm
Criterion Covered Total %
statement 28 95 29.4
branch 0 22 0.0
condition 0 6 0.0
subroutine 10 24 41.6
pod 12 12 100.0
total 50 159 31.4


line stmt bran cond sub pod time code
1             # RDF::Query::Plan::Clear
2             # -----------------------------------------------------------------------------
3              
4             =head1 NAME
5              
6             RDF::Query::Plan::Clear - Executable query plan for CLEAR operations.
7              
8             =head1 VERSION
9              
10             This document describes RDF::Query::Plan::Clear version 2.915_01.
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::Clear;
22              
23 35     35   187 use strict;
  35         75  
  35         877  
24 35     35   181 use warnings;
  35         70  
  35         928  
25 35     35   178 use base qw(RDF::Query::Plan);
  35         69  
  35         2447  
26              
27 35     35   196 use Log::Log4perl;
  35         84  
  35         254  
28 35     35   1553 use Scalar::Util qw(blessed);
  35         68  
  35         1748  
29 35     35   186 use Time::HiRes qw(gettimeofday tv_interval);
  35         86  
  35         252  
30              
31 35     35   3648 use RDF::Query::Error qw(:try);
  35         101  
  35         242  
32 35     35   4388 use RDF::Query::ExecutionContext;
  35         76  
  35         829  
33 35     35   253 use RDF::Query::VariableBindings;
  35         85  
  35         1496  
34              
35             ######################################################################
36              
37             our ($VERSION);
38             BEGIN {
39 35     35   34381 $VERSION = '2.915_01';
40             }
41              
42             ######################################################################
43              
44             =item C<< new ( $graph ) >>
45              
46             =cut
47              
48             sub new {
49 0     0 1   my $class = shift;
50 0           my $graph = shift;
51 0           my $self = $class->SUPER::new( $graph );
52 0           return $self;
53             }
54              
55             =item C<< execute ( $execution_context ) >>
56              
57             =cut
58              
59             sub execute ($) {
60 0     0 1   my $self = shift;
61 0           my $context = shift;
62 0           $self->[0]{delegate} = $context->delegate;
63 0 0         if ($self->state == $self->OPEN) {
64 0           throw RDF::Query::Error::ExecutionError -text => "CLEAR plan can't be executed while already open";
65             }
66            
67 0           my $l = Log::Log4perl->get_logger("rdf.query.plan.clear");
68 0           $l->trace( "executing RDF::Query::Plan::Clear" );
69            
70 0 0         my %args = ($self->namedgraph) ? (context => $self->namedgraph) : ();
71 0           my $graph = $self->namedgraph;
72 0 0         unless ($graph) {
73 0           $graph = RDF::Trine::Node::Nil->new;
74             }
75             # warn "clearing graph " . $graph->as_string;
76 0           my $ok = 0;
77             try {
78 0 0   0     if ($graph->is_nil) {
79 0           $context->model->remove_statements( undef, undef, undef, $graph );
80             } else {
81 0           my $uri = $graph->uri_value;
82 0 0         if ($uri eq 'tag:gwilliams@cpan.org,2010-01-01:RT:ALL') {
    0          
83 0           $context->model->remove_statements( undef, undef, undef, undef );
84             } elsif ($uri eq 'tag:gwilliams@cpan.org,2010-01-01:RT:NAMED') {
85 0           my $citer = $context->model->get_graphs;
86 0           while (my $graph = $citer->next) {
87 0           $context->model->remove_statements( undef, undef, undef, $graph );
88             }
89             } else {
90 0           $context->model->remove_statements( undef, undef, undef, $graph );
91             }
92             }
93 0           $ok = 1;
94 0     0     } catch RDF::Trine::Error with {};
95 0           $self->[0]{ok} = $ok;
96 0           $self->state( $self->OPEN );
97 0           $self;
98             }
99              
100             =item C<< next >>
101              
102             =cut
103              
104             sub next {
105 0     0 1   my $self = shift;
106 0 0         unless ($self->state == $self->OPEN) {
107 0           throw RDF::Query::Error::ExecutionError -text => "next() cannot be called on an un-open CLEAR";
108             }
109            
110 0           my $l = Log::Log4perl->get_logger("rdf.query.plan.clear");
111 0           $self->close();
112 0 0         if (my $d = $self->delegate) {
113 0           $d->log_result( $self, $self->[0]{ok} );
114             }
115 0           return $self->[0]{ok};
116             }
117              
118             =item C<< close >>
119              
120             =cut
121              
122             sub close {
123 0     0 1   my $self = shift;
124 0 0         unless ($self->state == $self->OPEN) {
125 0           throw RDF::Query::Error::ExecutionError -text => "close() cannot be called on an un-open CLEAR";
126             }
127            
128 0           delete $self->[0]{ok};
129 0           $self->SUPER::close();
130             }
131              
132             =item C<< namedgraph >>
133              
134             Returns the graph node which is to be cleared.
135              
136             =cut
137              
138             sub namedgraph {
139 0     0 1   my $self = shift;
140 0           return $self->[1];
141             }
142              
143             =item C<< distinct >>
144              
145             Returns true if the pattern is guaranteed to return distinct results.
146              
147             =cut
148              
149             sub distinct {
150 0     0 1   return 1;
151             }
152              
153             =item C<< ordered >>
154              
155             Returns true if the pattern is guaranteed to return ordered results.
156              
157             =cut
158              
159             sub ordered {
160 0     0 1   return [];
161             }
162              
163             =item C<< plan_node_name >>
164              
165             Returns the string name of this plan node, suitable for use in serialization.
166              
167             =cut
168              
169             sub plan_node_name {
170 0     0 1   return 'clear';
171             }
172              
173             =item C<< plan_prototype >>
174              
175             Returns a list of scalar identifiers for the type of the content (children)
176             nodes of this plan node. See L<RDF::Query::Plan> for a list of the allowable
177             identifiers.
178              
179             =cut
180              
181             sub plan_prototype {
182 0     0 1   my $self = shift;
183 0           my $g = $self->namedgraph;
184 0 0 0       if ($g->isa('RDF::Query::Node::Resource') and $g->uri_value =~ m'^tag:gwilliams@cpan[.]org,2010-01-01:RT:(NAMED|ALL)$') {
185 0           return qw(w);
186             } else {
187 0           return qw(N);
188             }
189             }
190              
191             =item C<< plan_node_data >>
192              
193             Returns the data for this plan node that corresponds to the values described by
194             the signature returned by C<< plan_prototype >>.
195              
196             =cut
197              
198             sub plan_node_data {
199 0     0 1   my $self = shift;
200 0           my $g = $self->namedgraph;
201 0 0 0       if ($g->isa('RDF::Query::Node::Resource') and $g->uri_value =~ m'^tag:gwilliams@cpan[.]org,2010-01-01:RT:(NAMED|ALL)$') {
202 0           return $1;
203             } else {
204 0           return ($self->namedgraph);
205             }
206             }
207              
208             =item C<< graph ( $g ) >>
209              
210             =cut
211              
212             sub graph {
213 0     0 1   my $self = shift;
214 0           my $g = shift;
215 0           my $label = $self->graph_labels;
216 0           my $url = $self->namedgraph->uri_value;
217 0           $g->add_node( "$self", label => "Clear" . $self->graph_labels );
218 0           $g->add_node( "${self}$url", label => $url );
219 0           $g->add_edge( "$self" => "${self}$url", label => 'url' );
220 0           return "$self";
221             }
222              
223             =item C<< is_update >>
224              
225             Returns true if the plan represents an update operation.
226              
227             =cut
228              
229             sub is_update {
230 0     0 1   return 1;
231             }
232              
233             1;
234              
235             __END__
236              
237             =back
238              
239             =head1 AUTHOR
240              
241             Gregory Todd Williams <gwilliams@cpan.org>
242              
243             =cut