Report coverage to Codecov as well as Coveralls
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / SQLite.pm
CommitLineData
758ab1cd 1package SQL::Translator::Producer::SQLite;
2
20770e44 3=head1 NAME
4
5SQL::Translator::Producer::SQLite - SQLite producer for SQL::Translator
6
7=head1 SYNOPSIS
8
9 use SQL::Translator;
10
11 my $t = SQL::Translator->new( parser => '...', producer => 'SQLite' );
12 $t->translate;
13
14=head1 DESCRIPTION
15
16This module will produce text output of the schema suitable for SQLite.
17
18=cut
19
758ab1cd 20use strict;
d0fcb05d 21use warnings;
758ab1cd 22use Data::Dumper;
b21bf652 23use SQL::Translator::Schema::Constants;
86609eaa 24use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements);
27df230e 25use SQL::Translator::Generator::DDL::SQLite;
758ab1cd 26
0c04c5a2 27our ( $DEBUG, $WARN );
0c04c5a2 28our $VERSION = '1.59';
11ad2df9 29$DEBUG = 0 unless defined $DEBUG;
30$WARN = 0 unless defined $WARN;
758ab1cd 31
11ad2df9 32our $max_id_length = 30;
ae602737 33my %global_names;
2d23c1e1 34
35# HIDEOUS TEMPORARY DEFAULT WITHOUT QUOTING!
36our $NO_QUOTES = 1;
37{
38
39 my ($quoting_generator, $nonquoting_generator);
40 sub _generator {
41 $NO_QUOTES
42 ? $nonquoting_generator ||= SQL::Translator::Generator::DDL::SQLite->new(quote_chars => [])
43 : $quoting_generator ||= SQL::Translator::Generator::DDL::SQLite->new
44 }
45}
758ab1cd 46
758ab1cd 47sub produce {
a1d94525 48 my $translator = shift;
49 local $DEBUG = $translator->debug;
50 local $WARN = $translator->show_warnings;
51 my $no_comments = $translator->no_comments;
52 my $add_drop_table = $translator->add_drop_table;
53 my $schema = $translator->schema;
d12f72ff 54 my $producer_args = $translator->producer_args;
7b4b17aa 55 my $sqlite_version = parse_dbms_version(
56 $producer_args->{sqlite_version}, 'perl'
57 );
f9c96971 58 my $no_txn = $producer_args->{no_transaction};
758ab1cd 59
1a24938d 60 debug("PKG: Beginning production\n");
758ab1cd 61
ae602737 62 %global_names = (); #reset
63
2d23c1e1 64 # only quote if quotes were requested for real
65 # 0E0 indicates "the default of true" was assumed
66 local $NO_QUOTES = 0
67 if $translator->quote_identifiers and $translator->quote_identifiers ne '0E0';
b6b0696f 68
69 my $head = (header_comment() . "\n") unless $no_comments;
70
24d9fe69 71 my @create = ();
b6b0696f 72
73 push @create, "BEGIN TRANSACTION" unless $no_txn;
758ab1cd 74
b21bf652 75 for my $table ( $schema->get_tables ) {
24d9fe69 76 push @create, create_table($table, { no_comments => $no_comments,
d12f72ff 77 sqlite_version => $sqlite_version,
4d438549 78 add_drop_table => $add_drop_table,});
a5a882f0 79 }
80
ec59a597 81 for my $view ( $schema->get_views ) {
24d9fe69 82 push @create, create_view($view, {
a25ac5d2 83 add_drop_view => $add_drop_table,
84 no_comments => $no_comments,
85 });
ec59a597 86 }
87
d0fcb05d 88 for my $trigger ( $schema->get_triggers ) {
89 push @create, create_trigger($trigger, {
90 add_drop_trigger => $add_drop_table,
91 no_comments => $no_comments,
92 });
93 }
94
b6b0696f 95 push @create, "COMMIT" unless $no_txn;
96
f9c96971 97 if (wantarray) {
b6b0696f 98 return ($head||(), @create);
f9c96971 99 } else {
b6b0696f 100 return join ('',
101 $head||(),
102 join(";\n\n", @create ),
103 ";\n",
104 );
f9c96971 105 }
758ab1cd 106}
107
758ab1cd 108sub mk_name {
ae602737 109 my ($name, $scope, $critical) = @_;
758ab1cd 110
111 $scope ||= \%global_names;
112 if ( my $prev = $scope->{ $name } ) {
113 my $name_orig = $name;
114 $name .= sprintf( "%02d", ++$prev );
ea93df61 115 substr($name, $max_id_length - 3) = "00"
11ad2df9 116 if length( $name ) > $max_id_length;
758ab1cd 117
118 warn "The name '$name_orig' has been changed to ",
119 "'$name' to make it unique.\n" if $WARN;
120
121 $scope->{ $name_orig }++;
122 }
123
124 $scope->{ $name }++;
2d23c1e1 125 return _generator()->quote($name);
758ab1cd 126}
127
ec59a597 128sub create_view {
129 my ($view, $options) = @_;
a25ac5d2 130 my $add_drop_view = $options->{add_drop_view};
ec59a597 131
2d23c1e1 132 my $view_name = _generator()->quote($view->name);
d8cf2279 133 $global_names{$view->name} = 1;
56785c01 134
ec59a597 135 debug("PKG: Looking at view '${view_name}'\n");
136
137 # Header. Should this look like what mysqldump produces?
138 my $extra = $view->extra;
4c0d31c1 139 my @create;
140 push @create, "DROP VIEW IF EXISTS $view_name" if $add_drop_view;
141
142 my $create_view = 'CREATE';
143 $create_view .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
144 $create_view .= ' VIEW';
145 $create_view .= " IF NOT EXISTS" if exists($extra->{if_not_exists}) && $extra->{if_not_exists};
146 $create_view .= " ${view_name}";
ec59a597 147
148 if( my $sql = $view->sql ){
4c0d31c1 149 $create_view .= " AS\n ${sql}";
ec59a597 150 }
4c0d31c1 151 push @create, $create_view;
152
153 # Tack the comment onto the first statement.
154 unless ($options->{no_comments}) {
155 $create[0] = "--\n-- View: ${view_name}\n--\n" . $create[0];
156 }
157
158 return @create;
ec59a597 159}
160
161
bfb5a568 162sub create_table
163{
164 my ($table, $options) = @_;
758ab1cd 165
2d23c1e1 166 my $table_name = _generator()->quote($table->name);
d8cf2279 167 $global_names{$table->name} = 1;
56785c01 168
bfb5a568 169 my $no_comments = $options->{no_comments};
170 my $add_drop_table = $options->{add_drop_table};
3db73ef8 171 my $sqlite_version = $options->{sqlite_version} || 0;
bfb5a568 172
173 debug("PKG: Looking at table '$table_name'\n");
174
d0fcb05d 175 my ( @index_defs, @constraint_defs );
bfb5a568 176 my @fields = $table->get_fields or die "No fields in $table_name";
177
4d438549 178 my $temp = $options->{temporary_table} ? 'TEMPORARY ' : '';
bfb5a568 179 #
180 # Header.
181 #
7b4b17aa 182 my $exists = ($sqlite_version >= 3.003) ? ' IF EXISTS' : '';
24d9fe69 183 my @create;
d0fcb05d 184 my ($comment, $create_table) = "";
185 $comment = "--\n-- Table: $table_name\n--\n" unless $no_comments;
186 if ($add_drop_table) {
187 push @create, $comment . qq[DROP TABLE$exists $table_name];
188 } else {
189 $create_table = $comment;
190 }
191
192 $create_table .= "CREATE ${temp}TABLE $table_name (\n";
bfb5a568 193
194 #
195 # Comments
196 #
197 if ( $table->comments and !$no_comments ){
24d9fe69 198 $create_table .= "-- Comments: \n-- ";
199 $create_table .= join "\n-- ", $table->comments;
200 $create_table .= "\n--\n\n";
bfb5a568 201 }
202
203 #
204 # How many fields in PK?
205 #
206 my $pk = $table->primary_key;
207 my @pk_fields = $pk ? $pk->fields : ();
208
209 #
210 # Fields
211 #
212 my ( @field_defs, $pk_set );
213 for my $field ( @fields ) {
214 push @field_defs, create_field($field);
215 }
216
ea93df61 217 if (
218 scalar @pk_fields > 1
219 ||
220 ( @pk_fields && !grep /INTEGER PRIMARY KEY/, @field_defs )
bfb5a568 221 ) {
2d23c1e1 222 push @field_defs, 'PRIMARY KEY (' . join(', ', map _generator()->quote($_), @pk_fields ) . ')';
bfb5a568 223 }
224
225 #
226 # Indices
227 #
bfb5a568 228 for my $index ( $table->get_indices ) {
229 push @index_defs, create_index($index);
230 }
231
232 #
233 # Constraints
234 #
bfb5a568 235 for my $c ( $table->get_constraints ) {
0dbd2362 236 if ($c->type eq "FOREIGN KEY") {
237 push @field_defs, create_foreignkey($c);
238 }
e773f3ff 239 elsif ($c->type eq "CHECK") {
240 push @field_defs, create_check_constraint($c);
241 }
ea93df61 242 next unless $c->type eq UNIQUE;
bfb5a568 243 push @constraint_defs, create_constraint($c);
244 }
245
24d9fe69 246 $create_table .= join(",\n", map { " $_" } @field_defs ) . "\n)";
bfb5a568 247
d0fcb05d 248 return (@create, $create_table, @index_defs, @constraint_defs );
bfb5a568 249}
250
e773f3ff 251sub create_check_constraint {
252 my $c = shift;
253 my $check = '';
254 $check .= 'CONSTRAINT ' . _generator->quote( $c->name ) . ' ' if $c->name;
255 $check .= 'CHECK(' . $c->expression . ')';
256 return $check;
257}
258
0dbd2362 259sub create_foreignkey {
260 my $c = shift;
261
ea4a3ecc 262 my @fields = $c->fields;
263 my @rfields = map { $_ || () } $c->reference_fields;
264 unless ( @rfields ) {
265 my $rtable_name = $c->reference_table;
266 if ( my $ref_table = $c->schema->get_table( $rtable_name ) ) {
267 push @rfields, $ref_table->primary_key;
268
269 die "FK constraint on " . $rtable_name . '.' . join('', @fields) . " has no reference fields\n"
270 unless @rfields;
271 }
272 else {
273 die "Can't find reference table '$rtable_name' in schema\n";
274 }
275 }
276
277 my $fk_sql = sprintf 'FOREIGN KEY (%s) REFERENCES %s(%s)',
2d23c1e1 278 join (', ', map { _generator()->quote($_) } @fields ),
279 _generator()->quote($c->reference_table),
280 join (', ', map { _generator()->quote($_) } @rfields )
ea4a3ecc 281 ;
282
283 $fk_sql .= " ON DELETE " . $c->{on_delete} if $c->{on_delete};
284 $fk_sql .= " ON UPDATE " . $c->{on_update} if $c->{on_update};
0dbd2362 285
286 return $fk_sql;
287}
288
2d23c1e1 289sub create_field { return _generator()->field($_[0]) }
bfb5a568 290
291sub create_index
292{
293 my ($index, $options) = @_;
294
2491a467 295 (my $index_table_name = $index->table->name) =~ s/^.+?\.//; # table name may not specify schema
296 my $name = mk_name($index->name || "${index_table_name}_idx");
4d438549 297
ea93df61 298 my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : '';
bfb5a568 299
300 # strip any field size qualifiers as SQLite doesn't like these
2d23c1e1 301 my @fields = map { s/\(\d+\)$//; _generator()->quote($_) } $index->fields;
2d23c1e1 302 $index_table_name = _generator()->quote($index_table_name);
cc74bccc 303 warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN;
ea93df61 304 my $index_def =
907f8cea 305 "CREATE ${type}INDEX $name ON " . $index_table_name .
306 ' (' . join( ', ', @fields ) . ')';
bfb5a568 307
308 return $index_def;
309}
310
311sub create_constraint
312{
313 my ($c, $options) = @_;
314
cc74bccc 315 (my $index_table_name = $c->table->name) =~ s/^.+?\.//; # table name may not specify schema
2491a467 316 my $name = mk_name($c->name || "${index_table_name}_idx");
317 my @fields = map _generator()->quote($_), $c->fields;
2d23c1e1 318 $index_table_name = _generator()->quote($index_table_name);
cc74bccc 319 warn "removing schema name from '" . $c->table->name . "' to make '$index_table_name'\n" if $WARN;
bfb5a568 320
ea93df61 321 my $c_def =
907f8cea 322 "CREATE UNIQUE INDEX $name ON " . $index_table_name .
323 ' (' . join( ', ', @fields ) . ')';
bfb5a568 324
325 return $c_def;
326}
327
d0fcb05d 328sub create_trigger {
329 my ($trigger, $options) = @_;
330 my $add_drop = $options->{add_drop_trigger};
331
410d4a42 332 my @statements;
d0fcb05d 333
410d4a42 334 my $trigger_name = $trigger->name;
56785c01 335 $global_names{$trigger_name} = 1;
336
d0fcb05d 337 my $events = $trigger->database_events;
410d4a42 338 for my $evt ( @$events ) {
d0fcb05d 339
410d4a42 340 my $trig_name = $trigger_name;
341 if (@$events > 1) {
342 $trig_name .= "_$evt";
d0fcb05d 343
410d4a42 344 warn "Multiple database events supplied for trigger '$trigger_name', ",
345 "creating trigger '$trig_name' for the '$evt' event.\n" if $WARN;
346 }
d0fcb05d 347
2d23c1e1 348 $trig_name = _generator()->quote($trig_name);
410d4a42 349 push @statements, "DROP TRIGGER IF EXISTS $trig_name" if $add_drop;
d0fcb05d 350
f9c96971 351
410d4a42 352 $DB::single = 1;
353 my $action = "";
354 if (not ref $trigger->action) {
e533bcdd 355 $action = $trigger->action;
356 $action = "BEGIN " . $action . " END"
357 unless $action =~ /^ \s* BEGIN [\s\;] .*? [\s\;] END [\s\;]* $/six;
f9c96971 358 }
410d4a42 359 else {
360 $action = $trigger->action->{for_each} . " "
361 if $trigger->action->{for_each};
362
363 $action = $trigger->action->{when} . " "
364 if $trigger->action->{when};
d0fcb05d 365
410d4a42 366 my $steps = $trigger->action->{steps} || [];
367
368 $action .= "BEGIN ";
369 $action .= $_ . "; " for (@$steps);
370 $action .= "END";
371 }
372
373 push @statements, sprintf (
374 'CREATE TRIGGER %s %s %s on %s %s',
375 $trig_name,
376 $trigger->perform_action_when,
377 $evt,
2d23c1e1 378 _generator()->quote($trigger->on_table),
410d4a42 379 $action
380 );
381 }
d0fcb05d 382
410d4a42 383 return @statements;
d0fcb05d 384}
385
0444e686 386sub alter_table { () } # Noop
4d438549 387
388sub add_field {
389 my ($field) = @_;
390
391 return sprintf("ALTER TABLE %s ADD COLUMN %s",
2d23c1e1 392 _generator()->quote($field->table->name), create_field($field))
4d438549 393}
394
395sub alter_create_index {
396 my ($index) = @_;
397
398 # This might cause name collisions
399 return create_index($index);
400}
401
402sub alter_create_constraint {
403 my ($constraint) = @_;
404
405 return create_constraint($constraint) if $constraint->type eq 'UNIQUE';
406}
407
408sub alter_drop_constraint { alter_drop_index(@_) }
409
410sub alter_drop_index {
411 my ($constraint) = @_;
412
ecf7f25d 413 return sprintf("DROP INDEX %s",
2d23c1e1 414 _generator()->quote($constraint->name));
4d438549 415}
416
417sub batch_alter_table {
86609eaa 418 my ($table, $diffs, $options) = @_;
4d438549 419
4d438549 420 # If we have any of the following
421 #
422 # rename_field
423 # alter_field
424 # drop_field
425 #
426 # we need to do the following <http://www.sqlite.org/faq.html#q11>
427 #
428 # BEGIN TRANSACTION;
429 # CREATE TEMPORARY TABLE t1_backup(a,b);
430 # INSERT INTO t1_backup SELECT a,b FROM t1;
431 # DROP TABLE t1;
432 # CREATE TABLE t1(a,b);
433 # INSERT INTO t1 SELECT a,b FROM t1_backup;
434 # DROP TABLE t1_backup;
435 # COMMIT;
436 #
437 # Fun, eh?
46bf5655 438 #
439 # If we have rename_field we do similarly.
0ce31813 440 #
441 # We create the temporary table as a copy of the new table, copy all data
442 # to temp table, create new table and then copy as appropriate taking note
443 # of renamed fields.
46bf5655 444
445 my $table_name = $table->name;
4d438549 446
447 if ( @{$diffs->{rename_field}} == 0 &&
448 @{$diffs->{alter_field}} == 0 &&
46bf5655 449 @{$diffs->{drop_field}} == 0
450 ) {
86609eaa 451 return batch_alter_table_statements($diffs, $options);
4d438549 452 }
453
4d438549 454 my @sql;
ea93df61 455
0ce31813 456 # $table is the new table but we may need an old one
457 # TODO: this is NOT very well tested at the moment so add more tests
458
459 my $old_table = $table;
460
461 if ( $diffs->{rename_table} && @{$diffs->{rename_table}} ) {
462 $old_table = $diffs->{rename_table}[0][0];
1e54de2f 463 }
464
0ce31813 465 my $temp_table_name = $table_name . '_temp_alter';
466
467 # CREATE TEMPORARY TABLE t1_backup(a,b);
468
1e54de2f 469 my %temp_table_fields;
4d438549 470 do {
0ce31813 471 local $table->{name} = $temp_table_name;
5db972d2 472 # We only want the table - don't care about indexes on tmp table
4d438549 473 my ($table_sql) = create_table($table, {no_comments => 1, temporary_table => 1});
474 push @sql,$table_sql;
1e54de2f 475
476 %temp_table_fields = map { $_ => 1} $table->get_fields;
4d438549 477 };
478
0ce31813 479 # record renamed fields for later
480 my %rename_field = map { $_->[1]->name => $_->[0]->name } @{$diffs->{rename_field}};
481
482 # drop added fields from %temp_table_fields
483 delete @temp_table_fields{@{$diffs->{add_field}}};
484
485 # INSERT INTO t1_backup SELECT a,b FROM t1;
486
487 push @sql, sprintf( 'INSERT INTO %s( %s) SELECT %s FROM %s',
488
489 _generator()->quote( $temp_table_name ),
490
491 join( ', ',
492 map _generator()->quote($_),
493 grep { $temp_table_fields{$_} } $table->get_fields ),
494
495 join( ', ',
496 map _generator()->quote($_),
497 map { $rename_field{$_} ? $rename_field{$_} : $_ }
498 grep { $temp_table_fields{$_} } $table->get_fields ),
499
500 _generator()->quote( $old_table->name )
501 );
502
503 # DROP TABLE t1;
504
505 push @sql, sprintf('DROP TABLE %s', _generator()->quote($old_table->name));
506
507 # CREATE TABLE t1(a,b);
508
509 push @sql, create_table($table, { no_comments => 1 });
510
511 # INSERT INTO t1 SELECT a,b FROM t1_backup;
512
513 push @sql, sprintf('INSERT INTO %s SELECT %s FROM %s',
514 _generator()->quote($table_name),
515 join(', ', map _generator()->quote($_), $table->get_fields),
516 _generator()->quote($temp_table_name)
517 );
518
519 # DROP TABLE t1_backup;
520
521 push @sql, sprintf('DROP TABLE %s', _generator()->quote($temp_table_name));
522
523 return wantarray ? @sql : join(";\n", @sql);
4d438549 524}
525
526sub drop_table {
527 my ($table) = @_;
2d23c1e1 528 $table = _generator()->quote($table);
24d9fe69 529 return "DROP TABLE $table";
4d438549 530}
531
46bf5655 532sub rename_table {
533 my ($old_table, $new_table, $options) = @_;
534
2d23c1e1 535 $old_table = _generator()->quote($old_table);
536 $new_table = _generator()->quote($new_table);
46bf5655 537
d8cf2279 538 return "ALTER TABLE $old_table RENAME TO $new_table";
46bf5655 539
540}
541
934e1b39 542# No-op. Just here to signify that we are a new style parser.
543sub preproces_schema { }
544
bfb5a568 5451;
758ab1cd 546
20770e44 547=pod
548
549=head1 SEE ALSO
550
551SQL::Translator, http://www.sqlite.org/.
758ab1cd 552
553=head1 AUTHOR
554
11ad2df9 555Ken Youens-Clark C<< <kclark@cpan.orgE> >>.
4d438549 556
557Diff code added by Ash Berlin C<< <ash@cpan.org> >>.
20770e44 558
559=cut