File Coverage

blib/lib/DBIx/Class/FormTools.pm
Criterion Covered Total %
statement 107 110 97.2
branch 34 40 85.0
condition 17 29 58.6
subroutine 12 13 92.3
pod 3 3 100.0
total 173 195 88.7


line stmt bran cond sub pod time code
1             package DBIx::Class::FormTools;
2              
3             our $VERSION = '0.000010';
4              
5 10     10   67185 use 5.10.1;
  10         39  
6 10     10   47 use strict;
  10         17  
  10         182  
7 10     10   38 use warnings;
  10         26  
  10         276  
8              
9             #use DBIx::Class::FormTools::Form;
10              
11 10     10   49 use Carp;
  10         23  
  10         636  
12 10     10   4801 use Moose;
  10         4170505  
  10         59  
13              
14 10     10   68808 use Data::Dump 'pp';
  10         13708  
  10         14190  
15             # use Debug::ShowStuff ':all';
16              
17             has 'schema' => (is => 'rw', isa => 'Ref');
18             has '_formdata' => (is => 'rw', isa => 'HashRef');
19              
20             has '_objects' => (is => 'rw', isa => 'HashRef');
21             has '_delayed_attributes' => (is => 'rw', isa => 'HashRef');
22              
23             =head1 NAME
24              
25             DBIx::Class::FormTools - Helper module for building forms with multiple related L<DBIx::Class> objects.
26              
27             =head1 VERSION
28              
29             This document describes DBIx::Class::FormTools version 0.0.10
30              
31             =head1 SYNOPSIS
32              
33             =head2 This is BETA software
34              
35             There may be bugs. The interface might change (But the it hasn't changed in a long time, so it is probably safe to use).
36              
37             =head2 Prerequisites
38              
39             In the examples I use 3 objects, a C<Film>, an C<Actor> and a C<Role>.
40             C<Role> is a many to many relation between C<Film> and C<Actor>.
41              
42             package MySchema;
43             use base 'DBIx::Class::Schema';
44             __PACKAGE__->load_classes(qw[
45             Film
46             Actor
47             Role
48             ]);
49              
50              
51             package MySchema::Film;
52             __PACKAGE__->table('films');
53             __PACKAGE__->add_columns(qw[
54             id
55             title
56             ]);
57             __PACKAGE__->set_primary_key('id');
58             __PACKAGE__->has_many(roles => 'MySchema::Role', 'film_id');
59              
60              
61             package MySchema::Actor;
62             __PACKAGE__->table('films');
63             __PACKAGE__->add_columns(qw[
64             id
65             name
66             ]);
67             __PACKAGE__->set_primary_key('id');
68             __PACKAGE__->has_many(roles => 'MySchema::Role', 'actor_id');
69              
70              
71             package MySchema::Role;
72             __PACKAGE__->table('roles');
73             __PACKAGE__->add_columns(qw[
74             film_id
75             actor_id
76             ]);
77             __PACKAGE__->set_primary_key(qw[
78             film_id
79             actor_id
80             ]);
81              
82             __PACKAGE__->belongs_to(film_id => 'MySchema::Film');
83             __PACKAGE__->belongs_to(actor_id => 'MySchema::Actor');
84              
85              
86             =head2 In your Controller
87              
88             use DBIx::Class::FormTools;
89              
90             my $formtool = DBIx::Class::FormTools->new({ schema => $schema });
91              
92              
93             =head2 In your view - L<HTML::Mason> example
94              
95             <%init>
96             my $film = $schema->resultset('Film')->find(42);
97             my $actor = $schema->resultset('Actor')->find(24);
98             my $role = $schema->resultset('Role')->new;
99              
100             </%init>
101             <form>
102             <input
103             name="<% $formtool->fieldname($film, 'title', 'o1') %>"
104             type="text"
105             value="<% $film->title %>"
106             />
107             <input
108             name="<% $formtool->fieldname($film, 'length', 'o1') %>"
109             type="text"
110             value="<% $film->length %>"
111             />
112             <input
113             name="<% $formtool->fieldname($film, 'comment', 'o1') %>"
114             type="text"
115             value="<% $film->comment %>"
116             />
117             <input
118             name="<% $formtool->fieldname($actor, 'name', 'o2') %>"
119             type="text"
120             value="<% $actor->name %>"
121             />
122             <input
123             name="<% $formtool->fieldname($role, undef, 'o3', {
124             film_id => 'o1',
125             actor_id => 'o2'
126             }) %>"
127             type="hidden"
128             value="dummy"
129             />
130             </form>
131              
132              
133             =head2 In your controller (or cool helper module, used in your controller)
134              
135             my @objects = $formtool->formdata_to_objects(\%querystring);
136             foreach my $object ( @objects ) {
137             # Assert and Manupulate $object as you like
138             $object->insert_or_update;
139             }
140              
141             =head1 DESCRIPTION
142              
143             =head2 Introduction
144              
145             L<DBIx::Class::FormTools> is a data serializer, that can convert HTML formdata
146             to L<DBIx::Class> objects based on element names created with
147             L<DBIx::Class::FormTools>.
148              
149             It uses user supplied object ids to connect the objects with each-other.
150             The objects do not need to exist on beforehand.
151              
152             The module is not ment to be used directly, although it can of-course be done
153             as seen in the above example, but rather used as a utility module in a
154             L<Catalyst> helper module or other equivalent framework.
155              
156             =head2 Connecting the dots - The problem at hand
157              
158             Creating a form with data from one object and storing it in a database is
159             easy, and several modules that does this quite well already exists on CPAN.
160              
161             What I am trying to accomplish here, is to allow multiple objects to be
162             created and updated in the same form - This includes the relations between
163             the objects i.e. "connecting the dots".
164              
165             =head2 Non-existent ids - Enter object_id
166              
167             When converting the formdata to objects, we need "something" to identify the
168             objects by, and sometimes we also need this "something" to point to another
169             object in the formdata to signify a relation. For this purpose we have the
170             C<object_id> which is user definable and can be whatever you like.
171              
172             =head1 METHODS
173              
174             =head2 C<new>
175              
176             Arguments: { schema => $schema }
177              
178             Creates new form helper
179              
180             my $formtool = DBIx::Class::FormTools->new({ schema => $schema });
181              
182             =cut
183              
184             =head2 C<schema>
185              
186             Arguments: None
187              
188             Returns the schema
189              
190             my $schema = $formtool->schema;
191              
192             =cut
193              
194              
195             =head2 C<fieldname>
196              
197             Arguments: $object, $accessor, $object_id, $foreign_object_ids
198              
199             my $name_film = $formtool->fieldname($film, 'title', 'o1');
200             my $name_actor = $formtool->fieldname($actor, 'name', 'o2');
201             my $name_role = $formtool->fieldname($role, undef,'o3',
202             { film_id => 'o1', actor_id => 'o2' }
203             );
204             my $name_role = $formtool->fieldname($role,'charater','o3',
205             { film_id => 'o1', actor_id => 'o2' }
206             );
207              
208             Creates a unique form field name for use in an HTML form.
209              
210             =over
211              
212             =item C<$object>
213              
214             The object you wish to create a key for.
215              
216             =item C<$accessor>
217              
218             The attribute in the object you wish to create a key for.
219              
220             =item C<$object_id>
221              
222             A unique string identifying a specific object in the form.
223              
224             =item C<$foreign_object_ids>
225              
226             A C<HASHREF> containing C<attribute =E<gt> object_id> pairs, use this to
227             connect objects with each-other as seen in the above example.
228              
229             =back
230              
231             =cut
232             sub fieldname
233             {
234 57     57 1 2714329 my ($self,$object,$attribute,$object_id,$foreign_object_ids) = @_;
235              
236             # Get class name
237 57   33     1667 my $class = $object->source_name || ref($object);
238              
239 57         11209 my @primary_keys = $object->primary_columns;
240              
241             my %relationships
242 57         11167 = ( map { $_,$object->relationship_info($_) } $object->relationships );
  151         15719  
243              
244 57         2941 my %id_fields = ();
245 57         149 foreach my $primary_key ( @primary_keys ) {
246             # Field is foreign key
247 62 100       270 if ( exists $relationships{$primary_key} ) {
248 10         34 $id_fields{$primary_key} = $foreign_object_ids->{$primary_key};
249             }
250             # Field is local
251             else {
252 52 100 66     1235 $id_fields{$primary_key}
253             = ( ref($object) && $object->$primary_key )
254             ? $object->$primary_key
255             : 'new';
256             }
257             }
258              
259             # Build object key
260             my $fieldname = join('|',
261             'dbic',
262             $object_id,
263             $class,
264 57   100     2233 join(q{;}, map { "$_:".$id_fields{$_} } keys %id_fields),
  62         403  
265             ($attribute || ''),
266             );
267              
268 57         463 return($fieldname);
269             }
270              
271              
272             =head2 C<formdata_to_object_hash>
273              
274             Arguments: \%formdata
275              
276             my @objects = $formtool->formdata_to_objects($formdata);
277              
278             Turn formdata(a querystring) in the form of a C<HASHREF> into an C<HASHREF> of
279             C<DBIx::Class> objects indexed by object_id.
280              
281             =cut
282             sub formdata_to_object_hash
283             {
284 7     7 1 9357 my ($self,$formdata) = @_;
285             # my $to_object_indent = indent();
286 7         20 my $objects = {};
287             my $rs = $self->schema->txn_do(sub{
288             # Cleanup old objects
289 7     7   15670 $self->_objects({});
290 7         231 $self->_formdata({});
291 7         267 $self->_delayed_attributes({});
292              
293             # Extract all dbic fields
294 7         41 my @dbic_formkeys = grep { /^dbic\|/ } keys %$formdata;
  43         128  
295              
296             # Create a todo list with one entry for each unique objects
297 7         50 my $to_be_inflated = {};
298              
299             # Sort data into piles for later object creation/updating
300 7         24 foreach my $formkey ( @dbic_formkeys ) {
301 43         187 my ($prefix,$object_id,$class,$id,$attribute) = split(/\|/,$formkey);
302              
303             # Store form value for $attribute
304 43 100       116 if ( $attribute ) {
305 41         122 my $real_attribute = $self->_get_real_attribute_from_class($class,$attribute);
306              
307 41         1219 my $metadata = $self->schema->source($class)->column_info($real_attribute);
308 41         2960 my $value = $formdata->{$formkey};
309              
310             # Handle empty fields for numeric attributes
311 41 50 33     122 $value = undef if !$value && $self->schema->storage->is_datatype_numeric($metadata->{data_type});
312              
313             # Handle empty fields for date attributes
314 41 0 33     91 $value = undef if !$value && exists($metadata->{_ic_dt_method});
315              
316             # Store value
317 41         1190 $self->_formdata->{$object_id}->{'content'}->{$real_attribute} = $value;
318             }
319              
320             # Build id field
321 43         80 my %id;
322 43         124 foreach my $field ( split(/;/,$id) ) {
323 46         126 my ($key,$value) = split(/:/,$field);
324 46         173 $id{$key} = $value;
325             }
326              
327             # Store id field
328 43         1226 $self->_formdata->{$object_id}->{'form_id'} = \%id;
329              
330             # Save class name and oid in the todo list
331             # println "$class | $object_id";
332 43         261 $to_be_inflated->{"$class|$object_id"} = {
333             class => $class,
334             object_id => $object_id,
335             };
336             }
337              
338             # Build objects from form data
339 7         41 foreach my $todo ( values %$to_be_inflated ) {
340             my $object = $self->_inflate_object(
341             $todo->{ 'object_id' },
342 19         69 $todo->{ 'class' },
343             );
344 19         108 $objects->{ $todo->{ 'object_id' } } = $object;
345             }
346 7         287 });
347              
348 7         3030 foreach my $oid ( keys %{$self->_delayed_attributes} ) {
  7         270  
349             # println "Setting delayed attributes for '$oid'";
350 6         15 foreach my $accessor ( keys %{$self->_delayed_attributes->{$oid}} ) {
  6         186  
351             # println "- ",ref($objects->{$oid}),"->$accessor( ",ref($self->_delayed_attributes->{$oid}{$accessor})," )";
352 10         3002 $objects->{$oid}->$accessor($self->_delayed_attributes->{$oid}{$accessor});
353             }
354             }
355              
356             # Cleanup old objects
357 7         3854 $self->_objects({});
358 7         203 $self->_formdata({});
359              
360 7         22 return($objects);
361             }
362              
363             =head2 C<formdata_to_objects>
364              
365             Arguments: \%formdata
366              
367             my @objects = $formtool->formdata_to_objects($formdata);
368              
369             Turn formdata(a querystring) in the form of a C<HASHREF> into an C<ARRAY> of
370             C<DBIx::Class> objects.
371              
372             =cut
373             sub formdata_to_objects {
374 2     2 1 2585 my ($self,$formdata,$inflate_only) = @_;
375 2         9 my $hash = $self->formdata_to_object_hash($formdata,$inflate_only);
376 2         13 return values %$hash;
377             }
378              
379             sub _get_real_attribute_from_class {
380 67     67   143 my ($self,$class,$attribute) = @_;
381              
382             # Get relationship info for the attribute
383 67         1870 my $relationship_info = $self->schema->source($class)->relationship_info($attribute);
384              
385             # Resolve the actual column name in the table (e.g. a relation named 'location' might be called 'location_id' in the result_source)
386             my $real_attribute = ( $relationship_info && $relationship_info->{attrs}{accessor} eq 'filter' ) ? $attribute
387 67 100 100     4837 : ( $relationship_info && $relationship_info->{attrs}{accessor} eq 'single' ) ? (keys %{$relationship_info->{'attrs'}{'fk_columns'}})[0]
  11 100 66     59  
388             : $attribute;
389 67         165 return $real_attribute;
390             }
391              
392             sub _flatten_id
393             {
394 0     0   0 my ($id) = @_;
395              
396 0         0 return join(';', map { $_.':'.$id->{$_} } sort keys %$id);
  0         0  
397             }
398              
399             sub _inflate_object
400             {
401 29     29   77 my ($self,$oid,$class) = @_;
402             # my $inflate_indent = indent();
403             # println "[$oid] _inflate_object - Begin";
404 29         47 my $id;
405 29         57 my $attributes = {};
406              
407             # Object exists in form
408 29 100       855 if ( exists($self->_formdata->{$oid}) ) {
409 28         793 $id = $self->_formdata->{$oid}->{'form_id'};
410 28         798 $attributes = $self->_formdata->{$oid}->{'content'};
411             }
412             # oid does not exist in the formdata, use oid is a real id
413             else {
414 1         3 $id = { id => $oid };
415             }
416              
417             # We must have an attribute hash if we want to call 'new' later on
418 29 100       100 $attributes = {} unless $attributes;
419              
420             # Return object if is already inflated
421             return $self->_objects->{$class}->{$oid}
422 29 100 100     825 if ( $self->_objects->{$class} && $self->_objects->{$class}->{$oid} );
423              
424             # Build a lookup hash of fields that are relationship fields
425             my $relationships = {
426 20         575 map { $_,$self->schema->source($class)->relationship_info($_) }
  39         3694  
427             $self->schema->source($class)->relationships
428             };
429              
430             # Inflate foreign fields that map to a *single* column
431 20         1325 my $todo_delayed_attributes = {};
432 20         87 foreach my $foreign_accessor ( keys %$relationships ) {
433             # Resolve foreign class name
434 39         1135 my $foreign_class = $self->schema->source($relationships->{$foreign_accessor}->{'class'})->result_class;
435 39         3634 my $foreign_relation_type = $relationships->{$foreign_accessor}->{'attrs'}->{'accessor'};
436             # println "[$oid] Processing $foreign_accessor for $foreign_class";
437              
438             # Do not process multicolumn relationships, they will be processed
439             # seperatly when the object to which they relate is inflated
440             # I.e. only process "local" attributes
441 39 100       108 next if $foreign_relation_type eq 'multi';
442              
443             # Resolve the actual column name in the table (e.g. a relation named 'location' might be called 'location_id')
444 26         80 my $real_foreign_accessor = $self->_get_real_attribute_from_class($class,$foreign_accessor);
445              
446             # Lookup foreign object id or real id, if the foreign object has already been inflated
447             my $foreign_oid = ( exists($self->_formdata->{$oid}{'form_id'}{$real_foreign_accessor}) )
448             ? $self->_formdata->{$oid}{'form_id'}{$real_foreign_accessor}
449 26 100       759 : $self->_formdata->{$oid}{'content'}{$real_foreign_accessor};
450              
451             # say "Formdata for local object: ".pp($self->_formdata);
452             # println "[$oid] Foreign oid to inflate ", $foreign_oid;
453             # println pp($self->_formdata->{$oid});
454              
455             # No id found, no inflate needed
456 26 100       90 next unless $foreign_oid;
457              
458 10         92 my $foreign_object = $self->_inflate_object(
459             $foreign_oid,
460             $foreign_class,
461             );
462              
463             # Store object for later use
464 10         290 $self->_objects->{$foreign_class}->{$oid} = $foreign_object;
465              
466             # If the field is part of the id then store it there as well
467 10 100       151 $id->{$foreign_accessor} = $foreign_object->id if exists $id->{$foreign_accessor};
468              
469             # If the inflated foreign object is new, its 'id' will be undefined.
470             # Therefore we delay adding the foreign object to the local object, until the local object have been inflated or created.
471             # println "[$oid] Delaying setting $foreign_accessor to ".ref($foreign_object);
472 10         448 $self->_delayed_attributes->{$oid}{$foreign_accessor} = $foreign_object;
473             # $attributes->{$real_foreign_accessor} = $foreign_object->id;
474             }
475             # All foreign objects have been now been inflated
476              
477             # Look up object in memory
478 20         555 my $object = $self->_objects->{$class}->{$oid};
479              
480             # Lookup in object in db
481 20 50       70 unless ( $object ) {
482 20         559 my $source = $self->schema->source($class);
483             # Don't lookup object if id is 'new'
484             $object = $self->schema->resultset($source->source_name)->find($id)
485 20 100       1255 unless grep { defined($id->{$_}) && $id->{$_} eq 'new' } $source->primary_columns;
  23 100       550  
486             }
487              
488             # Still no object, the create it
489 20 100       64172 unless ( $object ) {
490 13         461 $object = $self->schema->resultset($class)->new($attributes);
491             }
492              
493             # If we have a object update it with form data, if it exists
494             # println "[$oid] We have an object: ".ref($object).", add to todo list";
495             # println "[$oid] Attributes: ".pp($attributes);
496 20 50 33     6417 $object->set_columns($attributes) if $object && $attributes;
497              
498             # Store object for later use
499 20 50 33     6971 if ( $id && $object ) {
500             # say "Storing object ".ref($object)." for later use.";
501 20         768 $self->_objects->{$class}->{$oid} = $object;
502             }
503             # println "[$oid] _inflate_object - End";
504 20         78 return($object);
505             }
506              
507             1; # Magic true value required at end of module
508             __END__
509              
510             =head2 meta
511              
512             This is a method which provides access to the current class's metaclass.
513              
514             =head1 CAVEATS
515              
516             =head2 Transactions
517              
518             When using this module it is prudent that you use a database that supports
519             transactions.
520              
521             The reason why this is important, is that when calling C<formdata_to_objects>,
522             C<DBIx::Class::Row-E<gt>create()> is called foreach nonexistent object in
523             order to get the C<primary key> filled in. This call to C<create> results in a
524             SQL C<insert> statement, and might leave you with one object successfully put
525             into the database and one that generates an error - Transactions will allow
526             you to examine the C<ARRAY> of objects returned from C<formdata_to_objects>
527             before actually storing them in the database.
528              
529             =head2 Automatic Primary Key generation
530              
531             You must use C<DBIx::Class::PK::Auto>, otherwise the C<formdata_to_objects>
532             will fail when creating new objects, as it is unable to determine the value
533             for the primary key, and therefore is unable to connect the object to any
534             related objects in the form.
535              
536             =head1 BUGS AND LIMITATIONS
537              
538             No bugs have been reported.
539              
540             Please report any bugs or feature requests to
541             C<bug-dbix-class-formtools@rt.cpan.org>, or through the web interface at
542             L<http://rt.cpan.org>.
543              
544             =head1 AUTHOR
545              
546             David Jack Olrik C<< <djo@cpan.org> >>
547              
548             =head1 LICENCE AND COPYRIGHT
549              
550             Copyright (c) 2006, David Jack Olrik C<< <djo@cpan.org> >>.
551             All rights reserved.
552              
553             This module is free software; you can redistribute it and/or
554             modify it under the same terms as Perl itself. See L<perlartistic>.
555              
556             =head1 TODO
557              
558             =over
559              
560             =item * Add form object, that keeps track of object ids automagickly.
561              
562             =item * Add field generator, that can generate HTML/XHTML fields based on the
563             objects in the form object.
564              
565             =back
566              
567             =head1 SEE ALSO
568              
569             L<DBIx::Class> L<DBIx::Class::PK::Auto>