—

              
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__
HideShow 25 lines of Pod
=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 <cpan@fireartist.com>
=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