File Coverage

blib/lib/Build/Hopen/Scope/Hash.pm
Criterion Covered Total %
statement 35 40 87.5
branch 8 20 40.0
condition 3 8 37.5
subroutine 9 10 90.0
pod 2 2 100.0
total 57 80 71.2


line stmt bran cond sub pod time code
1             # Build::Hopen::Scope::Hash - a hash-based nested key-value store based
2             package Build::Hopen::Scope::Hash;
3 10     10   16685 use Build::Hopen::Base;
  10         31  
  10         73  
4              
5             our $VERSION = '0.000008'; # TRIAL
6              
7 10     10   2314 use parent 'Build::Hopen::Scope';
  10         22  
  10         66  
8             use Class::Tiny {
9 21         242 _content => sub { +{} }, # Our storage
10 10     10   701 };
  10         21  
  10         133  
11              
12             #use Build::Hopen::Util::Data qw(clone);
13 10     10   2545 use Build::Hopen::Arrrgs;
  10         22  
  10         518  
14 10     10   62 use Set::Scalar;
  10         22  
  10         4946  
15             #use Sub::ScopeFinalizer qw(scope_finalizer);
16              
17              
18             # Docs {{{1
19              
20             =head1 NAME
21              
22             Build::Hopen::Scope::Hash - a hash-based nested key-value store
23              
24             =head1 SYNOPSIS
25              
26             This class implements L using a single hash table as the
27             storage. It only supports one set of data (L),
28             which is named C<0>.
29              
30             =head1 ATTRIBUTES
31              
32             =head2 outer
33              
34             The fallback C for looking up names not found in this C.
35             If non is provided, it is C, and no fallback will happen.
36              
37             =head2 name
38              
39             Not used, but provided so you can use L to make Scopes.
40              
41             =head1 METHODS
42              
43             See also L, below, which is part of the public API.
44              
45             Several of the functions receive a C<$levels> parameter. Its meaning is:
46              
47             =over
48              
49             =item *
50              
51             If C<$levels> is provided and nonzero, go up that many more levels
52             (i.e., C<$levels==0> means only return this scope's local names).
53              
54             =item *
55             If C<$levels> is not provided or not defined, go all the way to the
56             outermost Scope.
57              
58             =back
59              
60             =cut
61              
62             # }}}1
63              
64             # Don't support -set, but permit `-set=>0` for the sake of code calling
65             # through the Scope interface. Call as `_set0($set)`.
66             # Returns truthy of OK, falsy if not.
67             # Better a readily-obvious crash than a subtle bug!
68             sub _set0 {
69 127   50 127   616 $_[0] //= 0; # Give the caller a default set
70 127         211 my $set = shift;
71 127 50 33     452 return false if defined($set) && $set ne '0' && $set ne '*';
      33        
72 127         319 return true;
73             } #_set0()
74              
75             =head1 FUNCTIONS TO BE OVERRIDDEN IN SUBCLASSES
76              
77             To implement a Scope with a different data-storage model than the hash
78             this class uses, subclass Scope and override these functions. Only L
79             is part of the public API.
80              
81             =head2 add
82              
83             Add key-value pairs to this scope. Returns the scope so you can
84             chain. Example usage:
85              
86             my $scope = Build::Hopen::Scope::Hash->new()->add(foo => 1);
87              
88             C is responsible for handling any conflicts that may occur. In this
89             particular implementation, the last-added value for a particular key wins.
90              
91             TODO add $set option
92              
93             =cut
94              
95             sub add {
96 13 50   13 1 6751 my $self = shift or croak 'Need an instance';
97 13 50       51 croak "Got an odd number of parameters" if @_%2;
98 13         43 my %new = @_;
99 13         41 @{$self->_content}{keys %new} = values %new;
  13         315  
100 13         45 return $self;
101             } #add()
102              
103             =head2 adopt_hash
104              
105             Takes over the given hash to be the new contents of the Scope::Hash.
106             Usage example:
107              
108             $scope->adopt_hash({ foo => 42 });
109              
110             The scope uses exactly the hash passed, not a clone of it. If this is not
111             applicable to a subclass, that subclass should override it as C<...> or an
112             express C.
113              
114             =cut
115              
116             sub adopt_hash {
117 0 0   0 1 0 my $self = shift or croak 'Need an instance';
118 0 0       0 my $hrNew = shift or croak 'Need a hash to adopt';
119 0 0       0 croak 'Cannot adopt a non-hash' unless ref $hrNew eq 'HASH';
120 0         0 $self->_content($hrNew);
121 0         0 return $self;
122             } #adopt_hash()
123              
124             =head2 _names_here
125              
126             Populates a L with the names of the items stored in this Scope,
127             but B any outer Scope. Called as:
128              
129             $scope->_names_here($retval[, $set]);
130              
131             No return value.
132              
133             =cut
134              
135             sub _names_here {
136 50     50   160 my ($self, %args) = parameters('self', [qw(retval ; set)], @_);
137 50 50       183 _set0 $args{set} or croak 'I only support set 0';
138 50         121 $args{retval}->insert(keys %{$self->_content});
  50         1112  
139             } #_names_here()
140              
141             =head2 _find_here
142              
143             Looks for a given item in this scope, but B any outer scope. Called as:
144              
145             $scope->_find_here($name[, $set])
146              
147             Returns the value, or C if not found.
148              
149             =cut
150              
151             sub _find_here {
152 77     77   250 my ($self, %args) = parameters('self', [qw(name ; set)], @_);
153 77 50       196 _set0 $args{set} or croak 'I only support set 0';
154              
155 77         1654 my $val = $self->_content->{$args{name}};
156 77 100       544 return undef unless defined $val;
157 33 50       166 return ($args{set} eq '*') ? { 0 => $val } : $val;
158             } #_find_here()
159              
160             1;
161             __END__