File Coverage

blib/lib/Data/Hive/Store/Hash.pm
Criterion Covered Total %
statement 37 37 100.0
branch 6 8 75.0
condition 1 3 33.3
subroutine 12 12 100.0
pod 9 9 100.0
total 65 69 94.2


line stmt bran cond sub pod time code
1 4     4   2486 use strict;
  4         8  
  4         129  
2 4     4   19 use warnings;
  4         6  
  4         144  
3             package Data::Hive::Store::Hash 1.015;
4             # ABSTRACT: store a hive in a flat hashref
5              
6 4     4   753 use parent 'Data::Hive::Store';
  4         521  
  4         26  
7              
8             #pod =head1 DESCRIPTION
9             #pod
10             #pod This is a simple store, primarily for testing, that will store hives in a flat
11             #pod hashref. Paths are packed into strings and used as keys. The structure does
12             #pod not recurse -- for that, see L.
13             #pod
14             #pod So, we could do this:
15             #pod
16             #pod my $href = {};
17             #pod
18             #pod my $hive = Data::Hive->NEW({
19             #pod store_class => 'Hash',
20             #pod store_args => [ $href ],
21             #pod });
22             #pod
23             #pod $hive->foo->SET(1);
24             #pod $hive->foo->bar->baz->SET(2);
25             #pod
26             #pod We would end up with C<$href> containing something like:
27             #pod
28             #pod {
29             #pod foo => 1,
30             #pod 'foo.bar.baz' => 2
31             #pod }
32             #pod
33             #pod =method new
34             #pod
35             #pod my $store = Data::Hive::Store::Hash->new(\%hash, \%arg);
36             #pod
37             #pod The only argument expected for C is a hashref, which is the hashref in
38             #pod which hive entries are stored.
39             #pod
40             #pod If no hashref is provided, a new, empty hashref will be used.
41             #pod
42             #pod The extra arguments may include:
43             #pod
44             #pod =for :list
45             #pod = path_packer
46             #pod A L-like object used to convert between paths
47             #pod (arrayrefs) and hash keys.
48             #pod
49             #pod =cut
50              
51             sub new {
52 15     15 1 457 my ($class, $href, $arg) = @_;
53 15 50       41 $href = {} unless $href;
54 15 50       34 $arg = {} unless $arg;
55              
56             my $guts = {
57             store => $href,
58 15   33     42 path_packer => $arg->{path_packer} || do {
59             require Data::Hive::PathPacker::Strict;
60             Data::Hive::PathPacker::Strict->new;
61             },
62             };
63              
64 15         15269 return bless $guts => $class;
65             }
66              
67             #pod =method hash_store
68             #pod
69             #pod This method returns the hashref in which things are being used. You should not
70             #pod alter its contents!
71             #pod
72             #pod =cut
73              
74 123     123 1 310 sub hash_store { $_[0]->{store} }
75 235     235 1 428 sub path_packer { $_[0]->{path_packer} }
76              
77             sub get {
78 32     32 1 47 my ($self, $path) = @_;
79 32         54 return $self->hash_store->{ $self->name($path) };
80             }
81              
82             sub set {
83 30     30 1 55 my ($self, $path, $value) = @_;
84 30         55 $self->hash_store->{ $self->name($path) } = $value;
85             }
86              
87             sub name {
88 96     96 1 138 my ($self, $path) = @_;
89 96         135 $self->path_packer->pack_path($path);
90             }
91              
92             sub exists {
93 28     28 1 42 my ($self, $path) = @_;
94 28         42 exists $self->hash_store->{ $self->name($path) };
95             }
96              
97             sub delete {
98 6     6 1 9 my ($self, $path) = @_;
99              
100 6         13 delete $self->hash_store->{ $self->name($path) };
101             }
102              
103             sub keys {
104 18     18 1 24 my ($self, $path) = @_;
105              
106 18         24 my @names = keys %{ $self->hash_store };
  18         31  
107              
108 18         24 my %is_key;
109              
110 18         30 PATH: for my $name (@names) {
111 139         195 my $this_path = $self->path_packer->unpack_path($name);
112              
113 139 100       291 next unless @$this_path > @$path;
114              
115 57         91 for my $i (0 .. $#$path) {
116 71 100       141 next PATH unless $this_path->[$i] eq $path->[$i];
117             }
118              
119 27         72 $is_key{ $this_path->[ $#$path + 1 ] } = 1;
120             }
121              
122 18         95 return keys %is_key;
123             }
124              
125             1;
126              
127             __END__