File Coverage

blib/lib/qbit/Hash.pm
Criterion Covered Total %
statement 15 23 65.2
branch 0 6 0.0
condition 0 3 0.0
subroutine 5 7 71.4
pod 2 2 100.0
total 22 41 53.6


line stmt bran cond sub pod time code
1             =head1 Name
2              
3             qbit::Hash - Functions to manipulate hashes.
4              
5             =cut
6              
7             package qbit::Hash;
8             $qbit::Hash::VERSION = '2.3';
9 8     8   39 use strict;
  8         8  
  8         260  
10 8     8   34 use warnings;
  8         11  
  8         216  
11 8     8   33 use utf8;
  8         9  
  8         36  
12 8     8   201 use base qw(Exporter);
  8         10  
  8         998  
13              
14             BEGIN {
15 8     8   10 our (@EXPORT, @EXPORT_OK);
16              
17 8         21 @EXPORT = qw(
18             hash_transform push_hs
19             );
20 8         1787 @EXPORT_OK = @EXPORT;
21             }
22              
23              
24              
25             =head1 Functions
26              
27             =head2 hash_transform
28              
29             B
30              
31             =over
32              
33             =item
34              
35             B<$hs> - hash ref, original hash;
36              
37             =item
38              
39             B<$arr> - array ref, keys to copy;
40              
41             =item
42              
43             B<$transform_hs> - hash ref, new keys names.
44              
45             =back
46              
47             B hash with new keys names.
48              
49             my %new_hash = hash_transform(
50             {
51             a => 1,
52             b => 2,
53             c => 3,
54             d => 4
55             },
56             [qw(a c)],
57             {
58             d => 'e'
59             }
60             );
61              
62             Result:
63             %new_hash = (
64             a => 1,
65             c => 3,
66             e => 4
67             )
68              
69             =cut
70              
71             sub hash_transform($$;$) {
72 0     0 1   my ($hs, $arr, $transform_hs) = @_;
73              
74 0 0 0       return map {$transform_hs ? $transform_hs->{$_} || $_ : $_ => $hs->{$_}}
75 0           grep {exists $hs->{$_}} @$arr, keys %$transform_hs;
  0            
76             }
77              
78              
79              
80             =head2 push_hs
81              
82             B
83              
84             =over
85              
86             =item
87              
88             B<$h1|%h1> - hash or hash ref, first hash;
89              
90             =item
91              
92             B<$h2|%h2> - hash or hash ref, second hash.
93              
94             =back
95              
96             Merge second hash into first.
97              
98             =cut
99              
100             sub push_hs(\[$%]@) {
101 0     0 1   my ($h1, @args) = @_;
102              
103 0 0         $h1 = $$h1 if ref($h1) eq 'REF';
104 0 0         my $h2 = @args == 1 ? $args[0] : {@args};
105              
106 0           @$h1{keys(%$h2)} = values(%$h2);
107             }
108              
109             1;