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   2228 use strict;
  4         6  
  4         169  
2 4     4   17 use warnings;
  4         5  
  4         201  
3             package Search::GIN::Driver::Hash;
4             our $VERSION = '0.10';
5 4     4   17 use Moose::Role;
  4         6  
  4         26  
6 4     4   17977 use Set::Object;
  4         18529  
  4         171  
7 4     4   25 use Data::Stream::Bulk::Util qw(bulk);
  4         7  
  4         45  
8 4     4   858 use Scalar::Util qw(refaddr);
  4         8  
  4         169  
9 4     4   20 use namespace::autoclean;
  4         5  
  4         33  
10              
11             with qw(Search::GIN::Driver);
12              
13             has values => (
14             isa => "HashRef",
15             is => "ro",
16             default => sub { {} },
17             );
18              
19             has objects => (
20             isa => "HashRef",
21             is => "ro",
22             default => sub { {} },
23             );
24              
25             sub clear {
26 0     0 0 0 my $self = shift;
27              
28 0         0 %{ $self->values } = ();
  0         0  
29 0         0 %{ $self->objects } = ();
  0         0  
30              
31 0         0 return;
32             }
33              
34             sub fetch_entry {
35 15     15 0 24 my ( $self, $key ) = @_;
36              
37 15 50       506 if ( my $set = $self->values->{$key} ) {
38 15         143 return bulk($set->members);
39             } else {
40 0         0 return;
41             }
42             }
43              
44             sub remove_ids {
45 16     16 0 24 my ( $self, @ids ) = @_;
46              
47 16         351 my $values = $self->values;
48 16         337 my $objects = $self->objects;
49              
50 16 50       29 my @key_sets = grep { defined } delete @{$objects}{map { ref() ? refaddr($_) : $_ } @ids};
  16         33  
  16         33  
  16         65  
51 16 50       50 return unless @key_sets;
52 0         0 my $keys = (shift @key_sets)->union(@key_sets);
53              
54 0         0 foreach my $key ( $keys->members ) {
55 0         0 my $set = $values->{$key};
56 0         0 $set->remove(@ids);
57 0 0       0 delete $values->{$key} if $set->size == 0;
58             }
59             }
60              
61             sub insert_entry {
62 16     16 0 23 my ( $self, $id, @keys ) = @_;
63              
64 16         445 my $values = $self->values;
65 16         358 my $objects = $self->objects;
66              
67 16         32 $self->remove_ids($id);
68              
69 16 50       134 my $set = $objects->{ref($id) ? refaddr($id) : $id} = Set::Object->new;
70              
71 16         86 $set->insert(@keys);
72              
73 16         17 foreach my $id_set (@{$values}{@keys}) {
  16         45  
74 45   66     410 $id_set ||= Set::Object->new;
75 45         220 $id_set->insert($id);
76             }
77             }
78              
79             1;