File Coverage

blib/lib/Build/Hopen/Scope/Hash.pm
Criterion Covered Total %
statement 32 37 86.4
branch 5 16 31.2
condition 1 3 33.3
subroutine 9 10 90.0
pod 2 2 100.0
total 49 68 72.0


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   2932 use Build::Hopen::Base;
  10         19  
  10         57  
4              
5             our $VERSION = '0.000006'; # TRIAL
6              
7 10     10   1829 use parent 'Build::Hopen::Scope';
  10         16  
  10         62  
8             use Class::Tiny {
9 20         166 _content => sub { +{} }, # Our storage
10 10     10   567 };
  10         17  
  10         92  
11              
12             #use Build::Hopen::Util::Data qw(clone);
13 10     10   2076 use Build::Hopen::Arrrgs;
  10         48  
  10         389  
14 10     10   51 use Set::Scalar;
  10         16  
  10         3723  
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 75     75   131 my $set = shift;
70 75 50 33     141 return false if defined($set) && $set ne '0';
71 75         155 return true;
72             } #_set0()
73              
74             =head1 FUNCTIONS TO BE OVERRIDDEN IN SUBCLASSES
75              
76             To implement a Scope with a different data-storage model than the hash
77             this class uses, subclass Scope and override these functions. Only L
78             is part of the public API.
79              
80             =head2 add
81              
82             Add key-value pairs to this scope. Returns the scope so you can
83             chain. Example usage:
84              
85             my $scope = Build::Hopen::Scope::Hash->new()->add(foo => 1);
86              
87             C is responsible for handling any conflicts that may occur. In this
88             particular implementation, the last-added value for a particular key wins.
89              
90             TODO add $set option
91              
92             =cut
93              
94             sub add {
95 11 50   11 1 4621 my $self = shift or croak 'Need an instance';
96 11 50       38 croak "Got an odd number of parameters" if @_%2;
97 11         36 my %new = @_;
98 11         29 @{$self->_content}{keys %new} = values %new;
  11         220  
99 11         34 return $self;
100             } #add()
101              
102             =head2 adopt_hash
103              
104             Takes over the given hash to be the new contents of the Scope::Hash.
105             Usage example:
106              
107             $scope->adopt_hash({ foo => 42 });
108              
109             The scope uses exactly the hash passed, not a clone of it. If this is not
110             applicable to a subclass, that subclass should override it as C<...> or an
111             express C.
112              
113             =cut
114              
115             sub adopt_hash {
116 0 0   0 1 0 my $self = shift or croak 'Need an instance';
117 0 0       0 my $hrNew = shift or croak 'Need a hash to adopt';
118 0 0       0 croak 'Cannot adopt a non-hash' unless ref $hrNew eq 'HASH';
119 0         0 $self->_content($hrNew);
120 0         0 return $self;
121             } #adopt_hash()
122              
123             =head2 _names_here
124              
125             Populates a L with the names of the items stored in this Scope,
126             but B any outer Scope. Called as:
127              
128             $scope->_names_here($retval[, $set]);
129              
130             No return value.
131              
132             =cut
133              
134             sub _names_here {
135 40     40   108 my ($self, %args) = parameters('self', [qw(retval ; set)], @_);
136 40 50       122 _set0 $args{set} or croak 'I only support set 0';
137 40         72 $args{retval}->insert(keys %{$self->_content});
  40         708  
138             } #_names_here()
139              
140             =head2 _find_here
141              
142             Looks for a given item in this scope, but B any outer scope. Called as:
143              
144             $scope->_find_here($name[, $set])
145              
146             Returns the value, or C if not found.
147              
148             =cut
149              
150             sub _find_here {
151 35     35   93 my ($self, %args) = parameters('self', [qw(name ; set)], @_);
152 35 50       89 _set0 $args{set} or croak 'I only support set 0';
153              
154 35         595 return $self->_content->{$args{name}};
155             } #_find_here()
156              
157             1;
158             __END__