File Coverage

blib/lib/KiokuDB/Backend/Hash.pm
Criterion Covered Total %
statement 41 41 100.0
branch 8 8 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod 0 5 0.0
total 61 66 92.4


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package KiokuDB::Backend::Hash;
4 21     21   38673 use Moose;
  21         335360  
  21         168  
5              
6 21     21   124629 use Data::Stream::Bulk::Util qw(bulk);
  21         1476814  
  21         158  
7              
8 21     21   4230 use Carp qw(croak);
  21         33  
  21         1081  
9              
10 21     21   109 use namespace::clean -except => 'meta';
  21         34  
  21         123  
11              
12             with (
13             'KiokuDB::Backend::Serialize::Delegate',
14             'KiokuDB::Backend',
15             'KiokuDB::Backend::Role::Query::Simple::Linear',
16             'KiokuDB::Backend::Role::TXN::Memory::Scan',
17             );
18              
19             has storage => (
20             isa => "HashRef",
21             is => "rw",
22             default => sub { {} },
23             );
24              
25             sub clear_storage {
26 166     166 0 368 my $self = shift;
27 166         321 %{ $self->storage } = ();
  166         4505  
28             }
29              
30             sub get_from_storage {
31 3335     3335 0 6506 my ( $self, @uids ) = @_;
32              
33 3335         88144 my $s = $self->storage;
34              
35 3335 100       5411 return if grep { not exists $s->{$_} } @uids;
  6314         16156  
36              
37 3300         4989 my @objs = map { $self->deserialize($_) } @{ $s }{@uids};
  6279         29373  
  3300         6157  
38              
39 3300 100       15589 if ( @objs == 1 ) {
40 2802         9883 return $objs[0];
41             } else {
42 498         2812 return @objs;
43             }
44             }
45              
46             sub commit_entries {
47 2050     2050 0 4721 my ( $self, @entries ) = @_;
48              
49 2050         55469 my $s = $self->storage;
50              
51 2050         20057 foreach my $entry ( @entries ) {
52 4313         131873 my $id = $entry->id;
53              
54 4313 100       100774 if ( $entry->deleted ) {
55 72         839 delete $s->{$id};
56             } else {
57 4241 100 100     35297 if ( exists $s->{$id} and not $entry->has_prev ) {
58 33         900 croak "Entry $id already exists in the database";
59             }
60 4208         13431 $s->{$id} = $self->serialize($entry);
61             }
62             }
63             }
64              
65             sub exists_in_storage {
66 509     509 0 1279 my ( $self, @uids ) = @_;
67              
68 509         805 map { exists $self->storage->{$_} } @uids;
  560         14810  
69             }
70              
71             sub all_storage_entries {
72 887     887 0 1347 my $self = shift;
73 887         1419 return bulk(map { $self->deserialize($_) } values %{ $self->storage });
  7462         41125  
  887         24706  
74             }
75              
76             __PACKAGE__->meta->make_immutable;
77              
78             __PACKAGE__
79              
80             __END__
81              
82             =pod
83              
84             =head1 NAME
85              
86             KiokuDB::Backend::Hash - In memory backend for testing purposes.
87              
88             =head1 SYNOPSIS
89              
90             my $dir = KiokuDB->new(
91             backend => KiokuDB::Backend::Hash->new(),
92             );
93              
94             =head1 DESCRIPTION
95              
96             This L<KiokuDB> backend provides in memory storage and retrieval of
97             L<KiokuDB::Entry> objects using L<Storable>'s C<dclone> to make dumps of the
98             backend clear.
99              
100             =cut