1 package SQL::Translator::Generator::DDL::SQLServer;
5 SQL::Translator::Generator::DDL::SQLServer - A Moo based MS SQL Server DDL
10 I<documentation volunteers needed>
15 use SQL::Translator::Schema::Constants;
17 with 'SQL::Translator::Generator::Role::Quote';
18 with 'SQL::Translator::Generator::Role::DDL';
20 sub quote_chars { [qw([ ])] }
23 sub _build_numeric_types {
29 sub _build_unquoted_defaults {
42 sub _build_sizeless_types {
44 qw( tinyint smallint int integer bigint text bit image datetime ) }
48 my ($self, $field) = @_;
50 return join ' ', $self->field_name($field), ($self->field_type($field)||die 'type is required'),
51 $self->field_autoinc($field),
52 $self->field_nullable($field),
53 $self->field_default($field),
56 sub field_autoinc { ( $_[1]->is_auto_increment ? 'IDENTITY' : () ) }
58 sub primary_key_constraint {
60 $_[0]->quote($_[1]->name || $_[1]->table->name . '_pk') .
62 join( ', ', map $_[0]->quote($_), $_[1]->fields ) .
68 $_[0]->quote($_[1]->name || $_[1]->table->name . '_idx') .
69 ' ON ' . $_[0]->quote($_[1]->table->name) .
70 ' (' . join( ', ', map $_[0]->quote($_), $_[1]->fields ) . ');'
73 sub unique_constraint_single {
74 my ($self, $constraint) = @_;
77 $self->unique_constraint_name($constraint) .
78 ' UNIQUE (' . join( ', ', map $self->quote($_), $constraint->fields ) . ')'
81 sub unique_constraint_name {
82 my ($self, $constraint) = @_;
83 $self->quote($constraint->name || $constraint->table->name . '_uc' )
86 sub unique_constraint_multiple {
87 my ($self, $constraint) = @_;
89 'CREATE UNIQUE NONCLUSTERED INDEX ' .
90 $self->unique_constraint_name($constraint) .
91 ' ON ' . $self->quote($constraint->table->name) . ' (' .
92 join( ', ', map $self->quote($_), $constraint->fields ) . ')' .
93 ' WHERE ' . join( ' AND ',
94 map $self->quote($_->name) . ' IS NOT NULL',
95 grep { $_->is_nullable } $constraint->fields ) . ';'
98 sub foreign_key_constraint {
99 my ($self, $constraint) = @_;
101 my $on_delete = uc ($constraint->on_delete || '');
102 my $on_update = uc ($constraint->on_update || '');
104 # The default implicit constraint action in MSSQL is RESTRICT
105 # but you can not specify it explicitly. Go figure :)
106 for (map uc $_ || '', $on_delete, $on_update) {
107 undef $_ if $_ eq 'RESTRICT'
110 'ALTER TABLE ' . $self->quote($constraint->table->name) .
112 $self->quote($constraint->name || $constraint->table->name . '_fk') .
114 ' (' . join( ', ', map $self->quote($_), $constraint->fields ) . ') REFERENCES '.
115 $self->quote($constraint->reference_table) .
116 ' (' . join( ', ', map $self->quote($_), $constraint->reference_fields ) . ')'
118 $on_delete && $on_delete ne "NO ACTION"
119 ? ' ON DELETE ' . $on_delete
122 $on_update && $on_update ne "NO ACTION"
123 ? ' ON UPDATE ' . $on_update
128 sub enum_constraint_name {
129 my ($self, $field_name) = @_;
130 $self->quote($field_name . '_chk' )
133 sub enum_constraint {
134 my ( $self, $field_name, $vals ) = @_;
137 'CONSTRAINT ' . $self->enum_constraint_name($field_name) .
138 ' CHECK (' . $self->quote($field_name) .
139 ' IN (' . join( ',', map $self->quote_string($_), @$vals ) . '))'
144 my ($self, $table) = @_;
146 (map $self->enum_constraint($_->name, { $_->extra }->{list} || []),
147 grep { 'enum' eq lc $_->data_type } $table->get_fields),
149 (map $self->primary_key_constraint($_),
150 grep { $_->type eq PRIMARY_KEY } $table->get_constraints),
152 (map $self->unique_constraint_single($_),
154 $_->type eq UNIQUE &&
155 !grep { $_->is_nullable } $_->fields
156 } $table->get_constraints),
160 my ($self, $table) = @_;
161 join ( "\n", $self->table_comments($table), '' ) .
163 'CREATE TABLE ' . $self->quote($table->name) . " (\n".
166 $self->fields($table),
167 $self->constraints($table),
170 $self->unique_constraints_multiple($table),
171 $self->indices($table),
175 sub unique_constraints_multiple {
176 my ($self, $table) = @_;
177 (map $self->unique_constraint_multiple($_),
179 $_->type eq UNIQUE &&
180 grep { $_->is_nullable } $_->fields
181 } $table->get_constraints)
185 my ($self, $table) = @_;
186 my $name = $table->name;
187 my $q_name = $self->quote($name);
188 "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" .
189 " DROP TABLE $q_name;"
192 sub remove_table_constraints {
193 my ($self, $table) = @_;
194 my $name = $table->name;
195 my $q_name = $self->quote($name);
196 "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" .
197 " ALTER TABLE $q_name NOCHECK CONSTRAINT all;"
201 my ($self, $schema) = @_;
203 if ($self->add_drop_table) {
204 my @tables = sort { $b->order <=> $a->order } $schema->get_tables;
206 ( $self->add_comments ? (
208 '-- Turn off constraints',
212 (map $self->remove_table_constraints($_), @tables),
213 ( $self->add_comments ? (
219 (map $self->drop_table($_), @tables),
225 sub foreign_key_constraints {
226 my ($self, $schema) = @_;
227 ( map $self->foreign_key_constraint($_),
228 grep { $_->type eq FOREIGN_KEY }
229 map $_->get_constraints,
230 $schema->get_tables )
234 my ($self, $schema) = @_;
236 $self->header_comments .
237 $self->drop_tables($schema) .
238 join("\n\n", map $self->table($_), grep { $_->name } $schema->get_tables) .
239 "\n" . join "\n", $self->foreign_key_constraints($schema)
246 See the included AUTHORS file:
247 L<http://search.cpan.org/dist/SQL-Translator/AUTHORS>
251 Copyright (c) 2012 the SQL::Translator L</AUTHORS> as listed above.
255 This code is free software and may be distributed under the same terms as Perl