.
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Returns true if the model was added successfully; returns a false |
|
163
|
|
|
|
|
|
|
C error otherwise. |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=cut |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub add_model { |
|
168
|
14
|
|
|
14
|
1
|
2113
|
my $self = shift; |
|
169
|
14
|
|
|
|
|
11
|
my $model = shift; |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# $model could either be a (presumably unfilled) object of a subclass of |
|
172
|
|
|
|
|
|
|
# Jifty::DBI::Record, or it could be the name of such a subclass. |
|
173
|
|
|
|
|
|
|
|
|
174
|
14
|
100
|
66
|
|
|
46
|
unless ( ref $model and UNIVERSAL::isa( $model, 'Jifty::DBI::Record' ) ) { |
|
175
|
12
|
|
|
|
|
7
|
my $new_model; |
|
176
|
12
|
|
|
|
|
9
|
eval { $new_model = $model->new; }; |
|
|
12
|
|
|
|
|
45
|
|
|
177
|
|
|
|
|
|
|
|
|
178
|
12
|
100
|
|
|
|
15
|
if ($@) { |
|
179
|
1
|
|
|
|
|
5
|
return $self->_error("Error making new object from $model: $@"); |
|
180
|
|
|
|
|
|
|
} |
|
181
|
|
|
|
|
|
|
|
|
182
|
11
|
50
|
|
|
|
28
|
unless ( UNIVERSAL::isa( $new_model, 'Jifty::DBI::Record' ) ) { |
|
183
|
0
|
|
|
|
|
0
|
return $self->_error( |
|
184
|
|
|
|
|
|
|
"Didn't get a Jifty::DBI::Record from $model, got $new_model" |
|
185
|
|
|
|
|
|
|
); |
|
186
|
|
|
|
|
|
|
} |
|
187
|
11
|
|
|
|
|
9
|
$model = $new_model; |
|
188
|
|
|
|
|
|
|
} |
|
189
|
|
|
|
|
|
|
|
|
190
|
13
|
|
|
|
|
19
|
my $table_obj = $self->_db_schema_table_from_model($model); |
|
191
|
|
|
|
|
|
|
|
|
192
|
13
|
|
|
|
|
23
|
$self->_db_schema->addtable($table_obj); |
|
193
|
|
|
|
|
|
|
|
|
194
|
13
|
|
|
|
|
138
|
return 1; |
|
195
|
|
|
|
|
|
|
} |
|
196
|
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head2 column_definition_sql TABLENAME COLUMNNAME |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
Given a table name and a column name, returns the SQL fragment |
|
200
|
|
|
|
|
|
|
describing that column for the current database. |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=cut |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub column_definition_sql { |
|
205
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
206
|
0
|
|
|
|
|
0
|
my $table = shift; |
|
207
|
0
|
|
|
|
|
0
|
my $col = shift; |
|
208
|
0
|
|
|
|
|
0
|
my $table_obj = $self->_db_schema->table($table); |
|
209
|
0
|
|
|
|
|
0
|
return $table_obj->column( $col )->line( $self->handle->dbh ) |
|
210
|
|
|
|
|
|
|
} |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=head2 create_table_sql_statements |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Returns a list of SQL statements (as strings) to create tables for all of |
|
215
|
|
|
|
|
|
|
the models added to the SchemaGenerator. |
|
216
|
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=cut |
|
218
|
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub create_table_sql_statements { |
|
220
|
17
|
|
|
17
|
1
|
508
|
my $self = shift; |
|
221
|
|
|
|
|
|
|
|
|
222
|
22
|
|
|
|
|
4993
|
return map { $self->_db_schema->table($_)->sql_create_table($self->handle->dbh) } |
|
|
10
|
|
|
|
|
39
|
|
|
223
|
17
|
|
|
|
|
34
|
sort { $a cmp $b } |
|
224
|
|
|
|
|
|
|
$self->_db_schema->tables; |
|
225
|
|
|
|
|
|
|
} |
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head2 create_table_sql_text |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
Returns a string containing a sequence of SQL statements to create tables for all of |
|
230
|
|
|
|
|
|
|
the models added to the SchemaGenerator. |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
This is just a trivial wrapper around L. |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=cut |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub create_table_sql_text { |
|
237
|
16
|
|
|
16
|
1
|
6883
|
my $self = shift; |
|
238
|
|
|
|
|
|
|
|
|
239
|
16
|
|
|
|
|
33
|
return join "\n", map {"$_ ;\n"} $self->create_table_sql_statements; |
|
|
22
|
|
|
|
|
13464
|
|
|
240
|
|
|
|
|
|
|
} |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 PRIVATE _db_schema_table_from_model MODEL |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Takes an object of a subclass of Jifty::DBI::Record; returns a new |
|
245
|
|
|
|
|
|
|
C object corresponding to the model. |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=cut |
|
248
|
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub _db_schema_table_from_model { |
|
250
|
13
|
|
|
13
|
|
10
|
my $self = shift; |
|
251
|
13
|
|
|
|
|
11
|
my $model = shift; |
|
252
|
|
|
|
|
|
|
|
|
253
|
13
|
|
|
|
|
33
|
my $table_name = $model->table; |
|
254
|
13
|
|
|
|
|
73
|
my @columns = $model->columns; |
|
255
|
|
|
|
|
|
|
|
|
256
|
13
|
|
|
|
|
163
|
my @cols; |
|
257
|
|
|
|
|
|
|
my @indexes; |
|
258
|
|
|
|
|
|
|
|
|
259
|
13
|
|
|
|
|
15
|
for my $column (@columns) { |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# Skip "Virtual" columns - (foreign keys to collections) |
|
262
|
57
|
100
|
|
|
|
179
|
next if $column->virtual; |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# Skip computed columns |
|
265
|
51
|
100
|
|
|
|
163
|
next if $column->computed; |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# If schema_version is defined, make sure columns are for that version |
|
268
|
50
|
100
|
100
|
|
|
229
|
if ($model->can('schema_version') and defined $model->schema_version) { |
|
269
|
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# Skip it if the app version is earlier than the column version |
|
271
|
37
|
100
|
100
|
|
|
186
|
next if defined $column->since |
|
272
|
|
|
|
|
|
|
and $model->schema_version < version->new($column->since); |
|
273
|
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Skip it if the app version is the same as or later than the |
|
275
|
|
|
|
|
|
|
# column version |
|
276
|
36
|
100
|
100
|
|
|
219
|
next if defined $column->till |
|
277
|
|
|
|
|
|
|
and $model->schema_version >= version->new($column->till); |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
} |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# Otherwise, assume the latest version and eliminate till columns |
|
282
|
47
|
100
|
100
|
|
|
261
|
next if (!$model->can('schema_version') or !defined $model->schema_version) |
|
|
|
|
100
|
|
|
|
|
|
283
|
|
|
|
|
|
|
and defined $column->till; |
|
284
|
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# Encode default values |
|
286
|
45
|
|
|
|
|
238
|
my $default = $column->default; |
|
287
|
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# Scalar::Defer-powered defaults do not get a default in the database |
|
289
|
45
|
100
|
66
|
|
|
182
|
if (ref($default) ne '0' && defined $default) { |
|
290
|
6
|
|
|
|
|
10
|
$model->_handle($self->handle); |
|
291
|
6
|
|
|
|
|
17
|
$model->_apply_input_filters( |
|
292
|
|
|
|
|
|
|
column => $column, |
|
293
|
|
|
|
|
|
|
value_ref => \$default, |
|
294
|
|
|
|
|
|
|
); |
|
295
|
6
|
50
|
33
|
|
|
22
|
$default = \"''" if defined $default and not length $default; |
|
296
|
6
|
|
|
|
|
11
|
$model->_handle(undef); |
|
297
|
|
|
|
|
|
|
} else { |
|
298
|
39
|
|
|
|
|
38
|
$default = ''; |
|
299
|
|
|
|
|
|
|
} |
|
300
|
|
|
|
|
|
|
|
|
301
|
45
|
100
|
|
|
|
62
|
push @cols, |
|
302
|
|
|
|
|
|
|
DBIx::DBSchema::Column->new( |
|
303
|
|
|
|
|
|
|
{ name => $column->name, |
|
304
|
|
|
|
|
|
|
type => $column->type, |
|
305
|
|
|
|
|
|
|
null => $column->mandatory ? 0 : 1, |
|
306
|
|
|
|
|
|
|
default => $default, |
|
307
|
|
|
|
|
|
|
} |
|
308
|
|
|
|
|
|
|
); |
|
309
|
|
|
|
|
|
|
|
|
310
|
45
|
100
|
|
|
|
620
|
if ($column->indexed) { |
|
311
|
1
|
|
|
|
|
4
|
push @indexes,[$column->name]; |
|
312
|
|
|
|
|
|
|
} |
|
313
|
|
|
|
|
|
|
} |
|
314
|
|
|
|
|
|
|
|
|
315
|
13
|
|
|
|
|
96
|
my $index_count = 1; |
|
316
|
1
|
|
|
|
|
7
|
my $table = DBIx::DBSchema::Table->new( |
|
317
|
|
|
|
|
|
|
{ name => $table_name, |
|
318
|
|
|
|
|
|
|
primary_key => "id", |
|
319
|
|
|
|
|
|
|
columns => \@cols, |
|
320
|
13
|
100
|
|
|
|
55
|
(@indexes) ? (indices => [map {DBIx::DBSchema::Index->new(name => $table_name.$index_count++, columns => $_) } @indexes]) : () |
|
321
|
|
|
|
|
|
|
} |
|
322
|
|
|
|
|
|
|
); |
|
323
|
|
|
|
|
|
|
|
|
324
|
13
|
|
|
|
|
622
|
return $table; |
|
325
|
|
|
|
|
|
|
} |
|
326
|
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head2 PRIVATE _error STRING |
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Takes in a string and returns it as a Class::ReturnValue error object. |
|
330
|
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=cut |
|
332
|
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub _error { |
|
334
|
1
|
|
|
1
|
|
1
|
my $self = shift; |
|
335
|
1
|
|
|
|
|
1
|
my $message = shift; |
|
336
|
|
|
|
|
|
|
|
|
337
|
1
|
|
|
|
|
6
|
my $ret = Class::ReturnValue->new; |
|
338
|
1
|
|
|
|
|
5
|
$ret->as_error( errno => 1, message => $message ); |
|
339
|
1
|
|
|
|
|
498
|
return $ret->return_value; |
|
340
|
|
|
|
|
|
|
} |
|
341
|
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
1; # Magic true value required at end of module |
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
|
345
|
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
None reported. |
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
No bugs have been reported. |
|
351
|
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
|
353
|
|
|
|
|
|
|
CRT NAMEE@rt.cpan.org>, or through the web interface at |
|
354
|
|
|
|
|
|
|
L. |
|
355
|
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=head1 AUTHOR |
|
357
|
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
David Glasser C<< glasser@bestpractical.com >> |
|
359
|
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
Some pod by Eric Wilhelm |
|
361
|
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
|
363
|
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
Copyright (c) 2005, Best Practical Solutions, LLC. All rights reserved. |
|
365
|
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
|
367
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. See L. |
|
368
|
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTY |
|
370
|
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
|
372
|
|
|
|
|
|
|
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN |
|
373
|
|
|
|
|
|
|
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES |
|
374
|
|
|
|
|
|
|
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER |
|
375
|
|
|
|
|
|
|
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
|
376
|
|
|
|
|
|
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE |
|
377
|
|
|
|
|
|
|
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH |
|
378
|
|
|
|
|
|
|
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL |
|
379
|
|
|
|
|
|
|
NECESSARY SERVICING, REPAIR, OR CORRECTION. |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
|
382
|
|
|
|
|
|
|
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
|
383
|
|
|
|
|
|
|
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE |
|
384
|
|
|
|
|
|
|
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, |
|
385
|
|
|
|
|
|
|
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE |
|
386
|
|
|
|
|
|
|
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING |
|
387
|
|
|
|
|
|
|
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A |
|
388
|
|
|
|
|
|
|
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF |
|
389
|
|
|
|
|
|
|
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF |
|
390
|
|
|
|
|
|
|
SUCH DAMAGES. |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
|
393
|
|
|
|
|
|
|
|