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');
=head1 NAME
DBIx::Class::FormTools - Helper module for building forms with multiple related L<DBIx::Class> objects.
=head1 VERSION
This document describes DBIx::Class::FormTools version 0.0.5
=head1 SYNOPSIS
=head2 This is ALPHA software
There may be bugs. The interface may change. Do not use this for anything
important just yet.
=head2 Prerequisites
In the examples I use 3 objects, a C<Film>, an C<Actor> and a C<Role>.
C<Role> is a many to many relation between C<Film> and C<Actor>.
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');
=head2 In your Controller
use DBIx::Class::FormTools;
my $helper = DBIx::Class::FormTools->({ schema => $schema });
=head2 In your view - L<HTML::Mason> example
<%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>
=head2 In your controller (or cool helper module, used in your controller)
my @objects = $helper->formdata_to_objects(\%querystring);
foreach my $object ( @objects ) {
# Assert and Manupulate $object as you like
$object->insert_or_update;
}
=head1 DESCRIPTION
=head2 Introduction
L<DBIx::Class::FormTools> is a data serializer, that can convert HTML formdata
to L<DBIx::Class> objects based on element names created with
L<DBIx::Class::FormTools>.
It uses user supplied object ids to connect the objects with each-other.
The objects do not need to exist on beforehand.
The module is not ment to be used directly, although it can of-course be done
as seen in the above example, but rather used as a utility module in a
L<Catalyst> helper module or other equivalent framework.
=head2 Connecting the dots - The problem at hand
Creating a form with data from one object and storing it in a database is
easy, and several modules that does this quite well already exists on CPAN.
What I am trying to accomplish here, is to allow multiple objects to be
created and updated in the same form - This includes the relations between
the objects i.e. "connecting the dots".
=head2 Non-existent ids - Enter object_id
When converting the formdata to objects, we need "something" to identify the
objects by, and sometimes we also need this "something" to point to another
object in the formdata to signify a relation. For this purpose we have the
C<object_id> which is user definable and can be whatever you like.
=head1 METHODS
=head2 C<new>
Arguments: { schema => $schema }
Creates new form helper
my $helper = DBIx::Class::FormTools->new({ schema => $schema });
=cut
=head2 C<schema>
Arguments: None
Returns the schema
my $helper = $helper->schema;
=cut
=head2 C<fieldname>
Arguments: $object, $accessor, $object_id, $foreign_object_ids
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' }
);
Creates a unique form field name for use in an HTML form.
=over
=item C<$object>
The object you wish to create a key for.
=item C<$accessor>
The attribute in the object you wish to create a key for.
=item C<$object_id>
A unique string identifying a specific object in the form.
=item C<$foreign_object_ids>
A C<HASHREF> containing C<attribute =E<gt> object_id> pairs, use this to
connect objects with each-other as seen in the above example.
=back
=cut
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);
}
=head2 C<formdata_to_objects>
Arguments: \%formdata
my @objects = $helper->formdata_to_objects($formdata);
Turn formdata(a querystring) in the form of a C<HASHREF> into an C<ARRAY> of
C<DBIx::Class> objects.
=cut
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__
=head2 meta
This is a method which provides access to the current class's metaclass.
=head1 CAVEATS
=head2 Transactions
When using this module it is prudent that you use a database that supports
transactions.
The reason why this is important, is that when calling C<formdata_to_objects>,
C<DBIx::Class::Row-E<gt>create()> is called foreach nonexistent object in
order to get the C<primary key> filled in. This call to C<create> results in a
SQL C<insert> statement, and might leave you with one object successfully put
into the database and one that generates an error - Transactions will allow
you to examine the C<ARRAY> of objects returned from C<formdata_to_objects>
before actually storing them in the database.
=head2 Automatic Primary Key generation
You must use C<DBIx::Class::PK::Auto>, otherwise the C<formdata_to_objects>
will fail when creating new objects, as it is unable to determine the value
for the primary key, and therefore is unable to connect the object to any
related objects in the form.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
Please report any bugs or feature requests to
C<bug-dbix-class-formtools@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.
=head1 AUTHOR
David Jack Olrik C<< <djo@cpan.org> >>
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2006, David Jack Olrik C<< <djo@cpan.org> >>.
All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
=head1 TODO
=over
=item * Add form object, that keeps track of object ids automagickly.
=item * Add field generator, that can generate HTML/XHTML fields based on the
objects in the form object.
=back
=head1 SEE ALSO
L<DBIx::Class> L<DBIx::Class::PK::Auto>