File Coverage

blib/lib/Form/Processor/Field.pm

Criterion	Covered	Total	%
statement	119	162	73.4
branch	55	82	67.0
condition	20	33	60.6
subroutine	29	40	72.5
pod	19	34	55.8
total	242	351	68.9

package Form::Processor::Field;
$Form::Processor::Field::VERSION = '1.162360';
use strict;
use warnings;
use base 'Rose::Object';
use Form::Processor::I18N;    # only needed if running without a form object.
use Scalar::Util;





use Rose::Object::MakeMethods::Generic (
    scalar => [
        'name',               # Field's name
        'init_value',         # initial value populated by init_from_object - used to look for changes
                              # not to be confused with the form method init_value().
        'value',              # scalar internal value -- same as init_value at start.
        'input',              # input value from parameter
        'temp',               # Temporary storage for fields to save validated data - DEPRECATED -- not really needed.
        'type',               # field type (e.g. 'Text', 'Select' ... )
        'label',              # Text label -- not really used much, yet.
        'style',              # Field's generic style to use for css formatting
                              #'form',         # The parent form (defined below)
        'sub_form',           # The field is made up of a sub-form.
                              # This is a more generic field type that can be used
                              # in template to determine what type of html widget to generate
        widget           => { interface => 'get_set_init' },
        order            => { interface => 'get_set_init' },
        required_message => { interface => 'get_set_init' },

        # Allow ragne checks -- done after validation so
        # must only be used on appropriate fields
        # These really should be defined in a subclass that only deals
        # with numbers.
        range_start => { interface => 'get_set_init' },
        range_end   => { interface => 'get_set_init' },

        value_format => { interface => 'get_set_init' },    # sprintf format to use when converting input to value

        # Often the fields need a unique id for js, so many a
        # handy way to get this.
        id => { interface => 'get_set_init' },

        max_size => { interface => 'get_set_init' },

    ],

    boolean => [

        # These should probably be 'get_set' here and then 'get_set_init' any
        # place that needs to define an initial value.
        password  => { interface => 'get_set_init' },    # don't return field in $form->fif
        required  => { interface => 'get_set_init' },    # field is requried
        writeonly => { interface => 'get_set_init' },    # don't call format_value on this field
        clear     => { interface => 'get_set_init' },    # don't validate and remove from database

        # disabled and readonly mirror the html form specification
        # disabled fields are not suppose to be "successful" and thus
        # should not be updated.  But.. see "noupdate" below.
        disabled => { interface => 'get_set_init' } .    # Don't update this field in the database.

            # readonly fields are basically like hidden fields that the UI
            # should no be able to modify but still are submitted.
            readonly => { interface => 'get_set_init' },    # Flag to indicate readonly field

        # Since disabled and readonly effect the UI differently
        # use a separate flag to tell the model to not update a field.
        noupdate => { interface => 'get_set_init' },        # don't update this field in the database

        must_submit => { interface => 'get_set' }           # override use_existing_values
    ],

    array => [
        errors        => {},
        reset_errors  => { interface => 'reset', hash_key => 'errors' },
        add_error_str => { interface => 'push', hash_key => 'errors' },
    ],
);


## Should $value be overridden to only return a value if there are not
#  any errors?

# ABSTRACT: Base class for Fields used with Form::Processor



sub init {
    my $self = shift;

    $self->SUPER::init( @_ );

    die "Need to supply name parameter"
        unless $self->name;
}


sub full_name {
    my $field = shift;

    my $name   = $field->name;
    my $form   = $field->form || return $name;
    my $parent = $form->parent_field || return $name;
    return $parent->name . '.' . $name;
}


sub form {
    my $self = shift;
    return Scalar::Util::weaken( $self->{form} = shift ) if ( @_ );
    return $self->{form};
}


sub init_id {
    my $field = shift;
    my $form_name = $field->form ? $field->form->name : 'fld-';
    return $field->form->name . $field->name
}


sub init_widget {'text'}


sub init_order {1}


sub set_order {
    my $field = shift;
    my $form  = $field->form;
    my $order = $form->field_counter || 1;
    $field->order( $order );
    $form->field_counter( $order + 1 );
}


sub init_required {0}


sub add_error {
    my $self = shift;

    my $form = $self->form;

    my $lh;

    # By default errors get attached to the field where they happen.
    my $error_field = $self;

    # Running without a form object?
    if ( $form ) {
        $lh = $form->language_handle;

        # If we are a sub-form then redirect errors to the parent field
        $error_field = $form->parent_field if $form->parent_field;
    }
    else {
        $lh = $Form::Processor::LANGUAGE_HANDLE || $ENV{LANGUAGE_HANDLE} || Form::Processor::I18N->get_handle ||
            die "Failed call to Text::Maketext->get_handle";
    }

    $self->add_error_str( $lh->maketext( @_ ) );

    return;

}


sub init_max_size {10_000}    # sanity check



sub init_range_start {return}
sub init_range_end   {return}


sub validate_field {
    my $field = shift;

    $field->reset_errors;
    $field->value( undef );


    # See if anything was submitted
    unless ( $field->any_input ) {
        $field->add_error( $field->required_message )
            if $field->required;

        return !$field->required;
    }

    return unless $field->test_multiple;
    return unless $field->test_options;


    # Check for max length new .20.
    if ( my $size = $field->max_size ) {

        my $value = $field->input;

        if ( length( $value ) > $size ) {
            $field->add_error( 'Please limit to [quant,_1,character]. You submitted [_2]', $size, length $value );
            return;
        }
    }


    return unless $field->validate;
    return unless $field->test_ranges;


    # Now move data from input -> value
    $field->input_to_value;

    return $field->validate_value unless $field->has_error;

    return;
}


sub validate {1}


sub validate_value {1}


sub init_value_format {return}


sub input_to_value {
    my $field = shift;

    return if defined $field->value;    # already set by validate method.

    my $format = $field->value_format;

    if ( $format ) {
        $field->value( sprintf( $format, $field->input ) );
    }

    else {
        $field->value( $field->input );
    }
}


sub test_ranges {
    my $field = shift;
    return 1 if $field->can( 'options' ) || $field->has_error;

    my $input = $field->input;


    return 1 unless defined $input;

    my $low  = $field->range_start;
    my $high = $field->range_end;

    if ( defined $low && defined $high ) {
        return $input >= $low && $input <= $high
            ? 1
            : $field->add_error( 'value must be between [_1] and [_2]', $low, $high );
    }

    if ( defined $low ) {
        return $input >= $low
            ? 1
            : $field->add_error( 'value must be greater than or equal to [_1]', $low );
    }

    if ( defined $high ) {
        return $input <= $high
            ? 1
            : $field->add_error( 'value must be less than or equal to [_1]', $high );
    }

    return 1;
}





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

    return unless defined $value;

    my @values = ref $value eq 'ARRAY' ? @$value : ( $value );

    for ( @values ) {
        next if ref $_;
        s/^\s+//;
        s/\s+$//;
    }

    return @values > 1 ? \@values : $values[0];
}


sub init_required_message {'This field is required'}


sub test_multiple {
    my ( $self ) = @_;

    my $value = $self->input;

    if ( ref $value eq 'ARRAY' && !( $self->can( 'multiple' ) && $self->multiple ) ) {
        $self->add_error( 'This field does not take multiple values' );
        return;
    }

    return 1;
}


sub any_input {
    my ( $self ) = @_;


    my $found;

    my $value = $self->input;

    # check for one value as defined
    return grep {/\S/} @$value
        if ref $value eq 'ARRAY';

    return defined $value && $value =~ /\S/;
}


sub test_options {
    my ( $self ) = @_;

    return 1 unless $self->can( 'options' );

    # create a lookup hash
    my %options = map { $_->{value} => 1 } $self->options;

    my $input = $self->input;

    return 1 unless defined $input;    # nothing to check

    for my $value ( ref $input eq 'ARRAY' ? @$input : ( $input ) ) {
        unless ( $options{$value} ) {
            $self->add_error( "'[_1]' is not a valid value", $value );
            return;
        }
    }

    return 1;
}



sub format_value {
    my $self  = shift;
    my $value = $self->value;
    return defined $value ? ( $self->name, $value ) : ();
}


sub init_noupdate {0}


sub init_disabled {0}
sub init_readonly {0}


sub init_clear {0}


sub init_writeonly {0}



sub init_password {0}


sub value_changed {
    my ( $self ) = @_;

    my @cmp;

    for ( qw/ init_value value / ) {
        my $val = $self->$_;
        $val = '' unless defined $val;

        push @cmp, join '|',
            sort
            map {
            ref( $_ ) && $_->isa( 'DateTime' )
                ? $_->iso8601
                : "$_"
            } ref( $val ) eq 'ARRAY' ? @$val : $val;

    }

    return $cmp[0] ne $cmp[1];
}


sub required_text { shift->required ? 'required' : 'optional' }


sub has_error {
    my $self   = shift;
    my $errors = $self->errors;
    return unless $errors;
    return scalar @$errors;
}





sub dump {
    my $f = shift;
    require Data::Dumper;
    warn "\n---------- [ ", $f->name, " ] ---------------\n";
    warn "Field Type: ", ref( $f ), "\n";
    warn "Required: ", ( $f->required || '0' ), "\n";
    warn "Password: ", ( $f->password || '0' ), "\n";
    my $v = $f->value;
    warn "Value: ", Data::Dumper::Dumper $v;
    my $iv = $f->init_value;
    warn "InitValue: ", Data::Dumper::Dumper $iv;
    my $i = $f->input;
    warn "Input: ", Data::Dumper::Dumper $i;

    if ( $f->can( 'options' ) ) {
        my $o = $f->options;
        warn "Options: " . Data::Dumper::Dumper $o;
    }
}






1;

__END__