The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Form::Processor::Field;
{
  $Form::Processor::Field::VERSION = '1.122970';
}
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 = $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__
=pod

=head1 NAME

Form::Processor::Field - Base class for Fields used with Form::Processor

=head1 VERSION

version 1.122970

=head1 SYNOPSIS

    # Used from another class
    use base 'Form::Processor::Field::Text';
    my $field = Form::Processor::Field::Text->new( name => $name );

=head1 DESCRIPTION

This is a base class that allows basic functionality for form fields.
Form fields inherit from this class and thus may have additional methods.
See the documentation or source for the individual fields.

Look at the L<validate_field> method for how individual fields are validated.

You are encouraged to create specific fields for your application instead of
simply using the fields included with Form::Processor.

=head1 METHODS

=over 4

=item new [parameters]

Create a new instance of a field.  Any initial values may be passed in
as a list of parameters.

=item must_submit

This boolean value defaults to false.

When true AND when the form's attribute "use_existing_values" is
set then this field will not default to any existing value.

This provides a way to selectively disable "use_existing_values"
on a per-field basis.

This has no effect if "use_existing_values" is false on the form.

=item full_name

This returns the name of the field, but if the field
is a child field will prepend the field with the parent's field
name.  For example, if a field is "month" and the parent's field name
is "birthday" then this will return "birthday.month".

=item form

This is a reference to the parent form object.
It's stored weakened references.

=item sub_form

A single field can be represented by more than one sub-fields
contained in a form.  This is a reference to that form.

=item id

Returns an id for the field, which is by default:

    $field->form->name . $field->id

A field may override with "init_id".

=item init_widget

This is the generic type of widget that could be used
to generate, say, the HTML markup for the field.
It's similar to the field's type(), but less specific since fields
of different types often use the same widget type.

For example, a Text field would have both the type and widget values
of "Text", where an Integer field would have "Integer" for the type
value and "Text" as the widget value.

Normally you do not need to set this in a field class as it should pick
it up from the base field class used for the specific field.

The basic types are:

    Type        : Example fields
    ------------:-----------------------------------
    text        : Text, Integer, Single field dates
    checkbox    : Checkbox
    radio       : Boolean (yes,no), OneToTen
    select      : Select, Multiple
    textarea    : HtmlArea
    compound    : A field made up of other fields

Note that a Select could be a drop down list or a radio group,
and that might be determined in the template code based on how
many select options there are.

Multiple select fields, likewise, might be an option list or
a group of checkboxes.

The default type is 'text'.

=item order

This is the field's order used for sorting errors and field lists.

=item set_order

This sets the field's order to the form's field_counter
and increments the counter.

The purpose of this is when displaying fields, say in a template,
this can be called with displaying the field to set its order.
Then a summary of error messages can be displayed in the order
the fields are on the form.

=item value

Sets or returns the internal value of the field.

The "validate" field method must set this value if the field validates.

=item required

Sets or returns the required flag on the field

=item errors

returns the error (or list of errors if more than one was set)

=item add_error

Add an error to the list of errors.  If $field->form
is defined then process error message as Maketext input.
See $form->language_handle for details.

Returns undef.  This allows:

    return $field->add_error( 'bad data' ) if $bad;

=item max_size

This can be used to specify a max length of a field.
Defaults to 10,000 characters.

Added in .20 as a sanity check.

=item min_length

If set "Text"-based fields must be this many charactres long to validate.
Default is zero.

=item range_start
=item range_end

Fields can have a start range and an end range.
The IntRange field, for example will use this range
to create a select list with a range of integers.

If one or both of range_start and range_end are set
and the field does not have an options list, the field's
input value will be tested to be within the range (or
equal to or above/below if only one is set) by numerical
comparison.

For example, in a profile:

    age => {
        type            => 'Integer',
        range_start     => 18,
        range_end       => 120,
    }

Will test that any age entered will be in the range of
of 18 to 120, inclusive.  Open ended can be done by simply:

    age => {
        type            => 'Integer',
        range_start     => 18,
    }

=item reest_errors

Resets the list of errors.  The validate method
clears the errors by default.

=item validate_field

This method does standard validation, which currently tests:

    required        -- if field is required and value exists

Then if a value exists:

    test_multiple   -- looks for multiple params passed in when not allowed
    test_options    -- tests if the params passed in are valid options

If all of those pass then the field's validate method is called

    $field->validate;

If C<< $field->validate >> returns true then the input value
is copied from the input attribute to the field's value attribute
by calling:

    $field->input_to_value;

The default method simply copies the value.  This method is only called
if the field does not have any errors.

The field's error list and internal value are reset upon entry.

Typically, a field may wish to override the following methods:

=over 4

=item validate

This method should validate the input data:

    $input = $field->input

The input data is the raw input provided to the form.

=item input_to_value

This method must copy the input data to the field's value.
The default method simple does:

    $field->value( $field->input );

A common use in a field would be to convert the input into
an internal format.  For example, converting a time or date in string
form to a L<DateTime> object.

=item validate_value

This method is called after converting the input data into the field's
internal value.  This can be used to validate the value after it's been converted.
For example, for testing a L<DateTime> object is within a given range of dates.

=back

=item validate

This method validates the input data for the field and returns true if
the data validates, false if otherwise.  It's expected that an error
message is added to the field if the field's input value does not validate.

The default method is to return true.

The method is passed the field's input value.

When overriding this method it is best to first call the parent class
validate method.  This way general to more specific error validation can occur.
For example in a field class:

    sub validate {
        my $field = shift;
        
        return unless $field->SUPER::validate;
        
        my $input = $field->input;
        #validate $input
        
        return $valid_input ? 1 : 0;
    }

If the validation method produces a final value in the process of validation
(e.g. creates a DateTime object from a string) then that value can either
be placed in C<< $field->value >> at that time and will not be copied by
C<< $field->input_to_value >>, or can place the value in a temporary location
and then the field can also override the C<input_to_value> method.

=item validate_value

This field method is called after the raw field has been validated (with the validate method)
and placed in the field's value (after calling input_to_value() method).

This method can be overridden in field classes to validate a field after it's been
converted into its internal form (e.g. a DateTime object).

The default method is to simply return true;

=item value_format

This is a sprintf format string that is used when moving the field's
input data to the field's value attribute.  By defult this is undefined,
but can be set in fields to alter the way the input_to_value() method
formates input data.

For example in a field that represents money the field could define:

    sub init_value_format { '%.2f' }

And then numberic data will be formatted with two decimal places.

=item input_to_value

This method is called if C<< $field->validate >> returns true.
The default method simply copies the input attribute value to the
value attribute if C<< $field->value >> is undefined.

    $field->value( $field->input )
        unless defined $field->value;

A field's validation method can populate a field's value during
validation, or can override this method to populate the value after
validation has run.  Overriding this method is recommended.

=item test_ranges

If range_start and/or range_end is set AND the field
does not have options will test that the value is within
range.  This is called after all other validation.

=item trim_value

Trims leading and trailing white space for single parameters.
If the parameter is an array ref then each value is trimmed.

Pass in the value to trim and returns value back

=item required_message

Returns text for use in "required" message.
The default is "This field is required".

=item test_multiple

Returns false if the field is a multiple field
and the input for the field is a list.

=item any_input

Returns true if $self->input contains any non-blank input.

=item test_options

If the field has an "options" method then the input value (or values
if an array ref) is tested to make sure they all are valid options.

Returns true or false

=item format_value

This method takes $field->value and formats it into a hash
that is merged in to the final params hash.  It's purpose is to take the
internal value an create the key/value pairs.

By default it returns:

    ( $field->name, $field->value )

A Date field subclass might expaned the value into:

    my $name = $field->name;
    return (
        $name . 'd'  => $day,
        $name . 'm' => $month,
        $name . 'y' => $year,
    );

It's up to you to not use duplicate hash values.

You might want to override test_required() if you don't use a matching field name
(e.g. $name . 'd' instead of just $name).

=item noupdate

This boolean flag indicates a field that should not be updated.  Field's
flagged as noupdate are skipped when processing by the model.

This is usesful when a form contains extra fields that are not directly
written to the data store.

=item disabled
=item readonly

These allow you to give hints to how the html element is genrated.  This have specific
meanings in the HTML specification, but may not be consistently implemented.
Disabled controls should not be successful and thus not submitted in forms, where
readonly fileds can be.  Instead of depending on these field attribues, an
Form::Processor::Model classes should instead use the L<noupdate> flag
as an indicator if the field should be ignored or not.

=item clear

This is a flag that says you want to clear the database column for this
field.  Validation is also not run on this field.

=item writeonly

Fields flagged as writeonly are not fetched from the model when $form->params
is called.  This means the field's formatted value will not be included
in the hash returned by $form->fif when first populating a form with
existing values.

An example might be a situation where a trigger is used to create a copy of a
row before an update.  In this case you might have a required "update_reason"
column that should only be written to the database on updates.

Unlike the C<password> flag, this only prevents populating a field from the
field's initial value, but not from the parameter hash passed to the form.
Redrawn forms (after validation failures) will display the value submitted
in the form.

=item password

This is a boolean flag and if set the $form->params method will remove that
field when calling $form->fif.

This is different than the C<writeonly> method above in that the value is
removed from the hash every time its fetched.

=item value_changed

Returns true if the value in the item has changed from what is currently in the
field's value.

This only does a string compare (arrays are sorted and joined).

=item required_text

Returns "required" or "optional" based on the field's setting.

=item has_error

Returns the count of errors on the field.

=item dump_field

A little debugging.

=back

=head1 AUTHOR

Bill Moseley <mods@hank.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Bill Moseley.

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