File Coverage

blib/lib/HTML/FormFu/Role/FormAndElementMethods.pm

Criterion	Covered	Total	%
statement	127	142	89.4
branch	35	64	54.6
condition	2	2	100.0
subroutine	19	22	86.3
pod	0	8	0.0
total	183	238	76.8

use strict;

package HTML::FormFu::Role::FormAndElementMethods;
# ABSTRACT: role for form and element methods
$HTML::FormFu::Role::FormAndElementMethods::VERSION = '2.07';
use Moose::Role;

use HTML::FormFu::Attribute qw(
    mk_attrs
    mk_attr_accessors
    mk_inherited_accessors
    mk_inherited_merging_accessors
);
use HTML::FormFu::Util qw(
    require_class
    _merge_hashes
);
use Carp qw( croak );
use Scalar::Util qw( blessed refaddr );

my @ATTRS = (qw( attributes ));

__PACKAGE__->mk_attrs(@ATTRS);

my @ATTR_ACCESSOR = (qw( title ));

__PACKAGE__->mk_attr_accessors(@ATTR_ACCESSOR);

my @INHERITED = qw(
    render_method
    config_file_path
);

__PACKAGE__->mk_inherited_accessors(@INHERITED);

my @MERGING = qw(
    tt_args
    config_callback
);

__PACKAGE__->mk_inherited_merging_accessors(@MERGING);

our @MULTIFORM_SHARED = ( @ATTRS, @ATTR_ACCESSOR, @INHERITED, @MERGING, );

sub _require_deflator {
    my ( $self, $type, $opt ) = @_;

    croak 'required arguments: $self, $type, \%options' if @_ != 3;

    eval { my %x = %$opt };
    croak "options argument must be hash-ref" if $@;

    my $class = $type;
    if ( not $class =~ s/^\+// ) {
        $class = "HTML::FormFu::Deflator::$class";
    }

    $type =~ s/^\+//;

    require_class($class);

    my $object = $class->new(
        {   type   => $type,
            parent => $self,
        } );

    # handle default_args
    my $parent = $self->parent;

    if ( exists $parent->default_args->{deflators}{$type} ) {
        $opt
            = _merge_hashes( $parent->default_args->{deflators}{$type}, $opt, );
    }

    $object->populate($opt);

    return $object;
}

sub _require_filter {
    my ( $self, $type, $opt ) = @_;

    croak 'required arguments: $self, $type, \%options' if @_ != 3;

    eval { my %x = %$opt };
    croak "options argument must be hash-ref" if $@;

    my $class = $type;
    if ( not $class =~ s/^\+// ) {
        $class = "HTML::FormFu::Filter::$class";
    }

    $type =~ s/^\+//;

    require_class($class);

    my $object = $class->new(
        {   type   => $type,
            parent => $self,
        } );

    # handle default_args
    my $parent = $self->parent;

    if ( exists $parent->default_args->{filters}{$type} ) {
        $opt = _merge_hashes( $parent->default_args->{filters}{$type}, $opt, );
    }

    $object->populate($opt);

    return $object;
}

sub _require_inflator {
    my ( $self, $type, $opt ) = @_;

    croak 'required arguments: $self, $type, \%options' if @_ != 3;

    eval { my %x = %$opt };
    croak "options argument must be hash-ref" if $@;

    my $class = $type;
    if ( not $class =~ s/^\+// ) {
        $class = "HTML::FormFu::Inflator::$class";
    }

    $type =~ s/^\+//;

    require_class($class);

    my $object = $class->new(
        {   type   => $type,
            parent => $self,
        } );

    # handle default_args
    my $parent = $self->parent;

    if ( exists $parent->default_args->{inflators}{$type} ) {
        $opt
            = _merge_hashes( $parent->default_args->{inflators}{$type}, $opt, );
    }

    $object->populate($opt);

    return $object;
}

sub _require_validator {
    my ( $self, $type, $opt ) = @_;

    croak 'required arguments: $self, $type, \%options' if @_ != 3;

    eval { my %x = %$opt };
    croak "options argument must be hash-ref" if $@;

    my $class = $type;
    if ( not $class =~ s/^\+// ) {
        $class = "HTML::FormFu::Validator::$class";
    }

    $type =~ s/^\+//;

    require_class($class);

    my $object = $class->new(
        {   type   => $type,
            parent => $self,
        } );

    # handle default_args
    my $parent = $self->parent;

    if ( exists $parent->default_args->{validators}{$type} ) {
        %$opt = ( %{ $parent->default_args->{validators}{$type} }, %$opt );
    }

    $object->populate($opt);

    return $object;
}

sub _require_transformer {
    my ( $self, $type, $opt ) = @_;

    croak 'required arguments: $self, $type, \%options' if @_ != 3;

    eval { my %x = %$opt };
    croak "options argument must be hash-ref" if $@;

    my $class = $type;
    if ( not $class =~ s/^\+// ) {
        $class = "HTML::FormFu::Transformer::$class";
    }

    $type =~ s/^\+//;

    require_class($class);

    my $object = $class->new(
        {   type   => $type,
            parent => $self,
        } );

    # handle default_args
    my $parent = $self->parent;

    if ( exists $parent->default_args->{transformers}{$type} ) {
        $opt
            = _merge_hashes( $parent->default_args->{transformers}{$type},
            $opt, );
    }

    $object->populate($opt);

    return $object;
}

sub _require_plugin {
    my ( $self, $type, $arg ) = @_;

    croak 'required arguments: $self, $type, \%options' if @_ != 3;

    eval { my %x = %$arg };
    croak "options argument must be hash-ref" if $@;

    my $abs   = $type =~ s/^\+//;
    my $class = $type;

    if ( !$abs ) {
        $class = "HTML::FormFu::Plugin::$class";
    }

    $type =~ s/^\+//;

    require_class($class);

    my $plugin = $class->new(
        {   type   => $type,
            parent => $self,
        } );

    $plugin->populate($arg);

    return $plugin;
}

sub get_deflator {
    my $self = shift;

    my $x = $self->get_deflators(@_);

    return @$x ? $x->[0] : ();
}

sub get_filter {
    my $self = shift;

    my $x = $self->get_filters(@_);

    return @$x ? $x->[0] : ();
}

sub get_constraint {
    my $self = shift;

    my $x = $self->get_constraints(@_);

    return @$x ? $x->[0] : ();
}

sub get_inflator {
    my $self = shift;

    my $x = $self->get_inflators(@_);

    return @$x ? $x->[0] : ();
}

sub get_validator {
    my $self = shift;

    my $x = $self->get_validators(@_);

    return @$x ? $x->[0] : ();
}

sub get_transformer {
    my $self = shift;

    my $x = $self->get_transformers(@_);

    return @$x ? $x->[0] : ();
}

sub get_plugin {
    my $self = shift;

    my $x = $self->get_plugins(@_);

    return @$x ? $x->[0] : ();
}

sub model_config {
    my ( $self, $config ) = @_;

    $self->{model_config} ||= {};

    $self->{model_config} = _merge_hashes( $self->{model_config}, $config );

    return $self->{model_config};
}

sub _string_equals {
    my ( $a, $b ) = @_;

    return blessed($b)
        ? ( refaddr($a) eq refaddr($b) )
        : ( "$a" eq "$b" );
}

sub _object_equals {
    my ( $a, $b ) = @_;

    return blessed($b)
        ? ( refaddr($a) eq refaddr($b) )
        : undef;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

HTML::FormFu::Role::FormAndElementMethods - role for form and element methods

=head1 VERSION

version 2.07

=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