File Coverage

blib/lib/HTML/FormFu/Deflator/CompoundSplit.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	11	12	91.6
condition	2	3	66.6
subroutine	5	5	100.0
pod	0	1	0.0
total	54	57	94.7

use strict;

package HTML::FormFu::Deflator::CompoundSplit;
$HTML::FormFu::Deflator::CompoundSplit::VERSION = '2.07';
# ABSTRACT: CompoundSplit deflator

use Moose;
use MooseX::Attribute::Chained;
extends 'HTML::FormFu::Deflator';

use HTML::FormFu::Constants qw( $EMPTY_STR $SPACE );

has split       => ( is => 'rw', traits => ['Chained'] );
has join        => ( is => 'rw', traits => ['Chained'] );
has field_order => ( is => 'rw', traits => ['Chained'] );

sub deflator {
    my ( $self, $value ) = @_;

    return if !defined $value || $value eq $EMPTY_STR;

    my ( $multi, @fields ) = @{ $self->parent->get_fields };

    my $split
        = defined $self->split
        ? $self->split
        : qr/$SPACE+/;

    my $join
        = defined $self->join
        ? $self->join
        : $SPACE;

    my @parts = CORE::split $split, $value;

    if ( my $order = $self->field_order ) {
        my @new_order;

    FIELD:
        for my $i (@$order) {
            for my $field (@fields) {
                if ( $field->name eq $i ) {
                    push @new_order, $field;
                    next FIELD;
                }
            }
        }

        @fields = @new_order;
    }

    my %value;

    for my $i ( 0 .. $#fields ) {

        # if there are more parts than fields, join the extra ones
        # to make the final field's value

        if ( $i == $#fields ) {
            my $default = CORE::join $join, @parts[ $i .. $#parts ];

            $fields[$i]->default($default);

            $value{ $fields[$i]->name } = $default;
        }
        else {
            $fields[$i]->default( $parts[$i] );

            $value{ $fields[$i]->name } = $parts[$i];
        }
    }

    return \%value;
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

HTML::FormFu::Deflator::CompoundSplit - CompoundSplit deflator

=head1 VERSION

version 2.07

=head1 SYNOPSIS

    ---
    element:
      - type: Multi
        name: address

        elements:
          - name: number
          - name: street

        deflator:
          - type: CompoundSplit

    # set the default

    $form->get_field('address')->default( $address );

=head1 DESCRIPTION

Deflator to allow you to set several field's values at once.

For use with a L<HTML::FormFu::Element::Multi> group of fields.

A L<default|HTML::FormFu::Role::Element::Field/default> value passed to the
L<Multi|HTML::FormFu::Element::Multi> field will be split according to the
L</split> setting, and its resulting parts passed to its child elements.

=head1 METHODS

=head2 split

Arguments: $regex

Default Value: C<qr/ +/>

Regex used to split the default value. Defaults to a regex matching 1 or more
space characters.

=head2 join

Arguments: $string

Default Value: C<' '>

If splitting the value results in more parts than there are fields, any extra
parts are joined again to form the value for the last field. The value of
L</join> is used to join these values.

Defaults to a single space.

For example, if the Multi element contains fields C<number> and C<name>,
and is given the value C<10 Downing Street>; when split this results in 3
parts: C<10>, C<Downing> and C<Street>. In this case, the 1st part, C<10> is
assigned to the first field, and the 2nd and 3rd parts are re-joined with a
space to give the single value C<Downing Street>, which is assigned to the
2nd field.

=head2 field_order

Arguments: \@order

If the parts from the split value should be assigned to the fields in a
different order, you must provide an arrayref containing the names, in the
order they should be assigned to.

    ---
    element:
      - type: Multi
        name: address

        elements:
          - name: street
          - name: number

        deflator:
          - type: CompoundSplit
            field_order:
              - number
              - street

=head1 AUTHOR

Carl Franks

=head1 LICENSE

This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 AUTHOR

Carl Franks <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Carl Franks.

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