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> |