File Coverage

blib/lib/Hash/DefHash/Normalize.pm
Criterion Covered Total %
statement 28 28 100.0
branch 11 12 91.6
condition 9 10 90.0
subroutine 4 4 100.0
pod 1 1 100.0
total 53 55 96.3


line stmt bran cond sub pod time code
1             package Hash::DefHash::Normalize;
2              
3             our $DATE = '2015-09-06'; # DATE
4             our $VERSION = '0.03'; # VERSION
5              
6 1     1   734 use 5.010001;
  1         3  
7 1     1   4 use strict;
  1         2  
  1         17  
8 1     1   4 use warnings;
  1         1  
  1         345  
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(
13             normalize_defhash
14             );
15              
16             sub normalize_defhash($;$) {
17 6     6 1 71 my ($dh, $opts) = @_;
18              
19 6   100     25 $opts //= {};
20 6   100     23 $opts->{remove_internal_properties} //= 0;
21              
22 6         8 my $opt_rip = $opts->{remove_internal_properties};
23              
24 6         9 my $ndh = {};
25              
26             KEY:
27 6         18 for my $k (keys %$dh) {
28 13 100       79 die "Invalid prop/attr syntax '$k', must be word/dotted-word only"
29             unless $k =~ /\A(\w+)(?:\.(\w+(?:\.\w+)*))?(?:\((\w+)\))?\z/;
30              
31 11         11 my ($prop, $attr);
32 11 100       25 if (defined $3) {
33 1         4 $prop = $1;
34 1 50       5 $attr = defined($2) ? "$2.alt.lang.$3" : "alt.lang.$3";
35             } else {
36 10         14 $prop = $1;
37 10         19 $attr = $2;
38             }
39              
40 11 100       26 my $nk = "$prop" . (defined($attr) ? ".$attr" : "");
41              
42             # strip property/attr started with _
43 11 100 100     57 if ($prop =~ /\A_/ || defined($attr) && $attr =~ /\A_|\._/) {
      66        
44 4 100       8 unless ($opt_rip) {
45 2         5 $ndh->{$nk} = $dh->{$k};
46             }
47 4         7 next KEY;
48             }
49              
50 7         16 $ndh->{$nk} = $dh->{$k};
51             }
52              
53 4         31 $ndh;
54             }
55              
56             1;
57             # ABSTRACT: Normalize DefHash
58              
59             __END__