File Coverage

blib/lib/HTML/FormFu/Inflator/CompoundDateTime.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	8	14	57.1
condition	2	5	40.0
subroutine	12	12	100.0
pod	0	1	0.0
total	77	88	87.5

use strict;

package HTML::FormFu::Inflator::CompoundDateTime;
$HTML::FormFu::Inflator::CompoundDateTime::VERSION = '2.07';
# ABSTRACT: CompoundDateTime inflator

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

use HTML::FormFu::Constants qw( $EMPTY_STR );
use DateTime;
use DateTime::Format::Strptime;
use List::Util 1.33 qw( none );
use Scalar::Util qw( reftype );
use Carp qw( croak );

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

my @known_fields = qw( year month day hour minute second nanosecond time_zone );

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

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

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

    if ( defined( my $order = $self->field_order ) ) {
        for my $order (@$order) {
            croak "unknown DateTime field_order name"
                if none { $order eq $_ } @known_fields;

            my $field = shift @fields;
            my $name  = $field->name;

            $input{$order} = $value->{$name};
        }
    }
    else {
        for my $name ( keys %$value ) {
            croak "unknown DateTime field name"
                if none { $name eq $_ } @known_fields;
        }

        %input = %$value;
    }

    my $dt;

    eval { $dt = DateTime->new(%input) };

    return $value if $@;

    if ( defined $self->strptime ) {
        my $strptime = $self->strptime;
        my %args;

        if ( ( reftype($strptime) || '' ) eq 'HASH' ) {
            %args = %$strptime;
        }
        else {
            %args = ( pattern => $strptime );
        }

        my $formatter = DateTime::Format::Strptime->new(%args);

        $dt->set_formatter($formatter);
    }

    return $dt;
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

HTML::FormFu::Inflator::CompoundDateTime - CompoundDateTime inflator

=head1 VERSION

version 2.07

=head1 SYNOPSIS

    ---
    element:
      - type: Multi
        name: date

        elements:
          - name: day
          - name: month
          - name: year

        inflator:
          - type: CompoundDateTime

    # get the submitted value as a DateTime object

    my $date = $form->param_value('date');

=head1 DESCRIPTION

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

Changes the input from several fields into a single L<DateTime> value.

By default, expects the field names to be any of the following:

=over

=item year

=item month

=item day

=item hour

=item minute

=item second

=item nanosecond

=item time_zone

=back

=head1 METHODS

=head2 field_order

Arguments: \@order

If your field names doesn't follow the convention listed above, you must
provide an arrayref containing the above names, in the order they correspond
with your own fields.

    ---
    element:
      - type: Multi
        name: date

        elements:
          - name: m
          - name: d
          - name: y

        inflator:
          - type: CompoundDateTime
            field_order:
              - month
              - day
              - year

=head2 strptime

Arguments: \%args

Arguments: $string

Optional. Define the format that should be used if the L<DateTime> object is
stringified.

Accepts a hashref of arguments to be passed to
L<DateTime::Format::Strptime/new>. Alternatively, accepts a single string
argument, suitable for passing to
C<< DateTime::Format::Strptime->new( pattern => $string ) >>.

    ---
    inflator:
      - type: CompoundDateTime
        strptime:
          pattern: '%d-%b-%Y'
          locale: de

    ---
    inflator:
      - type: CompoundDateTime
        strptime: '%d-%m-%Y'

=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