Form::Sensible::Form - Form::Sensible's Form class

    use Form::Sensible::Form;

    my $form = Form::Sensible::Form->new( name => 'login_form' );

    $form->add_field({ ... });

    # later

    $form->set_values( $cgi->Vars );

    my $validation_result = $form->validate();

    if ( !$validation_result->is_valid() ) {
        # re-render form with errors.
    }

package Form::Sensible::Form;

use Moose; 
use namespace::autoclean;
use Form::Sensible::DelegateConnection;
use Form::Sensible::Validator;
use Carp qw/croak/;
use Data::Dumper;
use Class::MOP;    ## I don't believe this is required

## a form is a collection of fields. Different form types will work differently.

## the Concept basically follows a flow:
##
## 1) Form is created.
## 2) Fields are created and added to the Form
## 3) Form is rendered
## 4) user takes action - filling in fields, etc.
## 5) user indicates an action (form is complete (submit) or cancelled)
## 6) If cancelled, form triggers cancel action.

## 7) if submitted - form calls validators in turn on each of it's fields (and finally a
##               'last step' validation that runs against all fields, if provided.)

## 7a) if validation fails - failed_validation action is called - most often re-render of the form with messages.

## 7b) if validation succeeds - complete_action is called.

has 'name' => (
    is          => 'rw',
    isa         => 'Str',
    required    => 1,
    default     => 'form',
);

has '_fields' => (
    is          => 'rw',
    isa         => 'HashRef[Form::Sensible::Field]',
    required    => 1,
    default     => sub { return {}; },
    lazy        => 1,
);

has 'field_order' => (
    is          => 'rw',
    isa         => 'ArrayRef[Str]',
    required    => 1,
    default     => sub { return []; },
    lazy        => 1,
);

has 'renderer' => (
    is          => 'rw',
    isa         => 'Form::Sensible::Renderer',
);

has 'render_hints' => (
    is          => 'rw',
    isa         => 'HashRef',
    required    => 1,
    default     => sub { return {}; },
    lazy        => 1,
);

## validation hints - FULL form validation
## runs _after_ field validation.
has 'validation' => (
    is          => 'rw',
    isa         => 'HashRef',
    required    => 1,
    default     => sub { return {}; },
    lazy        => 1,
);

## DEPRECATION WARNING.  validator_args is deprecated, as is validator_result and validator
## all of these are replaced via the validation_delegate. DUE FOR REMOVAL 2010-08-30
has 'validator_args' => (
    is          => 'rw',
    isa         => 'ArrayRef',
    required    => 1,
    default     => sub { return []; },
    lazy        => 1,
);

has 'validator_result' => (
    is          => 'rw',
    isa         => 'Form::Sensible::Validator::Result',
    required    => 0,
    clearer     => '_clear_validator_result',
);

has 'validator' => (
    is          => 'rw',
    isa         => 'Form::Sensible::Validator',
    lazy        => 1,
    builder     => '_create_validator'
);

## calling format:  ($form, $fieldname) returns true/false whether the field should be processed.
has 'should_process_field_delegate' => (
    is          => 'rw',
    isa         => 'Form::Sensible::DelegateConnection',
    required    => 1,
    default     => sub {
                            return FSConnector(sub { return 1; });
                   },
    lazy        => 1,
    coerce      => 1,
    # additional options
);

has 'validation_delegate' => (
    is          => 'rw',
    isa         => 'Form::Sensible::DelegateConnection',
    required    => 1,
    default     => sub {
                            my $self = shift;
                            my $validator;
                            if (defined($self->validation->{'validator_class'})) {
                                $validator = $self->_create_validator();
                            } else {
                                $validator = Form::Sensible::Validator->new();
                            }

                            return FSConnector( sub { 
                                                my $caller = shift;
                                                
                                                return $validator->validate($caller);
                                   });
                   },
    lazy        => 1,
    coerce      => 1,
    # additional options
);

## adds a field to the form.  If position is specified, places it at the
## given position, otherwise places it at the end of the form.  
## returns the new fields position in the form.
## Note that fieldname does not necessarily need to be the same as $field->name
## though you may get odd behavior if you accidentally insert multiple fields with
## the same $field->name

sub add_field {
    my ($self, $field, $fieldname, $position) = @_;
    
    if (!$fieldname) {
        if (ref($field) =~ /^Form::Sensible::Field/) {
            $fieldname = $field->name;
        } elsif (ref($field) eq 'HASH') {
            $fieldname = $field->{'name'};
        } 
    }
    
    if (defined($self->_fields->{$fieldname})) {
        $self->remove_field($fieldname);
    }
    
    ## this will cause an unblessed hash passed to add_field to auto-create
    ## the appropriate field type.
    if (ref($field) eq 'HASH') {
        my $newfield = $field;
        $field = Form::Sensible::Field->create_from_flattened($newfield);
    }
    
    if ($field->isa('Form::Sensible::Field::SubForm') && $field->form == $self) {
        croak "Unable to add sub-form. sub-form is the same as me. Infinite recursion will occur, dying now instead of later.";
    }
    
    $self->_fields->{$fieldname} = $field;
    
    ## if position is larger than the current form size
    ## reset position so the field is added to the end of the
    ## list.
    
    if ($position && $position > $#{$self->field_order}) {
        $position = undef;
    }
    if (!$position) {
        push @{$self->field_order}, $fieldname;
        $position = $#{$self->field_order};
    } else {
        splice @{$self->field_order}, $position, 0, $fieldname;
    }
    return $position;
}

## removes a field from the form by name.  Returns the removed field 
## or undef if the field was not present in the form.
sub remove_field {
    my ($self, $fieldname) = @_;
    
    my $field = $self->field($fieldname);
    delete($self->_fields->{$fieldname});
    foreach my $i (0..$#{$self->field_order}) {
        if ($self->field_order->[$i] eq $fieldname ) {
            splice @{$self->field_order}, $i, 1;
            last;
        }
    }
    return $field;
}

## moves a field from one position to another.  This may not work the way 
## I think because the field is removed and then replaced, depending on it's 
## original position, it may not appear where the user expects.  Need to work 
## on that.
sub reorder_field {
    my ($self, $fieldname, $newposition) = @_;
    
    my $field = $self->remove_field($fieldname);
    return $self->add_field($field, $fieldname, $newposition);
}

## returns the field requested or undef if a field by that name is not found
sub field {
    my ($self, $fieldname) = @_;
    
    return $self->_fields->{$fieldname};
}

## returns a hash containing all the fields in the current form 
## fields is DEPRECATED.  DO NOT USE IT.
sub fields {
    my $self = shift;
    
    return { %{$self->_fields} };
}

## Returns an array of all the fields in the form in field_order 
## obeying should_process_field_delegate.
sub get_fields {
    my $self = shift;
    
    my @active_fields;
    foreach my $fieldname (@{$self->field_order}) {
        if ($self->should_process_field_delegate->($self, $fieldname)) {
            push @active_fields, $self->field($fieldname);
        }
    }
    return @active_fields;   
}


## returns the fieldnames in the current form in their presentation order
sub fieldnames {
    my $self = shift;
    
    return @{$self->field_order};
}

sub _create_validator {
    my ($self) = @_;
    
    my $validator;

    ## first see if we have had our validator class overridden
    my $classname;
    if (defined($self->validation->{'validator_class'})) {
        ## we have, so get the class name and instantiate an object of that class
        $classname = $self->validation->{'validator_class'};
    } else {
        ## otherwise, we create a Form::Sensible::Validator object.
        $classname = '+Form::Sensible::Validator';
    }
    if ($classname =~ /^\+(.*)$/) {
        $classname = $1;
    } else {
        $classname = 'Form::Sensible::Validator::' . $classname;
    }
    Class::MOP::load_class($classname);
    $validator = $classname->new(@{$self->validator_args});
    
    return $validator;
}


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

    my $result = $self->validation_delegate->($self);
    
    ## for now - validation_results() are set automatically if validate is run from the form.
    ## this is deprecated and will be removed.  DUE FOR REMOVAL 2010-07-30
    $self->validator_result($result);
    
    return $result;
}

sub render {
    my ($self) = shift;
    
    if ($self->renderer) {
        return $self->renderer->render($self, @_);
    } else {
        croak __PACKAGE__ . '->render() called but no renderer defined for this form (' . $self->name . ')';
    }
}

sub set_values {
    my ($self, $values) = @_;
    
    foreach my $fieldname ( $self->fieldnames ) {
        if (exists($values->{$fieldname})) {
            $self->field($fieldname)->value($values->{$fieldname});
        }
    }
}

sub get_all_values {
    my $self = shift;
    
    my $value_hash = {};
    foreach my $fieldname ( $self->fieldnames ) {
        $value_hash->{$fieldname} = $self->field($fieldname)->value();
    }
    return $value_hash;
}

sub clear_state {
    my $self = shift;
    
    foreach my $fieldname ( $self->fieldnames ) {
        $self->field($fieldname)->clear_state();
    }
    
    ## DUE FOR REMOVAL 2010-07-30
    $self->_clear_validator_result();
}

sub delegate_all_field_values {
    my $self = shift;
    my $value_delegate = shift;

    foreach my $field ($self->get_fields()) {
        $field->value_delegate( $value_delegate );
    }
}

sub delegate_all_field_values_to_hashref {
    my $self = shift;
    my $hashref = shift;
    
    # We only need one value delegate object because it gets the name from the field's name.
    # So we save a bit of memory by not creating a separate delegate object for each field
    my $value_delegate = FSConnector( sub { 
                              my $caller = shift;
                              my $fieldname = $caller->name();

                              if ($#_ > -1) {   
                                  if (ref($_[0]) eq 'ARRAY' && !($caller->accepts_multiple)) {
                                      $hashref->{$fieldname} = $_[0]->[0];
                                  } else {
                                      $hashref->{$fieldname} = $_[0];
                                  }
                              }
                              return $hashref->{$fieldname}; 
                          });
    
    $self->delegate_all_field_values($value_delegate);
}



sub flatten {
    my ($self, $template_only) = @_;
    
    my $form_hash = {
    	                    'name' => $self->name,
    	                    'render_hints' => $self->render_hints,
    	                    'validation' => $self->validation,
    	                    'field_order' => $self->field_order,
    	            };

    $form_hash->{'fields'} = {};

    foreach my $fieldname ( $self->fieldnames ) {
        $form_hash->{'fields'}{$fieldname} = $self->field($fieldname)->flatten($template_only);
    }
    return $form_hash; 
}

__PACKAGE__->meta->make_immutable;
1;

__END__