package
HTML::FormHandler::Params;
has
'separator'
=> (
isa
=>
'Str'
,
is
=>
'rw'
,
default
=>
'.'
);
sub
split_name {
my
(
$self
,
$name
,
$sep
) =
@_
;
$sep
||=
$self
->separator;
$sep
=
"\Q$sep"
;
if
(
$sep
eq
'[]'
) {
return
grep
{
defined
} (
$name
=~ /
^ (\w+)
| \[ (\w+) \]
/gx
);
}
$name
=~ m/^ ( [^\\
$sep
]* (?: \\(?:.|$) [^\\
$sep
]* )* ) /gx;
my
$first
= $1;
$first
=~ s/\\(.)/$1/g;
my
(
@segments
) =
$name
=~
m/\G (?:[
$sep
]) ( [^\\
$sep
]* (?: \\(?:.|$) [^\\
$sep
]* )* ) /gx;
return
(
$first
,
@segments
);
}
sub
expand_hash {
my
(
$self
,
$flat
,
$sep
) =
@_
;
my
$deep
= {};
$sep
||=
$self
->separator;
for
my
$name
(
keys
%$flat
) {
my
(
$first
,
@segments
) =
$self
->split_name(
$name
,
$sep
);
my
$box_ref
= \
$deep
->{
$first
};
for
(
@segments
) {
if
( /^(0|[1-9]\d*)$/ ) {
$$box_ref
= []
unless
defined
$$box_ref
;
croak
"HFH: param clash for $name=$_"
unless
ref
$$box_ref
eq
'ARRAY'
;
$box_ref
= \(
$$box_ref
->[$1] );
}
else
{
s/\\(.)/$1/g
if
$sep
;
$$box_ref
= {}
unless
defined
$$box_ref
;
$$box_ref
= {
''
=>
$$box_ref
}
if
( !
ref
$$box_ref
);
croak
"HFH: param clash for $name=$_"
unless
ref
$$box_ref
eq
'HASH'
;
$box_ref
= \(
$$box_ref
->{
$_
} );
}
}
if
(
defined
$$box_ref
) {
croak
"HFH: param clash for $name value $flat->{$name}"
if
ref
$$box_ref
ne
'HASH'
;
$box_ref
= \(
$$box_ref
->{
''
} );
}
$$box_ref
=
$flat
->{
$name
};
}
return
$deep
;
}
sub
collapse_hash {
my
$self
=
shift
;
my
$deep
=
shift
;
my
$flat
= {};
$self
->_collapse_hash(
$deep
,
$flat
, () );
return
$flat
;
}
sub
join_name {
my
(
$self
,
@array
) =
@_
;
my
$sep
=
substr
(
$self
->separator, 0, 1 );
return
join
$sep
,
@array
;
}
sub
_collapse_hash {
my
(
$self
,
$deep
,
$flat
,
@segments
) =
@_
;
if
( !
ref
$deep
) {
my
$name
=
$self
->join_name(
@segments
);
$flat
->{
$name
} =
$deep
;
}
elsif
(
ref
$deep
eq
'HASH'
) {
for
(
keys
%$deep
) {
my
$name
=
$_
;
if
(
defined
(
my
$sep
=
$self
->separator ) ) {
$sep
=
"\Q$sep"
;
$name
=~ s/([\\
$sep
])/\\$1/g;
}
$self
->_collapse_hash(
$deep
->{
$_
},
$flat
,
@segments
,
$name
);
}
}
elsif
(
ref
$deep
eq
'ARRAY'
) {
for
( 0 ..
$#$deep
) {
$self
->_collapse_hash(
$deep
->[
$_
],
$flat
,
@segments
,
$_
)
if
defined
$deep
->[
$_
];
}
}
else
{
croak
"Unknown reference type for "
,
$self
->join_name(
@segments
),
":"
,
ref
$deep
;
}
}
__PACKAGE__->meta->make_immutable;
1;