package # hide from Pause HTML::FormHandler::Params; # ABSTRACT: params handling use Moose; use Carp; 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+) # root param | \[ (\w+) \] # nested /gx ); } # These next two regexes are the escaping aware equivalent # to the following: # my ($first, @segments) = split(/\./, $name, -1); # m// splits on unescaped '.' chars. Can't fail b/c \G on next # non ./ * -> escaped anything -> non ./ * $name =~ m/^ ( [^\\$sep]* (?: \\(?:.|$) [^\\$sep]* )* ) /gx; my $first = $1; $first =~ s/\\(.)/$1/g; # remove escaping my (@segments) = $name =~ # . -> ( non ./ * -> escaped anything -> non ./ * ) m/\G (?:[$sep]) ( [^\\$sep]* (?: \\(?:.|$) [^\\$sep]* )* ) /gx; # Escapes removed later, can be used to avoid using as array index 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; # remove escaping $$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 ) { # escape \ and separator chars (once only, at this level) 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; use namespace::autoclean; 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::FormHandler::Params - params handling =head1 VERSION version 0.40068 =head1 AUTHOR FormHandler Contributors - see HTML::FormHandler =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2017 by Gerda Shank. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut