File Coverage

blib/lib/AtteanX/Store/Memory.pm
Criterion Covered Total %
statement 234 241 97.1
branch 44 50 88.0
condition 10 12 83.3
subroutine 32 32 100.0
pod 11 11 100.0
total 331 346 95.6


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             AtteanX::Store::Memory - Simple in-memory RDF store
4              
5             =head1 VERSION
6              
7             This document describes AtteanX::Store::Memory version 0.033
8              
9             =head1 SYNOPSIS
10              
11             use AtteanX::Store::Memory;
12              
13             =head1 DESCRIPTION
14              
15             AtteanX::Store::Memory provides an in-memory quad-store.
16              
17             =cut
18              
19 14     14   77963 use v5.14;
  14         49  
20 14     14   76 use warnings;
  14         38  
  14         584  
21              
22             use Moo;
23 14     14   74 use Type::Tiny::Role;
  14         30  
  14         107  
24 14     14   4546 use Types::Standard qw(Int ArrayRef HashRef ConsumerOf InstanceOf);
  14         29  
  14         468  
25 14     14   70 use Encode;
  14         31  
  14         170  
26 14     14   12700 use Set::Scalar;
  14         29  
  14         1202  
27 14     14   82 use Digest::SHA;
  14         32  
  14         528  
28 14     14   86 use Data::Dumper;
  14         29  
  14         443  
29 14     14   75 use List::Util qw(first);
  14         28  
  14         551  
30 14     14   99 use Scalar::Util qw(refaddr reftype blessed);
  14         29  
  14         823  
31 14     14   89 use Math::Cartesian::Product;
  14         28  
  14         664  
32 14     14   86 use namespace::clean;
  14         27  
  14         602  
33 14     14   91  
  14         27  
  14         163  
34             with 'Attean::API::RDFStarStore';
35             with 'Attean::API::MutableQuadStore';
36             with 'Attean::API::QuadStore';
37             with 'Attean::API::ETagCacheableQuadStore';
38             with 'Attean::API::TimeCacheableQuadStore';
39             with 'Attean::API::CostPlanner';
40              
41             my @pos_names = Attean::API::Quad->variables;
42              
43             =head1 ATTRIBUTES
44              
45             =over 4
46              
47             =item C<< subject >>
48              
49             =item C<< predicate >>
50              
51             =item C<< object >>
52              
53             =item C<< graph >>
54              
55             =back
56              
57             =head1 METHODS
58              
59             Beyond the methods documented below, this class inherits methods from the
60             L<Attean::API::QuadStore> class.
61              
62             =over 4
63              
64             =item C<< new () >>
65              
66             Returns a new memory-backed storage object.
67              
68             =cut
69              
70             has _size => (is => 'rw', isa => Int, init_arg => undef, default => 0);
71             has statements => (is => 'rw', isa => ArrayRef[ConsumerOf['Attean::API::Quad']], init_arg => undef, default => sub { [] });
72             has subject => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} });
73             has predicate => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} });
74             has object => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} });
75             has graph => (is => 'ro', isa => HashRef[InstanceOf['Set::Scalar']], init_arg => undef, default => sub { +{} });
76             has graph_nodes => (is => 'rw', isa => HashRef[ConsumerOf['Attean::API::IRI']], init_arg => undef, default => sub { +{} });
77             has hash => (is => 'rw', isa => InstanceOf['Digest::SHA'], default => sub { Digest::SHA->new });
78             has mtime => (is => 'rw', isa => Int, default => sub { return time() });
79              
80             =item C<< size >>
81              
82             Returns the number of quads in the store.
83              
84             =cut
85              
86             shift->_size()
87             }
88              
89 25     25 1 2336 =item C<< get_quads ( $subject, $predicate, $object, $graph ) >>
90              
91             Returns a stream object of all statements matching the specified subject,
92             predicate and objects. Any of the arguments may be undef to match any value.
93              
94             =cut
95              
96             my $self = shift;
97             my @nodes = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @_;
98             my @iters;
99             cartesian { push(@iters, $self->_get_quads(@_)) } @nodes;
100             return Attean::IteratorSequence->new( iterators => \@iters, item_type => 'Attean::API::Quad' );
101             }
102              
103             my $self = shift;
104             my @nodes = @_;
105             my @pos_names = Attean::QuadPattern->variables;
106            
107 107     107   204 my %pattern_bound;
108 107         213 foreach my $pos (0 .. 3) {
109 107         474 my $n = $nodes[ $pos ];
110             $pattern_bound{ $pos_names[$pos] } = $n;
111 107         204 }
112 107         312
113 428         527 # create a quadpattern that includes any embedded triple patterns (RDF-star)
114 428         808 my $pattern = Attean::QuadPattern->new(%pattern_bound);
115              
116             my %bound;
117             my $bound = 0;
118 107         1978 my %embedded_triple_vars;
119             my $seen_embedded_triple = 0;
120 107         3551 foreach my $pos (0 .. 3) {
121 107         185 my $n = $nodes[ $pos ];
122 107         153 if (blessed($n) and $n->does('Attean::API::TriplePattern')) {
123 107         180 # replace embedded triple patterns with variables.
124 107         379 # the quads that match with the new variables will be filtered
125 428         558 # in post-processing below to ensure that they also match the
126 428 50 66     1296 # embedded triple patterns.
127             $seen_embedded_triple = 1;
128             my $v = Attean::Variable->new();
129             $embedded_triple_vars{$v->value} = $n;
130             $nodes[$pos] = $v;
131 0         0 $n = $v;
132 0         0 }
133 0         0
134 0         0 if (blessed($n) and $n->does('Attean::API::Variable')) {
135 0         0 $n = undef;
136             $nodes[$pos] = undef;
137             }
138 428 100 100     5554 if (blessed($n)) {
139 86         1011 $bound++;
140 86         146 $bound{ $pos } = $n;
141             }
142 428 100       4307 }
143 165         227
144 165         459 if ($bound == 0) {
145             my $i = 0;
146             my $sub = sub {
147             return unless ($i <= $#{ $self->statements });
148 107 100       299 my $st = $self->statements->[ $i ];
149 23         55 while (not(blessed($st)) and ($i <= $#{ $self->statements })) {
150             $i++;
151 71 100   71   97 $st = $self->statements->[ $i ];
  71         1401  
152 50         946 }
153 50   66     417 $i++;
  1         16  
154 1         9 return $st;
155 1         15 };
156             return Attean::CodeIterator->new( generator => $sub, item_type => 'Attean::API::Quad' )->matching_pattern($pattern);
157 50         98 }
158 50         110
159 23         129 my $match_set;
160 23         583 if ($bound == 1) {
161             my ($pos) = keys %bound;
162             my $name = $pos_names[ $pos ];
163 84         131 my $node = $bound{ $pos };
164 84 100       213 my $string = $node->as_string;
165 32         141 $match_set = $self->$name()->{ $string };
166 32         74 unless (blessed($match_set)) {
167 32         50 return Attean::ListIterator->new( values => [], item_type => 'Attean::API::Quad' );
168 32         122 }
169 32         3644 } else {
170 32 100       147 my @pos = keys %bound;
171 1         17 my @names = @pos_names[ @pos ];
172            
173             my @sets;
174 52         157 foreach my $i (0 .. $#pos) {
175 52         191 my $pos = $pos[ $i ];
176             my $node = $bound{ $pos };
177 52         76 Carp::confess unless ($node->can('as_string'));
178 52         139 my $string = $node->as_string;
179 133         219 my $name = $names[$i];
180 133         197 my $hash = $self->$name();
181 133 50       441 my $set = $hash->{ $string };
182 133         345 push(@sets, $set);
183 133         15632 }
184 133         464
185 133         264 foreach my $s (@sets) {
186 133         292 unless (blessed($s)) {
187             return Attean::ListIterator->new( values => [], item_type => 'Attean::API::Quad' );
188             }
189 52         107 }
190 129 100       396 my $i = shift(@sets);
191 5         98 while (@sets) {
192             my $s = shift(@sets);
193             $i = $i->intersection($s);
194 47         93 }
195 47         195 $match_set = $i;
196 72         10033 }
197 72         301
198             my @e = $match_set->elements;
199 47         19241 my $sub = sub {
200             return unless (scalar(@e));
201             my $e = shift(@e);
202 78         300 my $st = $self->statements->[ $e ];
203             return $st;
204 199 100   199   456 };
205 129         209 return Attean::CodeIterator->new( generator => $sub, item_type => 'Attean::API::Quad' )->matching_pattern($pattern);
206 129         2555 }
207 129         955  
208 78         888 =item C<< get_graphs >>
209 78         1577  
210             Returns an iterator over the Attean::API::Term objects comprising
211             the set of graphs of the stored quads.
212              
213             =cut
214              
215             my $self = shift;
216             my @ctx = values %{ $self->graph_nodes() };
217             return Attean::ListIterator->new( values => \@ctx, item_type => 'Attean::API::Term' );
218             }
219              
220 16     16 1 191 =item C<< add_quad ( $quad ) >>
221 16         26  
  16         260  
222 16         325 Adds the specified C<$quad> to the underlying model.
223              
224             =cut
225              
226             my $self = shift;
227             my $st = shift;
228            
229             my $count = $self->count_quads( $st->values );
230             if ($count == 0) {
231             $self->_size($self->_size + 1);
232             my $id = scalar(@{ $self->statements });
233             $self->hash->add('+' . encode_utf8($st->as_string));
234             $self->mtime(time());
235             push( @{ $self->statements }, $st );
236             foreach my $pos (0 .. $#pos_names) {
237             my $name = $pos_names[ $pos ];
238             my $node = $st->$name();
239             my $string = $node->as_string;
240             my $set = $self->$name()->{ $string };
241             unless (blessed($set)) {
242             $set = Set::Scalar->new();
243             $self->$name()->{ $string } = $set;
244             }
245             $set->insert( $id );
246             }
247            
248             my $ctx = $st->graph;
249             my $str = $ctx->as_string;
250             unless (exists $self->graph_nodes->{ $str }) {
251             $self->graph_nodes->{ $str } = $ctx;
252             }
253             }
254             return;
255             }
256              
257             =item C<< remove_quad ( $statement ) >>
258              
259             Removes the specified C<$statement> from the underlying model.
260              
261             =cut
262              
263             my $self = shift;
264             my $st = shift;
265            
266             my @nodes = $st->values;
267             my $count = $self->count_quads( @nodes[ 0..3 ] );
268             if ($count > 0) {
269             $self->_size( $self->_size - 1 );
270 17     17 1 1299 my $id = $self->_statement_id( $st->values );
271 17         20 $self->hash->add('-' . encode_utf8($st->as_string));
272             $self->mtime(time());
273 17         56 $self->statements->[ $id ] = undef;
274 17         54 foreach my $pos (0 .. 3) {
275 17 100       36 my $name = $pos_names[ $pos ];
276 16         279 my $node = $st->$name();
277 16         423 my $str = $node->as_string;
278 16         668 my $set = $self->$name()->{ $str };
279 16         243 $set->delete( $id );
280 16         530 if ($set->size == 0) {
281 16         87 if ($pos == 3) {
282 64         820 delete $self->graph_nodes->{ $str };
283 64         118 }
284 64         135 delete $self->$name()->{ $str };
285 64         2616 }
286 64         146 }
287 64 100       1227 }
288 37 100       210 return;
289 8         112 }
290              
291 37         143 =item C<< remove_quads ( $subject, $predicate, $object, $graph ) >>
292              
293             Removes the specified C<$statement> from the underlying model.
294              
295 17         199 =cut
296              
297             my $self = shift;
298             my @nodes = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @_;
299             my @iters;
300             cartesian { $self->_remove_quads(@_) } @nodes;
301             }
302              
303             my $self = shift;
304             my $subj = shift;
305 2     2 1 248 my $pred = shift;
306 2 100       4 my $obj = shift;
  4         11  
307 2         2 my $graph = shift;
308 2     3   8 my $iter = $self->get_quads( $subj, $pred, $obj, $graph );
  3         77  
309             while (my $st = $iter->next) {
310             $self->remove_quad( $st );
311             }
312 3     3   4 }
313 3         3  
314 3         4 =item C<< create_graph( $graph ) >>
315 3         3  
316 3         3 This is a no-op function for the memory quad-store.
317 3         46  
318 3         78 =cut
319 3         7  
320             # no-op on a quad-store
321             }
322              
323             =item C<< drop_graph( $graph ) >>
324              
325             Removes all quads with the given C<< $graph >>.
326              
327             =cut
328              
329       4 1   my $self = shift;
330             return $self->clear_graph(@_);
331             }
332              
333             =item C<< clear_graph( $graph ) >>
334              
335             Removes all quads with the given C<< $graph >>.
336              
337             =cut
338              
339             my $self = shift;
340 2     2 1 213 my $g = shift;
341 2         5 my $string = $g->as_string;
342             my $set = $self->graph()->{ $string };
343             return unless (blessed($set));
344            
345             my @quads = @{ $self->statements}[ $set->elements ];
346             foreach my $q (@quads) {
347             $self->remove_quad($q);
348             }
349             }
350              
351 4     4 1 214 =item C<< count_quads ( $subject, $predicate, $object, $graph ) >>
352 4         4  
353 4         8 Returns a count of all the statements matching the specified subject,
354 4         682 predicate, object, and graph. Any of the arguments may be undef to match any
355 4 50       12 value.
356              
357 4         12 =cut
  4         68  
358 4         25  
359 6         11 my $self = shift;
360             my @nodes = map { ref($_) eq 'ARRAY' ? $_ : [$_] } @_;
361             my $count = 0;
362             cartesian { $count += $self->_count_quads(@_) } @nodes;
363             return $count;
364             }
365              
366             my $self = shift;
367             my @nodes = @_[0..3];
368             my $bound = 0;
369             my %bound;
370            
371             foreach my $pos (0 .. 3) {
372 220     220 1 4741 my $n = $nodes[ $pos ];
373 220 100       406 if (ref($n)) {
  796         1927  
374 220         367 Carp::confess "Non-Attean node?" unless (ref($n) =~ /Attean/);
375 220     220   1770 }
  220         13323  
376 220         5073 if (blessed($n) and not($n->does('Attean::API::Variable'))) {
377             $bound++;
378             $bound{ $pos } = $n;
379             }
380 220     220   388 }
381 220         558
382 220         381 if ($bound == 0) {
383 220         296 return $self->_size;
384             } elsif ($bound == 1) {
385 220         513 my ($pos) = keys %bound;
386 880         1571 my $name = $pos_names[ $pos ];
387 880 100       1396 my $set = $self->$name()->{ $bound{ $pos }->as_string };
388 779 50       1700 unless (blessed($set)) {
389             return 0;
390 880 100 100     2742 }
391 737         12784 return $set->size;
392 737         1698 } else {
393             my @pos = keys %bound;
394             my @names = @pos_names[ @pos ];
395             my @sets;
396 220 100       671 foreach my $i (0 .. $#names) {
    100          
397 3         49 my $pos = $pos[ $i ];
398             my $setname = $names[ $i ];
399 28         60 my $data = $self->$setname();
400 28         61
401 28         142 my $node = $bound{ $pos };
402 28 100       3327 my $str = $node->as_string;
403 5         19 my $set = $data->{ $str };
404             push( @sets, $set );
405 23         110 }
406             foreach my $s (@sets) {
407 189         505 unless (blessed($s)) {
408 189         659 return 0;
409 189         260 }
410 189         512 }
411 709         969 my $i = shift(@sets);
412 709         794 while (@sets) {
413 709         1793 my $s = shift(@sets);
414             $i = $i->intersection($s);
415 709         892 }
416 709         1733 return $i->size;
417 709         80407 }
418 709         1384 }
419              
420 189         348 =item C<< etag_value_for_quads >>
421 326 100       869  
422 166         751 If the store has the capability and knowledge to support caching, returns a
423             persistent token that will remain consistent as long as the store's data doesn't
424             change. This token is acceptable for use as an HTTP ETag.
425 23         34  
426 23         37 =cut
427 59         11184  
428 59         132 my $self = shift;
429             return $self->hash->b64digest;
430 23         7741 }
431              
432             =item C<< mtime_for_quads >>
433              
434             =cut
435              
436             my $self = shift;
437             return $self->mtime;
438             }
439              
440             my $self = shift;
441             my @nodes = @_;
442             my ($subj, $pred, $obj, $graph) = @nodes;
443 3     3 1 4
444 3         38 my @pos = (0 .. 3);
445             my @names = @pos_names[ @pos ];
446             my @sets;
447             foreach my $i (0 .. $#names) {
448             my $pos = $pos[ $i ];
449             my $setname = $names[ $i ];
450             my $data = $self->$setname();
451             my $node = $nodes[ $pos ];
452 3     3 1 5 my $str = $node->as_string;
453 3         36 my $set = $data->{ $str };
454             push( @sets, $set );
455             }
456            
457 16     16   22 foreach my $s (@sets) {
458 16         26 unless (blessed($s)) {
459 16         28 return -1;
460             }
461 16         23 }
462 16         30 my $i = shift(@sets);
463 16         17 while (@sets) {
464 16         36 my $s = shift(@sets);
465 64         66 $i = $i->intersection($s);
466 64         58 }
467 64         93 if ($i->size == 1) {
468 64         71 my ($id) = $i->elements;
469 64         118 return $id;
470 64         2486 } else {
471 64         109 return -1;
472             }
473             }
474 16         21  
475 64 50       138  
476 0         0 =item C<< plans_for_algebra >>
477              
478             The store implements a cost-based query planner, but this method is
479 16         31 reimplemented to hand the overall control of the planning process to
480 16         31 an external planner by returning C<undef>.
481 48         9688  
482 48         90 =cut
483              
484 16 50       4809 my $self = shift;
485 16         83 my $algebra = shift;
486 16         84 return;
487             }
488 0         0  
489              
490             =item C<< cost_for_plan >>
491              
492             This store provides a cost estimate only for retrieving individual
493             quad patterns in this method. It will allow other planners to estimate
494             the cost for any other parts of the plan by returning C<undef> for
495             those parts.
496              
497             =cut
498              
499             my $self = shift;
500             my $plan = shift;
501             if ($plan->isa('Attean::Plan::Quad')) {
502 128     128 1 179 my @values = $plan->values;
503 128         155 my $count = $self->count_quads(@values);
504 128         260 return $count;
505             }
506             return;
507             }
508              
509             }
510              
511             1;
512              
513              
514             =back
515              
516             =head1 BUGS
517              
518             Please report any bugs or feature requests to through the GitHub web interface
519             at L<https://github.com/kasei/perlrdf2/issues>.
520              
521             =head1 AUTHOR
522              
523             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
524              
525             =head1 COPYRIGHT
526              
527             Copyright (c) 2014--2022 Gregory Todd Williams. This
528             program is free software; you can redistribute it and/or modify it under
529             the same terms as Perl itself.
530              
531             =cut