DBIx::Class::FormTools - Helper module for building forms with multiple related L<DBIx::Class> objects.

    package MySchema;
    use base 'DBIx::Class::Schema';
    __PACKAGE__->load_classes(qw[
        Film
        Actor
        Role
    ]);




    package MySchema::Film;
    __PACKAGE__->table('films');
    __PACKAGE__->add_columns(qw[
        id
        title
    ]);
    __PACKAGE__->set_primary_key('id');
    __PACKAGE__->has_many(roles => 'MySchema::Role', 'film_id');




    package MySchema::Actor;
    __PACKAGE__->table('films');
    __PACKAGE__->add_columns(qw[
        id
        name
    ]);
    __PACKAGE__->set_primary_key('id');
    __PACKAGE__->has_many(roles => 'MySchema::Role', 'actor_id');




    package MySchema::Role;
    __PACKAGE__->table('roles');
    __PACKAGE__->add_columns(qw[
        film_id
        actor_id
    ]);
    __PACKAGE__->set_primary_key(qw[
        film_id
        actor_id
    ]);

    __PACKAGE__->belongs_to(film_id  => 'MySchema::Film');
    __PACKAGE__->belongs_to(actor_id => 'MySchema::Actor');

    use DBIx::Class::FormTools;

    my $helper = DBIx::Class::FormTools->({ schema => $schema });

    <%init>
    my $film  = $schema->resultset('Film')->find(42);
    my $actor = $schema->resultset('Actor')->find(24);
    my $role  = $schema->resultset('Role')->new;

    </%init>
    <form>
        <input
            name="<% $helper->fieldname($film, 'title', 'o1') %>"
            type="text"
            value="<% $film->title %>"
        />
        <input
            name="<% $helper->fieldname($film, 'length', 'o1') %>"
            type="text"
            value="<% $film->length %>"
        />
        <input
            name="<% $helper->fieldname($film, 'comment', 'o1') %>"
            type="text"
            value="<% $film->comment %>"
        />
        <input
            name="<% $helper->fieldname($actor, 'name', 'o2') %>"
            type="text"
            value="<% $actor->name %>"
        />
        <input
            name="<% $helper->fieldname($role, undef, 'o3', {
                film_id  => 'o1',
                actor_id => 'o2'
            }) %>"
            type="hidden"
            value="dummy"
        />
    </form>

    my @objects = $helper->formdata_to_objects(\%querystring);
    foreach my $object ( @objects ) {
        # Assert and Manupulate $object as you like
        $object->insert_or_update;
    }

    my $helper = DBIx::Class::FormTools->new({ schema => $schema });

    my $helper = $helper->schema;

    my $name_film  = $helper->fieldname($film, 'title', 'o1');
    my $name_actor = $helper->fieldname($actor, 'name', 'o2');
    my $name_role  = $helper->fieldname($role, undef,'o3',
        { film_id => 'o1', actor_id => 'o2' }
    );
    my $name_role  = $helper->fieldname($role,'charater','o3',
        { film_id => 'o1', actor_id => 'o2' }
    );

    my @objects = $helper->formdata_to_objects($formdata);

package DBIx::Class::FormTools;

our $VERSION = '0.000007';

use strict;
use warnings;

#use DBIx::Class::FormTools::Form;

use Carp;
use Moose;

has 'schema'    => (is => 'rw', isa => 'Ref');
has '_objects'  => (is => 'rw', isa => 'HashRef');
has '_formdata' => (is => 'rw', isa => 'HashRef');

sub fieldname
{
    my ($self,$object,$attribute,$object_id,$foreign_object_ids) = @_;

    # Get class name
    my $class = $object->source_name || ref($object);
    
    my @primary_keys  = $object->primary_columns;
    
    my %relationships
        = ( map { $_,$object->relationship_info($_) } $object->relationships );

    my %id_fields = ();
    foreach my $primary_key ( @primary_keys ) {
        # Field is foreign key
        if ( exists $relationships{$primary_key} ) {
            $id_fields{$primary_key} = $foreign_object_ids->{$primary_key};
        }
        # Field is local
        else {
            $id_fields{$primary_key}
                = ( ref($object) &&  $object->$primary_key )
                ? $object->$primary_key
                : 'new';
        }
    }

    # Build object key
    my $fieldname = join('|',
        'dbic',
        $object_id,
        $class,
        join(q{;}, map { "$_:".$id_fields{$_} } keys %id_fields),
        ($attribute || ''),
    );

    return($fieldname);
}

sub formdata_to_objects
{
    my ($self,$formdata) = @_;

    # Cleanup old objects
    $self->_objects({});
    $self->_formdata({});

    # Extract all dbic fields
    my @dbic_formkeys = grep { /^dbic\|/ } keys %$formdata;

    my $objects = {};

    # Create a todo list with one entry for each unique objects
    # So we can process them in reverse order of dependency
    my %todolist;

    # Sort data into piles for later object creation/updating
    foreach my $formkey ( @dbic_formkeys ) {
        my ($prefix,$object_id,$class,$id,$attribute) = split(/\|/,$formkey);

        # Store form contents
        $self->_formdata->{$object_id}->{'content'}->{$attribute}
            = $formdata->{$formkey} if $attribute;

        # Build id field
        my %id;
        foreach my $field ( split(/;/,$id) ) {
            my ($key,$value) = split(/:/,$field);
            $id{$key} = $value;
        }

        # Store id field
        $self->_formdata->{$object_id}->{'form_id'} = \%id;

        # Save class name and id in the todo list
        # (hash used to avoid dupes)
        $todolist{"$class|$object_id"} = {
            class     => $class,
            object_id => $object_id,
        };
    }

    # Flatten todo hash into a todolist array
    my @todolist = values %todolist;

    # Build objects from form data
    my @objects;
    foreach my $todo ( @todolist ) {
        my $object = $self->_inflate_object(
            $todo->{ 'object_id' },
            $todo->{ 'class'     },
        );        
        push(@objects,$object);
    }

    # Cleanup old objects
    $self->_objects({});
    $self->_formdata({});

    return(@objects);
}


sub _flatten_id
{
    my ($id) = @_;
    
    return join(';', map { $_.':'.$id->{$_} } sort keys %$id);
}


sub _inflate_object
{
    my ($self,$oid,$class) = @_;

    my $attributes;
    my $id;

    # Object exists in form
    if ( exists($self->_formdata->{$oid}) ) {
        $id         = $self->_formdata->{$oid}->{'form_id'};
        $attributes = $self->_formdata->{$oid}->{'content'};
    }
    # Object does not exist in form, use oid as id
    # FIXME -> Should this be removed ?
    else {
        $id = { id => $oid };
    }

    # Return object if is already inflated
    return $self->_objects->{$class}->{$oid}
        if $self->_objects->{$class}
        && $self->_objects->{$class}->{$oid};

    # Inflate foreign fields that map to a *single* column
    my $relationships = {
        map { $_,$self->schema->source($class)->relationship_info($_) } 
        $self->schema->source($class)->relationships
    };
    foreach my $foreign_accessor ( keys %$relationships ) {
        # Resolve foreign class name
        my $foreign_class = $self->schema->source($relationships
                                                  ->{$foreign_accessor}
                                                  ->{'class'}
                                                  )->source_name;

        my $foreign_relation_type = $relationships->{$foreign_accessor}
                                                  ->{'attrs'}
                                                  ->{'accessor'};

        # Do not process multicolumn relationships, they will be processed
        # seperatly when the object to which they relate is inflated
        # I.e. only process "local" attributes
        next if $foreign_relation_type eq 'multi';

        # Lookup foreign object id
        # FIXME: Should we really look in both places?
        my $foreign_oid = ( $self->_formdata
                                 ->{$oid}
                                 ->{'form_id'}
                                 ->{$foreign_accessor} )
                        ?   $self->_formdata
                                 ->{$oid}
                                 ->{'form_id'}
                                 ->{$foreign_accessor}
                        :   $self->_formdata
                                 ->{$oid}
                                 ->{'content'}
                                 ->{$foreign_accessor};
        # No id found, no inflate needed
        next unless $foreign_oid;

        my $foreign_object = $self->_inflate_object(
            $foreign_oid,
            $foreign_class,
        );

        # Store object for later use
        $self->_objects->{$foreign_class}->{$oid}
            = $foreign_object;

        # If the field is part of the id then store it there as well
        $id->{$foreign_accessor} = $foreign_object->id
            if exists $id->{$foreign_accessor};

        # Store the foreign object with all the other object data
        # FIME: Shouldn't I be able to just pass the whole object here ?
        $attributes->{$foreign_accessor} = $foreign_object->id;
    }
    # All foreign objects have been now been inflated

    # Look up object in memory
    my $object = $self->_objects->{$class}->{$oid};

    # Lookup in object in db
    unless ( $object ) {
        my $source = $self->schema->source($class);
        # Don't lookup object if id is 'new'
        $object = $self->schema->resultset($source->source_name)->find($id)
            unless grep { $id->{$_} eq 'new' } $source->primary_columns;
    }

    # Still no object, the create it
    unless ( $object ) {
        $object = $self->schema->resultset($class)->create($attributes);
    }

    # If we have a object update it with form data, if it exists
    $object->set_columns($attributes) if $attributes && $object;

    # Store object for later use
    if ( $id && $object ) {
        $self->_objects->{$class}->{$oid} = $object;
    }

    return($object);
}


# sub form
# {
#     my $self = shift;
#     my $form = DBIx::Class::FormTools::Form->new({});
#     
#     return($form);
# }


1; # Magic true value required at end of module
__END__