File Coverage

blib/lib/HTML/FormFu/Role/NestedHashUtils.pm
Criterion Covered Total %
statement 45 77 58.4
branch 22 56 39.2
condition 7 9 77.7
subroutine 7 8 87.5
pod 0 4 0.0
total 81 154 52.6


line stmt bran cond sub pod time code
1             package HTML::FormFu::Role::NestedHashUtils;
2              
3 401     401   182386 use strict;
  401         544  
  401         15479  
4             our $VERSION = '2.05'; # VERSION
5              
6 401     401   1547 use Moose::Role;
  401         453  
  401         2671  
7              
8 401     401   1343619 use HTML::FormFu::Util qw( split_name );
  401         559  
  401         17193  
9 401     401   1579 use Carp qw( croak );
  401         461  
  401         296280  
10              
11             sub get_nested_hash_value {
12 3412     3412 0 4071 my ( $self, $param, $name ) = @_;
13              
14 3412         6388 my ( $root, @names ) = split_name($name);
15              
16 3412 100       6881 if ( !@names ) {
17 2769 100       8010 return exists $param->{$root} ? $param->{$root} : undef;
18             }
19              
20 643         870 my $ref = \$param->{$root};
21              
22 643         1179 for (@names) {
23 669 50       1445 if (/^(0|[1-9][0-9]*)\z/) {
24 0 0       0 croak "nested param clash for ARRAY $root"
25             if ref $$ref ne 'ARRAY';
26              
27 0 0       0 return if $1 > $#{$$ref};
  0         0  
28              
29 0         0 $ref = \( $$ref->[$1] );
30             }
31             else {
32 669 100 100     3226 return if ref $$ref ne 'HASH' || !exists $$ref->{$_};
33              
34 623         919 $ref = \( $$ref->{$_} );
35             }
36             }
37              
38 597         1343 return $$ref;
39             }
40              
41             sub set_nested_hash_value {
42 1692     1692 0 2166 my ( $self, $param, $name, $value ) = @_;
43              
44 1692         3394 my ( $root, @names ) = split_name($name);
45              
46 1692 100       3149 if ( !@names ) {
47 1203         3355 return $param->{$root} = $value;
48             }
49              
50 489         682 my $ref = \$param->{$root};
51              
52 489         652 for (@names) {
53 526 50       1449 if (/^(0|[1-9][0-9]*)\z/) {
54 0 0       0 $$ref = [] if !defined $$ref;
55              
56 0 0       0 croak "nested param clash for ARRAY $name"
57             if ref $$ref ne 'ARRAY';
58              
59 0         0 $ref = \( $$ref->[$1] );
60             }
61             else {
62 526 100       1010 $$ref = {} if !defined $$ref;
63              
64 526 50       1330 croak "nested param clash for HASH $name"
65             if ref $$ref ne 'HASH';
66              
67 526         1022 $ref = \( $$ref->{$_} );
68             }
69             }
70              
71 489         1461 $$ref = $value;
72             }
73              
74             sub delete_nested_hash_key {
75 0     0 0 0 my ( $self, $param, $name ) = @_;
76              
77 0         0 my ( $root, @names ) = split_name($name);
78              
79 0 0       0 if ( !@names ) {
80 0         0 delete $param->{$root};
81 0         0 return;
82             }
83              
84 0         0 my $ref = \$param->{$root};
85              
86 0         0 for my $i ( 0 .. $#names ) {
87 0         0 my $name = $names[$i];
88              
89 0 0       0 if ( $name =~ /^(0|[1-9][0-9]*)\z/ ) {
90 0 0       0 return if !defined $$ref;
91              
92 0 0       0 croak "nested param clash for ARRAY $name"
93             if ref $$ref ne 'ARRAY';
94              
95 0         0 $ref = \( $$ref->[$1] );
96              
97 0 0       0 if ( $i == $#names ) {
98 0         0 croak "can't delete hash key for an array";
99             }
100             }
101             else {
102 0 0       0 return if !defined $$ref;
103              
104 0 0       0 croak "nested param clash for HASH $name"
105             if ref $$ref ne 'HASH';
106              
107 0 0       0 if ( $i == $#names ) {
108 0         0 delete $$ref->{$name};
109             }
110             else {
111 0         0 $ref = \( $$ref->{$name} );
112             }
113             }
114             }
115              
116 0         0 return;
117             }
118              
119             sub nested_hash_key_exists {
120 3305     3305 0 4069 my ( $self, $param, $name ) = @_;
121              
122 3305         7080 my ( $root, @names ) = split_name($name);
123              
124 3305 100       5919 if ( !@names ) {
125 2659   33     15548 return ( defined($root) && exists( $param->{$root} ) );
126             }
127              
128 646         899 my $ref = \$param->{$root};
129              
130 646         1667 for my $i ( 0 .. $#names ) {
131 674         704 my $part = $names[$i];
132              
133 674 50       1575 if ( $part =~ /^(0|[1-9][0-9]*)\z/ ) {
134 0 0       0 croak "nested param clash for ARRAY $root"
135             if ref $$ref ne 'ARRAY';
136              
137 0 0       0 if ( $i == $#names ) {
138 0 0       0 return $1 > $$ref->[$1] ? 1 : 0;
139             }
140              
141 0         0 $ref = \( $$ref->[$1] );
142             }
143             else {
144 674 100       1187 if ( $i == $#names ) {
145 646 100 100     2950 return if !ref $$ref || ref($$ref) ne 'HASH';
146              
147 562 100       3051 return exists $$ref->{$part} ? 1 : 0;
148             }
149              
150 28         55 $ref = \( $$ref->{$part} );
151             }
152             }
153              
154 0           return;
155             }
156              
157             1;