File Coverage

blib/lib/Data/Perl/Role/Collection/Hash.pm
Criterion Covered Total %
statement 70 70 100.0
branch 16 22 72.7
condition n/a
subroutine 21 21 100.0
pod 15 15 100.0
total 122 128 95.3


line stmt bran cond sub pod time code
1             package Data::Perl::Role::Collection::Hash;
2             $Data::Perl::Role::Collection::Hash::VERSION = '0.002011';
3             # ABSTRACT: Wrapping class for Perl's built in hash structure.
4              
5 9     9   4227 use strictures 1;
  9         56  
  9         362  
6              
7 9     9   762 use Role::Tiny;
  9         18  
  9         52  
8 9     9   1326 use Scalar::Util qw/blessed/;
  9         27  
  9         489  
9 9     9   4700 use Module::Runtime qw/use_package_optimistically/;
  9         16046  
  9         57  
10              
11 17     17 1 132 sub new { my $cl = shift; bless({ @_ }, $cl) }
  17         102  
12              
13 13     13   46 sub _array_class { 'Data::Perl::Collection::Array' }
14              
15             sub get {
16 2     2 1 5 my $self = shift;
17              
18 2 100       9 if (@_ > 1) {
19 1         3 my @res = @{$self}{@_};
  1         4  
20              
21 1 50       7 blessed($self) ? use_package_optimistically($self->_array_class)->new(@res) : @res;
22             }
23             else {
24 1         7 $self->{$_[0]};
25             }
26             }
27              
28             sub set {
29 5     5 1 1190 my $self = shift;
30 5         15 my @keys_idx = grep { ! ($_ % 2) } 0..$#_;
  18         41  
31 5         12 my @values_idx = grep { $_ % 2 } 0..$#_;
  18         29  
32              
33 5         12 @{$self}{@_[@keys_idx]} = @_[@values_idx];
  5         13  
34              
35 5         10 my @res = @{$self}{@_[@keys_idx]};
  5         11  
36              
37 5 50       28 blessed($self) ? use_package_optimistically($self->_array_class)->new(@res) : @res;
38             }
39              
40             sub delete {
41 3     3 1 38 my $self = shift;
42 3         8 my @res = CORE::delete @{$self}{@_};
  3         13  
43              
44 3 50       18 blessed($self) ? use_package_optimistically($self->_array_class)->new(@res) : @res;
45             }
46              
47             sub keys {
48 5     5 1 22 my ($self) = @_;
49              
50 5         8 my @res = keys %{$self};
  5         21  
51              
52 5 50       36 blessed($self) ? use_package_optimistically($self->_array_class)->new(@res) : @res;
53             }
54              
55 3     3 1 22 sub exists { CORE::exists $_[0]->{$_[1]} }
56              
57 2     2 1 15 sub defined { CORE::defined $_[0]->{$_[1]} }
58              
59             sub values {
60 1     1 1 8 my ($self) = @_;
61              
62 1         3 my @res = CORE::values %{$_[0]};
  1         5  
63              
64 1 50       9 blessed($self) ? use_package_optimistically($self->_array_class)->new(@res) : @res;
65             }
66              
67             sub kv {
68 2     2 1 10 my ($self) = @_;
69              
70 2         4 my @res = CORE::map { [ $_, $self->{$_} ] } CORE::keys %{$self};
  4         14  
  2         7  
71              
72 2 50       13 blessed($self) ? use_package_optimistically($self->_array_class)->new(@res) : @res;
73             }
74              
75              
76             {
77 9     9   5377 no warnings 'once';
  9         24  
  9         2897  
78              
79             sub all {
80 1     1 1 3 my ($self) = @_;
81              
82 1         3 my @res = CORE::map { $_, $self->{$_} } CORE::keys %{$self};
  2         6  
  1         4  
83              
84 1         13 @res;
85             }
86              
87             *elements = *all;
88             }
89              
90 1     1 1 8 sub clear { %{$_[0]} = () }
  1         4  
91              
92 2     2 1 1165 sub count { CORE::scalar CORE::keys %{$_[0]} }
  2         14  
93              
94 2 100   2 1 4 sub is_empty { CORE::scalar CORE::keys %{$_[0]} ? 0 : 1 }
  2         16  
95              
96             sub accessor {
97 5 100   5 1 31 if (@_ == 2) {
    100          
98 2         11 $_[0]->{$_[1]};
99             }
100             elsif (@_ > 2) {
101 2         15 $_[0]->{$_[1]} = $_[2];
102             }
103             }
104              
105 2 100   2 1 14 sub shallow_clone { blessed($_[0]) ? bless({%{$_[0]}}, ref $_[0]) : {%{$_[0]}} }
  1         6  
  1         6  
106              
107             1;
108              
109             =pod
110              
111             =encoding UTF-8
112              
113             =head1 NAME
114              
115             Data::Perl::Role::Collection::Hash - Wrapping class for Perl's built in hash structure.
116              
117             =head1 VERSION
118              
119             version 0.002011
120              
121             =head1 SYNOPSIS
122              
123             use Data::Perl qw/hash/;
124              
125             my $hash = hash(a => 1, b => 2);
126              
127             $hash->values; # (1, 2)
128              
129             $hash->set('foo', 'bar'); # (a => 1, b => 2, foo => 'bar')
130              
131             =head1 DESCRIPTION
132              
133             This class provides a wrapper and methods for interacting with a hash.
134             All methods that return a list do so via a Data::Perl::Collection::Array
135             object.
136              
137             =head1 PROVIDED METHODS
138              
139             =over 4
140              
141             =item B
142              
143             Given an optional list of keys/values, constructs a new Data::Perl::Collection::Hash
144             object initalized with keys/values and returns it.
145              
146             =item B
147              
148             Returns a list of values in the hash for the given keys.
149              
150             This method requires at least one argument.
151              
152             =item B $value, $key2 =E $value2...)>
153              
154             Sets the elements in the hash to the given values. It returns the new values
155             set for each key, in the same order as the keys passed to the method.
156              
157             This method requires at least two arguments, and expects an even number of
158             arguments.
159              
160             =item B
161              
162             Removes the elements with the given keys.
163              
164             Returns a list of values in the hash for the deleted keys.
165              
166             =item B
167              
168             Returns the list of keys in the hash.
169              
170             This method does not accept any arguments.
171              
172             =item B
173              
174             Returns true if the given key is present in the hash.
175              
176             This method requires a single argument.
177              
178             =item B
179              
180             Returns true if the value of a given key is defined.
181              
182             This method requires a single argument.
183              
184             =item B
185              
186             Returns the list of values in the hash.
187              
188             This method does not accept any arguments.
189              
190             =item B
191              
192             Returns the key/value pairs in the hash as an array of array references.
193              
194             for my $pair ( $object->option_pairs ) {
195             print "$pair->[0] = $pair->[1]\n";
196             }
197              
198             This method does not accept any arguments.
199              
200             =item B
201              
202             Returns the key/value pairs in the hash as a flattened list..
203              
204             This method does not accept any arguments.
205              
206             =item B
207              
208             Resets the hash to an empty value, like C<%hash = ()>.
209              
210             This method does not accept any arguments.
211              
212             =item B
213              
214             Returns the number of elements in the hash. Also useful for not empty:
215             C<< has_options => 'count' >>.
216              
217             This method does not accept any arguments.
218              
219             =item B
220              
221             If the hash is populated, returns false. Otherwise, returns true.
222              
223             This method does not accept any arguments.
224              
225             =item B
226              
227             =item B
228              
229             If passed one argument, returns the value of the specified key. If passed two
230             arguments, sets the value of the specified key.
231              
232             When called as a setter, this method returns the value that was set.
233              
234             =item B
235              
236             This method returns a shallow clone of the hash reference. The return value
237             is a reference to a new hash with the same keys and values. It is I
238             because any values that were references in the original will be the I
239             references in the clone.
240              
241             =item B<_array_class>
242              
243             The name of the class which returned lists are instances of; i.e.
244             C<< Data::Perl::Collection::Array >>.
245              
246             Subclasses of this class can override this method.
247              
248             =back
249              
250             Note that C is deliberately omitted, due to its stateful interaction
251             with the hash iterator. C or C are much safer.
252              
253             =head1 SEE ALSO
254              
255             =over 4
256              
257             =item * L
258              
259             =item * L
260              
261             =back
262              
263             =head1 AUTHOR
264              
265             Matthew Phillips
266              
267             =head1 COPYRIGHT AND LICENSE
268              
269             This software is copyright (c) 2020 by Matthew Phillips .
270              
271             This is free software; you can redistribute it and/or modify it under
272             the same terms as the Perl 5 programming language system itself.
273              
274             =cut
275              
276             __END__