File Coverage

blib/lib/Hash/Slice.pm
Criterion Covered Total %
statement 31 34 91.1
branch 6 12 50.0
condition n/a
subroutine 7 7 100.0
pod 3 3 100.0
total 47 56 83.9


line stmt bran cond sub pod time code
1             package Hash::Slice;
2              
3 2     2   69523 use warnings;
  2         6  
  2         62  
4 2     2   12 use strict;
  2         4  
  2         122  
5              
6             =head1 NAME
7              
8             Hash::Slice - Make a hash from a deep slice of another hash
9              
10             =head1 VERSION
11              
12             Version 0.03
13              
14             =cut
15              
16             our $VERSION = '0.03';
17              
18             =head1 SYNOPSIS
19              
20             use Hash::Slice qw/slice cslice/;
21              
22             # A trivial example
23             my %hash = (a => 1, b => 2, c => 3);
24              
25             my $slice = slice \%hash, qw/a b/;
26              
27             # $slice is now { a => 1, b => 2 }
28              
29              
30             # A hairy example
31             my %hash = (a => 1, b => 2, c => { d => 3, e => 4 });
32              
33             my $slice = slice \%hash, qw/a/, [ c => qw/e/ ];
34              
35             # $slice is now { a => 1, c => { e => 4 } }
36              
37              
38             # An even hairier example
39             my %hash = (a => 1, b => 2, c => { d => 3, e => 4, f => { g => 5, h => 6, k => [ 0 .. 4 ] } }, z => 7);
40              
41             my $slice = slice \%hash, qw/a z/, [ c => qw/e/, [ f => qw/g k/ ] ];
42              
43             # $slice is now { a => 1, z => 7, c => { e => 4, f => { g => 5, k => [ 0, 1, 2, 3, 4 ] } } }
44              
45              
46             # Make a cloned-slice of %hash
47             my %hash = (a => 1, b => 2, c => { d => 3, e => 4, f => { g => 5, h => 6, k => [ 0 .. 4 ] } }, z => 7);
48              
49             my $slice = cslice \%hash, qw/a z/, [ c => qw/e/, [ f => qw/g k/ ] ];
50             $slice->{c}->{e} = "red"; # $hash{c}->{e} is still 4
51              
52             =head1 DESCRIPTION
53              
54             Hash::Slice lets you easily make a deep slice of a hash, specifically a hash containing one or more nested hashes. Instead of just taking a slice of the first level of a hash in an all-or-nothing manner, you can use slice to take a slice of the first level, then take a particular slice of the second level, and so on.
55              
56             =cut
57              
58 2     2   13 use vars qw/@ISA @EXPORT_OK/;
  2         21  
  2         162  
59             @ISA = qw/Exporter/;
60             @EXPORT_OK = qw/slice clone_slice cslice dclone_slice dcslice/;
61              
62 2     2   2129 use Carp::Clan;
  2         6470  
  2         12  
63              
64             =head1 FUNCTIONS
65              
66             =head2 $slice = slice $hash, @cut
67              
68             =head2 %slice = slice $hash, @cut
69              
70             Make a copy of $hash according to @cut.
71              
72             For each key in @cut, slice will copy the value of the key over to $slice->{$key}. If $slice encounters an ARRAY instead of a key, it will make a deep slice using the first element of ARRAY as the key and the rest of the array as the cut.
73              
74             Note, this method will not make an entry in $slice unless the key exists in $hash
75              
76             Note, unless you are making a deep cut, slice will simply copy the reference of the data being copied, and not make a clone. If you need to make a completely independent copy, use cslice or dcslice.
77              
78             =cut
79              
80             sub slice($@);
81             sub slice($@) {
82 11     11 1 27082 my $hash = shift;
83 11         28 my @cut = @_;
84              
85 11         19 my %slice;
86 11         21 for my $name (@cut) {
87 27 100       758 if (ref $name eq "ARRAY") {
    50          
88 5         10 my ($name, @cut) = @$name;
89 5 50       24 $slice{$name} = slice $hash->{$name}, @cut if exists $hash->{$name};
90             }
91             elsif (ref $name eq "HASH") {
92              
93 0         0 croak "Can't use a HASH ($name) in a slice() \@cut";
94              
95 0         0 while (my ($name, $cut) = each %$name) {
96 0 0       0 $slice{$name} = slice $hash->{$name}, $cut if exists $hash->{$name};
97             }
98             }
99             else {
100 22 50       95 $slice{$name} = $hash->{$name} if exists $hash->{$name};
101             }
102             }
103              
104 11 50       58 return wantarray ? %slice : \%slice;
105             }
106              
107             =head2 $slice = cslice $hash, @cut
108              
109             =head2 $slice = clone_slice $hash, @cut
110              
111             Make a copy of $hash according to @cut. $slice is an independent clone of $hash made using Clone::clone
112              
113             =cut
114              
115             sub clone_slice($@) {
116 1     1 1 39535 my $hash = shift;
117 1         5 my @cut = @_;
118              
119 1         13 require Clone;
120              
121 1         270 my $clone_hash = Clone::clone($hash);
122 1         10 return slice $clone_hash, @cut;
123             }
124             *cslice = \&clone_slice;
125              
126             =head2 $slice = dcslice $hash, @cut
127              
128             =head2 $slice = dclone_slice $hash, @cut
129              
130             Make a copy of $hash according to @cut. $slice is an independent clone of $hash made using Storable::dclone
131              
132             =cut
133              
134             sub dclone_slice($@) {
135 1     1 1 26027 my $hash = shift;
136 1         4 my @cut = @_;
137              
138 1         14 require Storable;
139              
140 1         131 my $dclone_hash = Storable::dclone($hash);
141 1         7 return slice $dclone_hash, @cut;
142             }
143             *dcslice = \&dclone_slice;
144              
145             =head1 AUTHOR
146              
147             Robert Krimen, C<< >>
148              
149             =head1 SOURCE
150              
151             You can contribute or fork this project via GitHub:
152              
153             L
154              
155             git clone git://github.com/robertkrimen/hash-slice.git Hash-Slice
156              
157             =head1 BUGS
158              
159             Please report any bugs or feature requests to
160             C, or through the web interface at
161             L.
162             I will be notified, and then you'll automatically be notified of progress on
163             your bug as I make changes.
164              
165             =head1 SUPPORT
166              
167             You can find documentation for this module with the perldoc command.
168              
169             perldoc Hash::Slice
170              
171             You can also look for information at:
172              
173             =over 4
174              
175             =item * AnnoCPAN: Annotated CPAN documentation
176              
177             L
178              
179             =item * CPAN Ratings
180              
181             L
182              
183             =item * RT: CPAN's request tracker
184              
185             L
186              
187             =item * Search CPAN
188              
189             L
190              
191             =back
192              
193             =head1 ACKNOWLEDGEMENTS
194              
195             =head1 COPYRIGHT & LICENSE
196              
197             Copyright 2007 Robert Krimen, all rights reserved.
198              
199             This program is free software; you can redistribute it and/or modify it
200             under the same terms as Perl itself.
201              
202             =cut
203              
204             1; # End of Hash::Slice