package SQL::Translator::Generator::DDL::SQLServer;
+=head1 NAME
+
+SQL::Translator::Generator::DDL::SQLServer - A Moo based MS SQL Server DDL
+generation engine.
+
+=head1 DESCRIPTION
+
+I<documentation volunteers needed>
+
+=cut
+
use Moo;
-use SQL::Translator::Generator::Utils;
+use SQL::Translator::Schema::Constants;
+with 'SQL::Translator::Generator::Role::Quote';
with 'SQL::Translator::Generator::Role::DDL';
-sub _build_shim { SQL::Translator::Generator::Utils->new( quote_chars => [qw( [ ] )] ) }
+sub quote_chars { [qw([ ])] }
+sub name_sep { q(.) }
sub _build_numeric_types {
+{
}
}
-has sizeless_types => (
- is => 'ro',
- builder => '_build_sizeless_types',
-);
-
sub _build_sizeless_types {
+{ map { $_ => 1 }
qw( tinyint smallint int integer bigint text bit image datetime ) }
$self->field_default($field),
}
-sub field_type_size {
- my ($self, $field) = @_;
-
- ($field->size && !$self->sizeless_types->{$field->data_type}
- ? '(' . $field->size . ')'
- : ''
- )
-}
-
sub field_autoinc { ( $_[1]->is_auto_increment ? 'IDENTITY' : () ) }
sub primary_key_constraint {
'CONSTRAINT ' .
- $_[0]->shim->quote($_[1]->name || $_[1]->table->name . '_pk') .
+ $_[0]->quote($_[1]->name || $_[1]->table->name . '_pk') .
' PRIMARY KEY (' .
- join( ', ', map $_[0]->shim->quote($_), $_[1]->fields ) .
+ join( ', ', map $_[0]->quote($_), $_[1]->fields ) .
')'
}
sub index {
'CREATE INDEX ' .
- $_[0]->shim->quote($_[1]->name || $_[1]->table->name . '_idx') .
- ' ON ' . $_[0]->shim->quote($_[1]->table->name) .
- ' (' . join( ', ', map $_[0]->shim->quote($_), $_[1]->fields ) . ');'
+ $_[0]->quote($_[1]->name || $_[1]->table->name . '_idx') .
+ ' ON ' . $_[0]->quote($_[1]->table->name) .
+ ' (' . join( ', ', map $_[0]->quote($_), $_[1]->fields ) . ');'
+}
+
+sub unique_constraint_single {
+ my ($self, $constraint) = @_;
+
+ 'CONSTRAINT ' .
+ $self->unique_constraint_name($constraint) .
+ ' UNIQUE (' . join( ', ', map $self->quote($_), $constraint->fields ) . ')'
+}
+
+sub unique_constraint_name {
+ my ($self, $constraint) = @_;
+ $self->quote($constraint->name || $constraint->table->name . '_uc' )
+}
+
+sub unique_constraint_multiple {
+ my ($self, $constraint) = @_;
+
+ 'CREATE UNIQUE NONCLUSTERED INDEX ' .
+ $self->unique_constraint_name($constraint) .
+ ' ON ' . $self->quote($constraint->table->name) . ' (' .
+ join( ', ', map $self->quote($_), $constraint->fields ) . ')' .
+ ' WHERE ' . join( ' AND ',
+ map $self->quote($_->name) . ' IS NOT NULL',
+ grep { $_->is_nullable } $constraint->fields ) . ';'
+}
+
+sub foreign_key_constraint {
+ my ($self, $constraint) = @_;
+
+ my $on_delete = uc ($constraint->on_delete || '');
+ my $on_update = uc ($constraint->on_update || '');
+
+ # The default implicit constraint action in MSSQL is RESTRICT
+ # but you can not specify it explicitly. Go figure :)
+ for (map uc $_ || '', $on_delete, $on_update) {
+ undef $_ if $_ eq 'RESTRICT'
+ }
+
+ 'ALTER TABLE ' . $self->quote($constraint->table->name) .
+ ' ADD CONSTRAINT ' .
+ $self->quote($constraint->name || $constraint->table->name . '_fk') .
+ ' FOREIGN KEY' .
+ ' (' . join( ', ', map $self->quote($_), $constraint->fields ) . ') REFERENCES '.
+ $self->quote($constraint->reference_table) .
+ ' (' . join( ', ', map $self->quote($_), $constraint->reference_fields ) . ')'
+ . (
+ $on_delete && $on_delete ne "NO ACTION"
+ ? ' ON DELETE ' . $on_delete
+ : ''
+ ) . (
+ $on_update && $on_update ne "NO ACTION"
+ ? ' ON UPDATE ' . $on_update
+ : ''
+ ) . ';';
+}
+
+sub enum_constraint_name {
+ my ($self, $field_name) = @_;
+ $self->quote($field_name . '_chk' )
+}
+
+sub enum_constraint {
+ my ( $self, $field_name, $vals ) = @_;
+
+ return (
+ 'CONSTRAINT ' . $self->enum_constraint_name($field_name) .
+ ' CHECK (' . $self->quote($field_name) .
+ ' IN (' . join( ',', map qq('$_'), @$vals ) . '))'
+ )
+}
+
+sub constraints {
+ my ($self, $table) = @_;
+
+ (map $self->enum_constraint($_->name, { $_->extra }->{list} || []),
+ grep { 'enum' eq lc $_->data_type } $table->get_fields),
+
+ (map $self->primary_key_constraint($_),
+ grep { $_->type eq PRIMARY_KEY } $table->get_constraints),
+
+ (map $self->unique_constraint_single($_),
+ grep {
+ $_->type eq UNIQUE &&
+ !grep { $_->is_nullable } $_->fields
+ } $table->get_constraints),
+}
+
+sub table {
+ my ($self, $table) = @_;
+ join ( "\n", $self->table_comments($table), '' ) .
+ join ( "\n\n",
+ 'CREATE TABLE ' . $self->quote($table->name) . " (\n".
+ join( ",\n",
+ map { " $_" }
+ $self->fields($table),
+ $self->constraints($table),
+ ) .
+ "\n);",
+ $self->unique_constraints_multiple($table),
+ $self->indices($table),
+ )
+}
+
+sub unique_constraints_multiple {
+ my ($self, $table) = @_;
+ (map $self->unique_constraint_multiple($_),
+ grep {
+ $_->type eq UNIQUE &&
+ grep { $_->is_nullable } $_->fields
+ } $table->get_constraints)
+}
+
+sub drop_table {
+ my ($self, $table) = @_;
+ my $name = $table->name;
+ my $q_name = $self->quote($name);
+ "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" .
+ " DROP TABLE $q_name;"
+}
+
+sub remove_table_constraints {
+ my ($self, $table) = @_;
+ my $name = $table->name;
+ my $q_name = $self->quote($name);
+ "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" .
+ " ALTER TABLE $q_name NOCHECK CONSTRAINT all;"
+}
+
+sub drop_tables {
+ my ($self, $schema) = @_;
+
+ if ($self->add_drop_table) {
+ my @tables = sort { $b->order <=> $a->order } $schema->get_tables;
+ return join "\n", (
+ ( $self->add_comments ? (
+ '--',
+ '-- Turn off constraints',
+ '--',
+ '',
+ ) : () ),
+ (map $self->remove_table_constraints($_), @tables),
+ ( $self->add_comments ? (
+ '--',
+ '-- Drop tables',
+ '--',
+ '',
+ ) : () ),
+ (map $self->drop_table($_), @tables),
+ )
+ }
+ return '';
+}
+
+sub foreign_key_constraints {
+ my ($self, $schema) = @_;
+ ( map $self->foreign_key_constraint($_),
+ grep { $_->type eq FOREIGN_KEY }
+ map $_->get_constraints,
+ $schema->get_tables )
+}
+
+sub schema {
+ my ($self, $schema) = @_;
+
+ $self->header_comments .
+ $self->drop_tables($schema) .
+ join("\n\n", map $self->table($_), grep { $_->name } $schema->get_tables) .
+ "\n" . join "\n", $self->foreign_key_constraints($schema)
}
1;
+=head1 AUTHORS
+
+See the included AUTHORS file:
+L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2012 the SQL::Translator L</AUTHORS> as listed above.
+
+=head1 LICENSE
+
+This code is free software and may be distributed under the same terms as Perl
+itself.
+
+=cut
projects / dbsrgits/SQL-Translator.git / blobdiff