File Coverage

blib/lib/Hash/Rename.pm
Criterion Covered Total %
statement 26 26 100.0
branch 11 12 91.6
condition 8 8 100.0
subroutine 4 4 100.0
pod 1 1 100.0
total 50 51 98.0


line stmt bran cond sub pod time code
1             package Hash::Rename;
2 1     1   572 use strict;
  1         2  
  1         30  
3 1     1   5 use warnings;
  1         2  
  1         26  
4 1     1   4 use Exporter qw(import);
  1         5  
  1         358  
5             our $VERSION = '2.00';
6             our @EXPORT = ('hash_rename');
7              
8             sub hash_rename (\%@) {
9 8     8 1 16376 my ($hash, %args) = @_;
10 8         12 my %new_hash;
11 8         38 for my $key (sort keys %$hash) {
12 21         22 my $orig_key = $key;
13 21 100       55 $key = $args{prepend} . $key if defined $args{prepend};
14 21 100       51 $key = $key . $args{append} if defined $args{append};
15 21 100       41 if (defined $args{code}) {
16 8 50       20 ref $args{code} eq 'CODE'
17             || die "'code' value is not a CODE reference";
18 8         10 local $_ = $key;
19 8         19 $args{code}->();
20 8         29 $key = $_;
21             }
22 21 100 100     66 die "duplicate result key [$key] from original key [$orig_key]\n"
23             if defined($args{strict}) && exists $new_hash{$key};
24              
25             # apply 'recurse' option, if given
26 20         27 my $val = $hash->{$orig_key};
27 20 100 100     67 if ($args{recurse} && (ref($val) || '') eq 'HASH') {
      100        
28              
29             # suppress "called too early to check prototype ..." warning
30 1         9 &hash_rename($val, %args);
31             }
32 20         55 $new_hash{$key} = $val;
33             }
34 7         44 %$hash = %new_hash;
35             }
36             1;
37              
38             =pod
39              
40             =head1 NAME
41              
42             Hash::Rename - Rename hash keys
43              
44             =head1 SYNOPSIS
45              
46             use Hash::Rename;
47              
48             my %hash = (
49             '-noforce' => 1,
50             scheme => 'http'
51             );
52             hash_rename %hash, code => sub { s/^(?!-)/-/ };
53              
54             =head1 DESCRIPTION
55              
56             Using this module you can rename a hash's keys in place.
57              
58             =head1 FUNCTIONS
59              
60             =head2 hash_rename
61              
62             This function is automatically exported. It takes a hash to rename and another
63             hash of instructions on how to rename they keys.
64              
65             The syntax is like this:
66              
67             hash_rename %hash, instruction1 => 'value1', instruction2 => 'value2';
68              
69             The following instructions are supported:
70              
71             =over 4
72              
73             =item C
74              
75             hash_rename %hash, prepend => '-';
76              
77             The given value is prepended to each hash key.
78              
79             =item C
80              
81             hash_rename %hash, append => '-';
82              
83             The given value is appended to each hash key.
84              
85             =item C
86              
87             hash_rename %hash, code => sub { s/^(?!-)/-/ };
88              
89             Each hash key is localized to C<$_> and subjected to the code. Its new value
90             is the result of C<$_> after the code has been executed.
91              
92             =item C
93              
94             If present and set to a true value, the resulting keys are checked for
95             duplicates. C will die if it detects a duplicate resulting hash
96             key. They keys of the hash to change are processed in alphabetical order.
97              
98             =item C
99              
100             Each hash value that is itself a hash reference is renamed with the same
101             arguments as the original hash.
102              
103             =back
104              
105             If several instructions are given, they are processed in the order in which
106             they are described above. So you can have:
107              
108             hash_rename %hash, prepend => '-', append => '=';
109              
110             =head1 AUTHOR
111              
112             The following person is the author of all the files provided in this
113             distribution unless explicitly noted otherwise.
114              
115             Marcel Gruenauer , L
116              
117             =head1 CONTRIBUTORS
118              
119             Masayuki Matsuki (@songmu) added the C option.
120              
121             =head1 COPYRIGHT AND LICENSE
122              
123             The following copyright notice applies to all the files provided in this
124             distribution, including binary files, unless explicitly noted otherwise.
125              
126             This software is copyright (c) 2014 by Marcel Gruenauer.
127              
128             This is free software; you can redistribute it and/or modify it under the same
129             terms as the Perl 5 programming language system itself.