view release on metacpan or  search on metacpan

lib/Data/MuForm/Field.pm  view on Meta::CPAN

package Data::MuForm::Field;
# ABSTRACT: Base field package
use Moo;
use Types::Standard -types;
use Try::Tiny;
use Scalar::Util ('blessed', 'weaken');
use Data::Clone ('data_clone');
use Data::MuForm::Localizer;
use Data::MuForm::Merge ('merge');
with 'Data::MuForm::Common';

has 'name' => ( is => 'rw', required => 1 );
has 'id' => ( is => 'rw', lazy => 1, builder => 'build_id' );
sub build_id {
   my $self = shift;
   if ( my $meth = $self->get_method('build_id') ) {
       return $meth->($self, @_);
   }
   elsif ( $self->form && $self->form->can('build_field_id') ) {
       return $self->form->build_field_id($self);
   }
   return $self->prefixed_name;
}
has 'prefixed_name' => ( is => 'rw', lazy => 1, builder => 'build_prefixed_name');
sub build_prefixed_name {
    my $self = shift;
    my $prefix = ( $self->form && $self->form->field_prefix ) ? $self->field_prefix. "." : '';
    return $prefix . $self->full_name;
}
has 'form' => ( is => 'rw', weak_ref => 1, predicate => 'has_form' );
has 'type' => ( is => 'ro', required => 1, default => 'Text' );
has 'default' => ( is => 'rw' );
has 'input' => ( is => 'rw', predicate => 'has_input', clearer => 'clear_input' );
has 'input_without_param' => ( is => 'rw', predicate => 'has_input_without_param' );
has 'value' => ( is => 'rw', predicate => 'has_value', clearer => 'clear_value' );
has 'init_value' => ( is => 'rw', predicate => 'has_init_value', clearer => 'clear_init_value' );
has 'no_value_if_empty' => ( is => 'rw' );
has 'input_param' => ( is => 'rw' );
has 'filled_from' => ( is => 'rw', clearer => 'clear_filled_from' );
has 'password' => ( is => 'rw', default => 0 );
has 'accessor' => ( is => 'rw', lazy => 1, builder => 'build_accessor' );
sub build_accessor {
    my $self     = shift;
    my $accessor = $self->name;
    $accessor =~ s/^(.*)\.//g if ( $accessor =~ /\./ );
    return $accessor;
}
has 'custom' => ( is => 'rw' );
has 'parent' => ( is  => 'rw',   predicate => 'has_parent', weak_ref => 1 );
has 'source' => ( is => 'rw' );
has 'errors' => ( is => 'rw', isa => ArrayRef, default => sub {[]} );
sub has_errors { my $self = shift; return scalar @{$self->errors}; }
sub all_errors { my $self = shift; return @{$self->errors}; }
sub clear_errors { $_[0]->{errors} = [] }
sub clear_error_fields { }

# this is a permanent setting of active
has 'active' => ( is => 'rw', default => 1 );
# this is a temporary active set on the process call, cleared on clear_data
has '_active' => ( is => 'rw', predicate => '_has_active', clearer => '_clear_active' );
sub clear_inactive { $_[0]->active(1) }
sub inactive { return ( shift->active ? 0 : 1 ) }
sub is_active {
    my $self = shift;
    return $self->_active if $self->_has_active;
    return $self->active;
}
sub multiple { }
sub is_inactive { ! $_[0]->is_active }
has 'disabled' => ( is => 'rw', default => 0 );
has 'no_update' => ( is => 'rw', default => 0 );
has 'writeonly' => ( is => 'rw', default => 0 );
has 'is_contains' => ( is => 'rw' );
has 'apply' => ( is => 'rw', default => sub {[]} ); # for field defnitions
sub has_apply { return scalar @{$_[0]->{apply}} }
has 'base_apply' => ( is => 'rw', builder => 'build_base_apply' ); # for field classes
sub build_base_apply {[]}
sub has_base_apply { return scalar @{$_[0]->{base_apply}} }
has 'trim' => ( is => 'rw', default => sub { *default_trim } );
sub default_trim {
    my $value = shift;
    return unless defined $value;
    my @values = ref $value eq 'ARRAY' ? @$value : ($value);
    for (@values) {
        next if ref $_ or !defined;
        s/^\s+//;
        s/\s+$//;
    }
    return ref $value eq 'ARRAY' ? \@values : $values[0];
}
sub has_fields { } # compound fields will override
has 'methods' => ( is => 'rw', isa => HashRef, builder => 'build_methods', trigger => 1 );
sub build_methods {{}}
sub _trigger_methods {
    my ( $self, $new_methods ) = @_;
    my $base_methods = $self->build_methods;
    my $methods = merge($new_methods, $base_methods);
    $self->{methods} = $methods;

}
sub get_method {
   my ( $self, $meth_name ) = @_;
   return  $self->{methods}->{$meth_name};
}

has 'validate_when_empty' => ( is => 'rw' );
has 'not_nullable' => ( is => 'rw' );
sub is_repeatable {}
sub is_compound {}
sub is_form {0}
sub no_fif {0}

around BUILDARGS => sub {
  my ( $orig, $class, %field_attr ) = @_;

  munge_field_attr(\%field_attr);

  return $class->$orig(%field_attr);
};


sub BUILD {
    my $self = shift;

    if ( $self->form ) {
        # To avoid memory cycles it needs to be weakened when
        # it's set through a form.
        weaken($self->{localizer});
        weaken($self->{renderer});
    }
    else {
        # Vivify. This would generally only happen in a standalone field, in tests.
        $self->localizer;
        $self->renderer;
    }

    $self->_install_methods;
}

sub _install_methods {
    my $self = shift;

    if ( $self->form ) {
        my $suffix = $self->convert_full_name($self->full_name);
        foreach my $prefix ( 'validate', 'default' ) {
            next if exists $self->methods->{$prefix};
            my $meth_name = "${prefix}_$suffix";
            if ( my $meth = $self->form->can($meth_name) ) {
                my $wrap_sub = sub {
                    my $self = shift;
                    return $self->form->$meth($self);
                };
                $self->{methods}->{$prefix} = $wrap_sub;
            }
        }
    }
}


sub fif {
    my $self = shift;
    return unless $self->is_active;
    return '' if $self->password;
    return $self->input if $self->has_input;
    if ( $self->has_value ) {
      my $value = $self->value;
      $value = $self->transform_value_to_fif->($self, $value) if $self->has_transform_value_to_fif;
      return $value;
    }
    return '';
}


sub full_name {
    my $field = shift;

    my $name = $field->name;
    my $parent_name;
    # field should always have a parent unless it's a standalone field test
    if ( $field->parent ) {
        $parent_name = $field->parent->full_name;
    }
    return $name unless defined $parent_name && length $parent_name;
    return $parent_name . '.' . $name;
}

sub full_accessor {
    my $field = shift;