File Coverage

blib/lib/KiokuDB/Backend/Hash.pm
Criterion Covered Total %
statement 2 4 50.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 4 6 66.6


line stmt bran cond sub pod time code
1             package KiokuDB::Backend::Hash;
2             BEGIN {
3 1     1   23138 $KiokuDB::Backend::Hash::AUTHORITY = 'cpan:NUFFIN';
4             }
5             $KiokuDB::Backend::Hash::VERSION = '0.57';
6 1     1   1879 use Moose;
  0            
  0            
7             # ABSTRACT: In memory backend for testing purposes.
8              
9             use Data::Stream::Bulk::Util qw(bulk);
10              
11             use Carp qw(croak);
12              
13             use namespace::clean -except => 'meta';
14              
15             with (
16             'KiokuDB::Backend::Serialize::Delegate',
17             'KiokuDB::Backend',
18             'KiokuDB::Backend::Role::Query::Simple::Linear',
19             'KiokuDB::Backend::Role::TXN::Memory::Scan',
20             );
21              
22             has storage => (
23             isa => "HashRef",
24             is => "rw",
25             default => sub { {} },
26             );
27              
28             sub clear_storage {
29             my $self = shift;
30             %{ $self->storage } = ();
31             }
32              
33             sub get_from_storage {
34             my ( $self, @uids ) = @_;
35              
36             my $s = $self->storage;
37              
38             return if grep { not exists $s->{$_} } @uids;
39              
40             my @objs = map { $self->deserialize($_) } @{ $s }{@uids};
41              
42             if ( @objs == 1 ) {
43             return $objs[0];
44             } else {
45             return @objs;
46             }
47             }
48              
49             sub commit_entries {
50             my ( $self, @entries ) = @_;
51              
52             my $s = $self->storage;
53              
54             foreach my $entry ( @entries ) {
55             my $id = $entry->id;
56              
57             if ( $entry->deleted ) {
58             delete $s->{$id};
59             } else {
60             if ( exists $s->{$id} and not $entry->has_prev ) {
61             croak "Entry $id already exists in the database";
62             }
63             $s->{$id} = $self->serialize($entry);
64             }
65             }
66             }
67              
68             sub exists_in_storage {
69             my ( $self, @uids ) = @_;
70              
71             map { exists $self->storage->{$_} } @uids;
72             }
73              
74             sub all_storage_entries {
75             my $self = shift;
76             return bulk(map { $self->deserialize($_) } values %{ $self->storage });
77             }
78              
79             __PACKAGE__->meta->make_immutable;
80              
81             __PACKAGE__
82              
83             __END__
84              
85             =pod
86              
87             =encoding UTF-8
88              
89             =head1 NAME
90              
91             KiokuDB::Backend::Hash - In memory backend for testing purposes.
92              
93             =head1 VERSION
94              
95             version 0.57
96              
97             =head1 SYNOPSIS
98              
99             my $dir = KiokuDB->new(
100             backend => KiokuDB::Backend::Hash->new(),
101             );
102              
103             =head1 DESCRIPTION
104              
105             This L<KiokuDB> backend provides in memory storage and retrieval of
106             L<KiokuDB::Entry> objects using L<Storable>'s C<dclone> to make dumps of the
107             backend clear.
108              
109             =head1 AUTHOR
110              
111             Yuval Kogman <nothingmuch@woobling.org>
112              
113             =head1 COPYRIGHT AND LICENSE
114              
115             This software is copyright (c) 2014 by Yuval Kogman, Infinity Interactive.
116              
117             This is free software; you can redistribute it and/or modify it under
118             the same terms as the Perl 5 programming language system itself.
119              
120             =cut