Form::Processor::Model::DBIC - Model class for Form Processor using DBIx::Class

    package MyApp:Form::User;
    use strict;
    use base 'Form::Processor::Model::DBIC';

    # Associate this form with a DBIx::Class result class
    sub object_class { 'User' } # Where 'User' is the DBIC source_name 

    # Define the fields that this form will operate on
    # Field names must be column or relationship names in your
    # DBIx::Class result class
    sub profile {
        return {
            fields => {
                name        => {
                   type => 'Text',
                   label => 'Name:',
                   required => 1,
                   noupdate => 1,
                },
                age         => {
                    type => 'PosInteger',
                    label    => 'Age:',
                    required => 1,
                },
                sex         => {
                    type => 'Select',
                    label => 'Gender:',
                    required => 1,
                },
                birthdate   => '+MyApp::Field::Date', # customized field class
                hobbies     =>  {
                    type => 'Multiple',
                    size => 5,
                },
                address     => 'Text',
                city        => 'Text',
                state       => 'Select',
            },

            dependency => [
                ['address', 'city', 'state'],
            ],
        };

   <p>
   [% f = form.field('address') %]
   <label class="label" for="[% f.name %]">[% f.label || f.name %]</label>
   <input type="text" name="[% f.name %]" id="[% f.name %]">
   </p>

   <p>
   [% f = form.field('sex') %]
   <label class="label" for="[% f.name %]">[% f.label || f.name %]</label>
   <select name="[% f.name %]">
     [% FOR option IN f.options %]
       <option value="[% option.value %]" [% IF option.value == f.value %]selected="selected"[% END %]>[% option.label | html %]</option>
     [% END %] 
   </select>
   </p>

    package MyApp::Controller::User;
    use strict;
    use warnings;
    use base 'Catalyst::Controller::Form::Processor';

    # Create or edit
    sub edit : Local {
        my ( $self, $c, $user_id ) = @_;
        $c->stash->{template} = 'user/edit.tt'; 
        # Validate and insert/update database. Args = pk, form name
        return unless $self->update_from_form( $user_id, 'User' );
        # Form validated.
        $c->stash->{user} = $c->stash->{form}->item;
        $c->res->redirect($c->uri_for('profile'));
    }

    my $validated = $form->update_from_form( $parameter_hash );

   arraryref:
        unique => ['user_id', 'username']

   or hashref:
        unique => {
            username => 'That username is already taken',
        }

    return $self->resultset->find( $self->item_id );

package Form::Processor::Model::DBIC;

use base 'Form::Processor';
use Carp;

our $VERSION = '0.10001';

use Rose::Object::MakeMethods::Generic (
    scalar => [
        'schema'      => { interface => 'get_set_init' },
        'source_name' => {},
    ],
);

sub update_from_form {
    my ( $self, $params ) = @_;
    return unless $self->validate($params);
    $self->schema->txn_do( sub { $self->update_model } );
    return 1;
}

sub model_validate {
    my ($self) = @_;
    return unless $self->validate_unique;
    return 1;
}

sub update_model {
    my ($self) = @_;
    my $item   = $self->item;
    my $source = $self->source;

    # get a hash of all fields, skipping fields marked 'noupdate'
    my $prefix = $self->name_prefix;
    my %columns;
    my %multiple_m2m;
    my %other;
    my $field;
    my $value;

    # Save different flavors of fields into hashes for processing
    foreach $field ( $self->fields ) {
        next if $field->noupdate;
        my $name = $field->name;
        $name =~ s/^$prefix\.//g if $prefix;

        # If the field is flagged "clear" then set to NULL.
        $value = $field->clear ? undef : $field->value;
        if ( $source->has_relationship($name) ) {
            # If this is a relationship then may need to convert it to
            # a column name.  The common situation is where the column name
            # is "artist_id" but the belongs_to relation name is "artist"
            # where "artist" is what is used as the field name in the form.
            #
            # Another option would be to convert the $value into an object
            # as then can set the relationship like this $cd->artist_rel( $artist_object )
            ($name) = values %{ $source->relationship_info($name)->{cond} };
            $name =~ s{^self\.}{};
            $columns{$name} = $value;
        }
        elsif ( $source->has_column($name) ) {
            $columns{$name} = $value;
        }
        elsif ( $field->can('multiple') && $field->multiple == 1 ) {

            # didn't have a relationship and is multiple, so must be m2m
            $multiple_m2m{$name} = $value;
        }
        else    # neither a column nor a rel
        {
            $other{$name} = $value;
        }
    }

    # Handle database columns
    if ($item) {
        $self->updated_or_created('updated');
    }
    else {
        $item = $self->resultset->new_result( {} );
        $self->item($item);
        $self->updated_or_created('created');
    }
    for my $field_name ( keys %columns ) {
        $value = $columns{$field_name};
        my $cur = $item->$field_name;
        next unless $value || $cur;
        next if ( ( $value && $cur ) && ( $value eq $cur ) );
        $item->$field_name($value);
    }

    # set non-column, non-rel attributes
    for my $field_name ( keys %other ) {
        next unless $item->can($field_name);
        $item->$field_name( $other{$field_name} );
    }

    # update db
    if ( $item->in_storage ) {
        $item->update;
    }
    else {
        $item->insert;
    }

    # process Multiple field 'many_to_many' relationships
    if (%multiple_m2m) {

        for my $col_name ( keys %multiple_m2m ) {

            # Make sure the $col_name is a relation
            next unless $item->can($col_name);

            my $value = $multiple_m2m{$col_name};

            # Get a result source, primary key, and resultset
            # for the related many_to_many class
            my $f_source = $item->$col_name->result_source;
            my ($key)    = $f_source->primary_columns;
            my $f_rs     = $f_source->resultset;

            # And set.
            my $method = 'set_' . $col_name;
            my @objs = $f_rs->search( { $key => $value } );
            $item->$method(@objs);
        }
    }

    $self->reset_params;    # force reload of parameters from values
    return $item;
}

sub guess_field_type {
    my ( $self, $column ) = @_;
    my $source = $self->source;
    my @return;

    #  TODO: Should be able to use $source->column_info

    # Is it a direct has_a relationship?
    if (
        $source->has_relationship($column)
        && (
            $source->relationship_info($column)->{attrs}->{accessor} eq 'single'
            || $source->relationship_info($column)->{attrs}->{accessor} eq
            'filter' )
      )
    {
        my $f_class = $source->related_class($column);
        @return =
          $f_class->isa('DateTime')
          ? ('DateTimeDMYHM')
          : ('Select');
    }

    # Else is it has_many?
    elsif ($source->has_relationship($column)
        && $source->relationship_info($column)->{attrs}->{accessor} eq 'multi' )
    {
        @return = ('Multiple');
    }
    elsif ( $column =~ /_time$/ )    # ends in time, must be time value
    {
        @return = ('DateTimeDMYHM');
    }
    else                             # default: Text
    {
        @return = ('Text');
    }

    return wantarray ? @return : $return[0];
}

sub lookup_options {
    my ( $self, $field ) = @_;

    my $field_name = $field->name;
    my $prefix     = $self->name_prefix;
    $field_name =~ s/^$prefix\.//g if $prefix;

    # if this field doesn't refer to a foreign key, return
    my $f_class;
    my $source;
    if ( $self->source->has_relationship($field_name) ) {
        $f_class = $self->source->related_class($field_name);
        $source  = $self->schema->source($f_class);
    }
    elsif ( $self->resultset->new_result( {} )->can("add_to_$field_name") ) {

        # Multiple field with many_to_many relationship
        $source =
          $self->resultset->new_result( {} )->$field_name->result_source;
    }
    return unless $source;

    my $label_column = $field->label_column;
    return unless $source->has_column($label_column);

    my $active_col =
        $self->can('active_column')
      ? $self->active_column
      : $field->active_column;

    $active_col = '' unless $source->has_column($active_col);
    my $sort_col = $field->sort_order;
    $sort_col = defined $sort_col
      && $source->has_column($sort_col) ? $sort_col : $label_column;

    my ($primary_key) = $source->primary_columns;

    # If there's an active column, only select active OR items already selected
    my $criteria = {};
    if ($active_col) {
        my @or = ( $active_col => 1 );

        # But also include any existing non-active
        push @or, ( "$primary_key" => $field->init_value )
          if $self->item && defined $field->init_value;
        $criteria->{'-or'} = \@or;
    }

    # get an array of row objects
    my @rows =
      $self->schema->resultset( $source->source_name )
      ->search( $criteria, { order_by => $sort_col } )->all;

    return [
        map {
            my $label = $_->$label_column;
            $_->id, $active_col && !$_->$active_col ? "[ $label ]" : "$label"
          } @rows
    ];
}

sub init_value {
    my ( $self, $field, $item ) = @_;

    my $name = $field->name;

    # Not sure a prefix is ever used.
    my $prefix = $self->name_prefix;
    $name =~ s/^$prefix\.//g if $prefix;

    # Fetch item if not passed in (should always be the case)
    $item ||= $self->item;
    return unless $item;

    # Our item may be an init object hash
    return $item->{$name} if ref($item) eq 'HASH';

    # Can we call the method on the object?
    return unless $item->isa('DBIx::Class') && $item->can($name);

    # Map any DBIC objects to their ids, but other objects (namely
    # DateTime objects) are passed as-is.  Many-to-many will be a list
    # of ids.
    return map { ref $_ && $_->isa('DBIx::Class') ? $_->id : $_ } $item->$name;

} ## end sub init_value

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

    my $unique      = $self->profile->{unique};
    my $item        = $self->item;
    my $rs          = $self->resultset;
    my $found_error = 0;
    my @unique_fields;
    my $error_message;
    if ( ref($unique) eq 'ARRAY' ) {
        @unique_fields = @$unique;
        $error_message = 'Value must be unique in the database';
    }
    if ( ref($unique) eq 'HASH' ) {
        @unique_fields = keys %$unique;
    }

    return 1 unless @unique_fields;
    for my $field ( map { $self->field($_) } @unique_fields ) {
        next if $field->errors;
        my $value = $field->value;
        next unless defined $value;
        my $name   = $field->name;
        my $prefix = $self->name_prefix;
        $name =~ s/^$prefix\.//g if $prefix;

        # unique means there can only be one in the database like it.
        my $count = $rs->search( { $name => $value } )->count;

        # not found, this one is unique
        next if $count < 1;

        # found this value, but it's the same row we're updating
        next
          if $count == 1
              && $self->item_id
              && $self->item_id ==
              $rs->search( { $name => $value } )->first->id;
        my $field_error =
             $field->unique_message
          || $error_message
          || $self->profile->{'unique'}->{$name};
        $field->add_error($field_error);
        $found_error++;
    }

    return $found_error;
}

sub init_item {
    my $self = shift;

    my $item_id = $self->item_id or return;
    return unless $item_id =~ /^\d+$/;
    my $item = $self->resultset->find($item_id);
    $self->item_id(undef) unless $item;
    return $item;
}

sub init_schema {
    my $self = shift;
    return if exists $self->{schema};
    if ( my $c = $self->user_data->{context} ) {

        # starts out <model>::<source_name>
        my $schema = $c->model( $self->object_class )->result_source->schema;

        # change object_class to source_name
        $self->source_name(
            $c->model( $self->object_class )->result_source->source_name );
        return $schema;
    }
    die "Schema must be defined for Form::Processor::Model::DBIC";
}

sub init_source_name {
    my $self = shift;
    return $self->object_class;
}

sub source {
    my ( $self, $f_class ) = @_;
    return $self->schema->source( $self->source_name || $self->object_class );
}

sub resultset {
    my ( $self, $f_class ) = @_;
    return $self->schema->resultset( $self->source_name
          || $self->object_class );
}

sub build_form {
    my $self    = shift;
    my $profile = $self->profile;
    croak "Please define 'profile' method in subclass"
      unless ref $profile eq 'HASH';

    for my $group ( 'required', 'optional', 'fields' ) {
        my $required = 'required' eq $group;
        $self->_build_fields( $profile->{$group}, $required );
        my $auto_fields = $profile->{ 'auto_' . $group } || next;
        $self->_build_fields( $auto_fields, $required );
    }
}

sub _build_fields {
    my ( $self, $fields, $required ) = @_;
    return unless $fields;
    my $field;
    if ( ref($fields) eq 'ARRAY' ) {
        for (@$fields) {
            $field = $self->make_field( $_, 'Auto' ) || next;
            $field->required($required) unless ( exists $field->{required} );
            $self->add_field($field);
        }
        return;
    }
    while ( my ( $name, $type ) = each %$fields ) {
        $field = $self->make_field( $name, $type ) || next;
        $field->required($required) unless ( exists $field->{required} );
        $self->add_field($field);
    }
}

1;