[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / SQLite.pm

package SQL::Translator::Producer::SQLite;

=head1 NAME

SQL::Translator::Producer::SQLite - SQLite producer for SQL::Translator

=head1 SYNOPSIS

  use SQL::Translator;

  my $t = SQL::Translator->new( parser => '...', producer => 'SQLite' );
  $t->translate;

=head1 DESCRIPTION

This module will produce text output of the schema suitable for SQLite.

=cut

use strict;
use warnings;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
use SQL::Translator::Generator::Utils;
my $util = SQL::Translator::Generator::Utils->new( quote_chars => q(") );
use SQL::Translator::Generator::DDL::SQLite;

our ( $DEBUG, $WARN );
our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
$WARN = 0 unless defined $WARN;

our $max_id_length    = 30;
my %global_names;
my $future = SQL::Translator::Generator::DDL::SQLite->new();

sub produce {
    my $translator     = shift;
    local $DEBUG       = $translator->debug;
    local $WARN        = $translator->show_warnings;
    my $no_comments    = $translator->no_comments;
    my $add_drop_table = $translator->add_drop_table;
    my $schema         = $translator->schema;
    my $producer_args  = $translator->producer_args;
    my $sqlite_version = parse_dbms_version(
        $producer_args->{sqlite_version}, 'perl'
    );
    my $no_txn         = $producer_args->{no_transaction};

    debug("PKG: Beginning production\n");

    %global_names = ();   #reset


    my $head = (header_comment() . "\n") unless $no_comments;

    my @create = ();

    push @create, "BEGIN TRANSACTION" unless $no_txn;

    for my $table ( $schema->get_tables ) {
        push @create, create_table($table, { no_comments => $no_comments,
                                             sqlite_version => $sqlite_version,
                                          add_drop_table => $add_drop_table,});
    }

    for my $view ( $schema->get_views ) {
      push @create, create_view($view, {
        add_drop_view => $add_drop_table,
        no_comments   => $no_comments,
      });
    }

    for my $trigger ( $schema->get_triggers ) {
      push @create, create_trigger($trigger, {
        add_drop_trigger => $add_drop_table,
        no_comments   => $no_comments,
      });
    }

    push @create, "COMMIT" unless $no_txn;

    if (wantarray) {
      return ($head||(), @create);
    } else {
      return join ('',
        $head||(),
        join(";\n\n", @create ),
        ";\n",
      );
    }
}

sub mk_name {
    my ($name, $scope, $critical) = @_;

    $scope ||= \%global_names;
    if ( my $prev = $scope->{ $name } ) {
        my $name_orig = $name;
        $name        .= sprintf( "%02d", ++$prev );
        substr($name, $max_id_length - 3) = "00"
            if length( $name ) > $max_id_length;

        warn "The name '$name_orig' has been changed to ",
             "'$name' to make it unique.\n" if $WARN;

        $scope->{ $name_orig }++;
    }

    $scope->{ $name }++;
    return $util->quote($name);
}

sub create_view {
    my ($view, $options) = @_;
    my $add_drop_view = $options->{add_drop_view};

    my $view_name = $util->quote($view->name);
    $global_names{$view->name} = 1;

    debug("PKG: Looking at view '${view_name}'\n");

    # Header.  Should this look like what mysqldump produces?
    my $extra = $view->extra;
    my @create;
    push @create, "DROP VIEW IF EXISTS $view_name" if $add_drop_view;

    my $create_view = 'CREATE';
    $create_view .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
    $create_view .= ' VIEW';
    $create_view .= " IF NOT EXISTS" if exists($extra->{if_not_exists}) && $extra->{if_not_exists};
    $create_view .= " ${view_name}";

    if( my $sql = $view->sql ){
      $create_view .= " AS\n    ${sql}";
    }
    push @create, $create_view;

    # Tack the comment onto the first statement.
    unless ($options->{no_comments}) {
      $create[0] = "--\n-- View: ${view_name}\n--\n" . $create[0];
    }

    return @create;
}


sub create_table
{
    my ($table, $options) = @_;

    my $table_name = $util->quote($table->name);
    $global_names{$table->name} = 1;

    my $no_comments = $options->{no_comments};
    my $add_drop_table = $options->{add_drop_table};
    my $sqlite_version = $options->{sqlite_version} || 0;

    debug("PKG: Looking at table '$table_name'\n");

    my ( @index_defs, @constraint_defs );
    my @fields = $table->get_fields or die "No fields in $table_name";

    my $temp = $options->{temporary_table} ? 'TEMPORARY ' : '';
    #
    # Header.
    #
    my $exists = ($sqlite_version >= 3.003) ? ' IF EXISTS' : '';
    my @create;
    my ($comment, $create_table) = "";
    $comment =  "--\n-- Table: $table_name\n--\n" unless $no_comments;
    if ($add_drop_table) {
      push @create, $comment . qq[DROP TABLE$exists $table_name];
    } else {
      $create_table = $comment;
    }

    $create_table .= "CREATE ${temp}TABLE $table_name (\n";

    #
    # Comments
    #
    if ( $table->comments and !$no_comments ){
        $create_table .= "-- Comments: \n-- ";
        $create_table .= join "\n-- ",  $table->comments;
        $create_table .= "\n--\n\n";
    }

    #
    # How many fields in PK?
    #
    my $pk        = $table->primary_key;
    my @pk_fields = $pk ? $pk->fields : ();

    #
    # Fields
    #
    my ( @field_defs, $pk_set );
    for my $field ( @fields ) {
        push @field_defs, create_field($field);
    }

    if (
         scalar @pk_fields > 1
         ||
         ( @pk_fields && !grep /INTEGER PRIMARY KEY/, @field_defs )
         ) {
        push @field_defs, 'PRIMARY KEY (' . join(', ', map $util->quote($_), @pk_fields ) . ')';
    }

    #
    # Indices
    #
    my $idx_name_default = 'A';
    for my $index ( $table->get_indices ) {
        push @index_defs, create_index($index);
    }

    #
    # Constraints
    #
    my $c_name_default = 'A';
    for my $c ( $table->get_constraints ) {
        if ($c->type eq "FOREIGN KEY") {
            push @field_defs, create_foreignkey($c);
        }
        next unless $c->type eq UNIQUE;
        push @constraint_defs, create_constraint($c);
    }

    $create_table .= join(",\n", map { "  $_" } @field_defs ) . "\n)";

    return (@create, $create_table, @index_defs, @constraint_defs );
}

sub create_foreignkey {
    my $c = shift;

    my @fields = $c->fields;
    my @rfields = map { $_ || () } $c->reference_fields;
    unless ( @rfields ) {
        my $rtable_name = $c->reference_table;
        if ( my $ref_table = $c->schema->get_table( $rtable_name ) ) {
            push @rfields, $ref_table->primary_key;

            die "FK constraint on " . $rtable_name . '.' . join('', @fields) . " has no reference fields\n"
              unless @rfields;
        }
        else {
            die "Can't find reference table '$rtable_name' in schema\n";
        }
    }

    my $fk_sql = sprintf 'FOREIGN KEY (%s) REFERENCES %s(%s)',
        join (', ', map { $util->quote($_) } @fields ),
        $util->quote($c->reference_table),
        join (', ', map { $util->quote($_) } @rfields )
    ;

    $fk_sql .= " ON DELETE " . $c->{on_delete} if $c->{on_delete};
    $fk_sql .= " ON UPDATE " . $c->{on_update} if $c->{on_update};

    return $fk_sql;
}

sub create_field { return $future->field($_[0]) }

sub create_index
{
    my ($index, $options) = @_;

    my $name   = $index->name;
    $name      = mk_name($name);

    my $type   = $index->type eq 'UNIQUE' ? "UNIQUE " : '';

    # strip any field size qualifiers as SQLite doesn't like these
    my @fields = map { s/\(\d+\)$//; $util->quote($_) } $index->fields;
    (my $index_table_name = $index->table->name) =~ s/^.+?\.//; # table name may not specify schema
    $index_table_name = $util->quote($index_table_name);
    warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN;
    my $index_def =
    "CREATE ${type}INDEX $name ON " . $index_table_name .
        ' (' . join( ', ', @fields ) . ')';

    return $index_def;
}

sub create_constraint
{
    my ($c, $options) = @_;

    my $name   = $c->name;
    $name      = mk_name($name);
    my @fields = map $util->quote($_), $c->fields;
    (my $index_table_name = $c->table->name) =~ s/^.+?\.//; # table name may not specify schema
    $index_table_name = $util->quote($index_table_name);
    warn "removing schema name from '" . $c->table->name . "' to make '$index_table_name'\n" if $WARN;

    my $c_def =
    "CREATE UNIQUE INDEX $name ON " . $index_table_name .
        ' (' . join( ', ', @fields ) . ')';

    return $c_def;
}

sub create_trigger {
  my ($trigger, $options) = @_;
  my $add_drop = $options->{add_drop_trigger};

  my @statements;

  my $trigger_name = $trigger->name;
  $global_names{$trigger_name} = 1;

  my $events = $trigger->database_events;
  for my $evt ( @$events ) {

    my $trig_name = $trigger_name;
    if (@$events > 1) {
      $trig_name .= "_$evt";

      warn "Multiple database events supplied for trigger '$trigger_name', ",
        "creating trigger '$trig_name' for the '$evt' event.\n" if $WARN;
    }

    $trig_name = $util->quote($trig_name);
    push @statements,  "DROP TRIGGER IF EXISTS $trig_name" if $add_drop;


    $DB::single = 1;
    my $action = "";
    if (not ref $trigger->action) {
      $action .= "BEGIN " . $trigger->action . " END";
    }
    else {
      $action = $trigger->action->{for_each} . " "
        if $trigger->action->{for_each};

      $action = $trigger->action->{when} . " "
        if $trigger->action->{when};

      my $steps = $trigger->action->{steps} || [];

      $action .= "BEGIN ";
      $action .= $_ . "; " for (@$steps);
      $action .= "END";
    }

    push @statements, sprintf (
      'CREATE TRIGGER %s %s %s on %s %s',
      $trig_name,
      $trigger->perform_action_when,
      $evt,
      $util->quote($trigger->on_table),
      $action
    );
  }

  return @statements;
}

sub alter_table { } # Noop

sub add_field {
  my ($field) = @_;

  return sprintf("ALTER TABLE %s ADD COLUMN %s",
      $util->quote($field->table->name), create_field($field))
}

sub alter_create_index {
  my ($index) = @_;

  # This might cause name collisions
  return create_index($index);
}

sub alter_create_constraint {
  my ($constraint) = @_;

  return create_constraint($constraint) if $constraint->type eq 'UNIQUE';
}

sub alter_drop_constraint { alter_drop_index(@_) }

sub alter_drop_index {
  my ($constraint) = @_;

  return sprintf("DROP INDEX %s",
      $util->quote($constraint->name));
}

sub batch_alter_table {
  my ($table, $diffs) = @_;

  # If we have any of the following
  #
  #  rename_field
  #  alter_field
  #  drop_field
  #
  # we need to do the following <http://www.sqlite.org/faq.html#q11>
  #
  # BEGIN TRANSACTION;
  # CREATE TEMPORARY TABLE t1_backup(a,b);
  # INSERT INTO t1_backup SELECT a,b FROM t1;
  # DROP TABLE t1;
  # CREATE TABLE t1(a,b);
  # INSERT INTO t1 SELECT a,b FROM t1_backup;
  # DROP TABLE t1_backup;
  # COMMIT;
  #
  # Fun, eh?
  #
  # If we have rename_field we do similarly.

  my $table_name = $table->name;
  my $renaming = $diffs->{rename_table} && @{$diffs->{rename_table}};

  if ( @{$diffs->{rename_field}} == 0 &&
       @{$diffs->{alter_field}}  == 0 &&
       @{$diffs->{drop_field}}   == 0
       ) {
#    return join("\n", map {
    return map {
        my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
        map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ?  ("$sql") : () } @{ $diffs->{$_} }

      } grep { @{$diffs->{$_}} }
    qw/rename_table
       alter_drop_constraint
       alter_drop_index
       drop_field
       add_field
       alter_field
       rename_field
       alter_create_index
       alter_create_constraint
       alter_table/;
  }


  my @sql;
  my $old_table = $renaming ? $diffs->{rename_table}[0][0] : $table;

  do {
    local $table->{name} = $table_name . '_temp_alter';
    # We only want the table - dont care about indexes on tmp table
    my ($table_sql) = create_table($table, {no_comments => 1, temporary_table => 1});
    push @sql,$table_sql;
  };

  push @sql, "INSERT INTO @{[$util->quote($table_name.'_temp_alter')]} SELECT @{[ join(', ', map $util->quote($_), $old_table->get_fields)]} FROM @{[$util->quote($old_table)]}",
             "DROP TABLE @{[$util->quote($old_table)]}",
             create_table($table, { no_comments => 1 }),
             "INSERT INTO @{[$util->quote($table_name)]} SELECT @{[ join(', ', map $util->quote($_), $old_table->get_fields)]} FROM @{[$util->quote($table_name.'_temp_alter')]}",
             "DROP TABLE @{[$util->quote($table_name.'_temp_alter')]}";

  return @sql;
#  return join("", @sql, "");
}

sub drop_table {
  my ($table) = @_;
  $table = $util->quote($table);
  return "DROP TABLE $table";
}

sub rename_table {
  my ($old_table, $new_table, $options) = @_;

  $old_table = $util->quote($old_table);
  $new_table = $util->quote($new_table);

  return "ALTER TABLE $old_table RENAME TO $new_table";

}

# No-op. Just here to signify that we are a new style parser.
sub preproces_schema { }

1;

=pod

=head1 SEE ALSO

SQL::Translator, http://www.sqlite.org/.

=head1 AUTHOR

Ken Youens-Clark C<< <kclark@cpan.orgE> >>.

Diff code added by Ash Berlin C<< <ash@cpan.org> >>.

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