File Coverage

blib/lib/Search/GIN/Driver/Hash.pm
Criterion Covered Total %
statement 42 54 77.7
branch 4 10 40.0
condition 2 3 66.6
subroutine 10 11 90.9
pod 0 4 0.0
total 58 82 70.7


line stmt bran cond sub pod time code
1 4     4   2155 use strict;
  4         7  
  4         169  
2 4     4   17 use warnings;
  4         4  
  4         203  
3             package Search::GIN::Driver::Hash;
4              
5             our $VERSION = '0.11';
6              
7 4     4   17 use Moose::Role;
  4         5  
  4         26  
8 4     4   18282 use Set::Object;
  4         19076  
  4         164  
9 4     4   23 use Data::Stream::Bulk::Util qw(bulk);
  4         5  
  4         39  
10 4     4   928 use Scalar::Util qw(refaddr);
  4         6  
  4         222  
11 4     4   17 use namespace::autoclean;
  4         4  
  4         35  
12              
13             with qw(Search::GIN::Driver);
14              
15             has values => (
16             isa => "HashRef",
17             is => "ro",
18             default => sub { {} },
19             );
20              
21             has objects => (
22             isa => "HashRef",
23             is => "ro",
24             default => sub { {} },
25             );
26              
27             sub clear {
28 0     0 0 0 my $self = shift;
29              
30 0         0 %{ $self->values } = ();
  0         0  
31 0         0 %{ $self->objects } = ();
  0         0  
32              
33 0         0 return;
34             }
35              
36             sub fetch_entry {
37 15     15 0 19 my ( $self, $key ) = @_;
38              
39 15 50       395 if ( my $set = $self->values->{$key} ) {
40 15         114 return bulk($set->members);
41             } else {
42 0         0 return;
43             }
44             }
45              
46             sub remove_ids {
47 16     16 0 23 my ( $self, @ids ) = @_;
48              
49 16         349 my $values = $self->values;
50 16         343 my $objects = $self->objects;
51              
52 16 50       28 my @key_sets = grep { defined } delete @{$objects}{map { ref() ? refaddr($_) : $_ } @ids};
  16         38  
  16         33  
  16         65  
53 16 50       45 return unless @key_sets;
54 0         0 my $keys = (shift @key_sets)->union(@key_sets);
55              
56 0         0 foreach my $key ( $keys->members ) {
57 0         0 my $set = $values->{$key};
58 0         0 $set->remove(@ids);
59 0 0       0 delete $values->{$key} if $set->size == 0;
60             }
61             }
62              
63             sub insert_entry {
64 16     16 0 24 my ( $self, $id, @keys ) = @_;
65              
66 16         433 my $values = $self->values;
67 16         378 my $objects = $self->objects;
68              
69 16         36 $self->remove_ids($id);
70              
71 16 50       144 my $set = $objects->{ref($id) ? refaddr($id) : $id} = Set::Object->new;
72              
73 16         84 $set->insert(@keys);
74              
75 16         18 foreach my $id_set (@{$values}{@keys}) {
  16         78  
76 45   66     413 $id_set ||= Set::Object->new;
77 45         232 $id_set->insert($id);
78             }
79             }
80              
81             1;