Commit | Line | Data |
1ea76bff |
1 | package SQL::Translator::Generator::DDL::SQLServer; |
2 | |
3 | use Moo; |
4 | use SQL::Translator::Generator::Utils; |
7a16a53e |
5 | use SQL::Translator::Schema::Constants; |
1ea76bff |
6 | |
39bfaa8b |
7 | with 'SQL::Translator::Generator::Role::Quote'; |
1ea76bff |
8 | with 'SQL::Translator::Generator::Role::DDL'; |
9 | |
39bfaa8b |
10 | sub quote_chars { [qw([ ])] } |
11 | sub name_sep { q(.) } |
1ea76bff |
12 | |
f699ffaa |
13 | sub _build_numeric_types { |
14 | +{ |
15 | int => 1, |
16 | } |
17 | } |
18 | |
19 | sub _build_unquoted_defaults { |
20 | +{ |
21 | NULL => 1, |
22 | } |
23 | } |
24 | |
1ea76bff |
25 | sub _build_type_map { |
26 | +{ |
27 | date => 'datetime', |
28 | 'time' => 'datetime', |
29 | } |
30 | } |
31 | |
1ea76bff |
32 | sub _build_sizeless_types { |
33 | +{ map { $_ => 1 } |
34 | qw( tinyint smallint int integer bigint text bit image datetime ) } |
35 | } |
36 | |
37 | sub field { |
38 | my ($self, $field) = @_; |
39 | |
40 | return join ' ', $self->field_name($field), ($self->field_type($field)||die 'type is required'), |
41 | $self->field_autoinc($field), |
42 | $self->field_nullable($field), |
43 | $self->field_default($field), |
44 | } |
45 | |
1ea76bff |
46 | sub field_autoinc { ( $_[1]->is_auto_increment ? 'IDENTITY' : () ) } |
47 | |
e6fcfabf |
48 | sub primary_key_constraint { |
49 | 'CONSTRAINT ' . |
38d0ddf0 |
50 | $_[0]->quote($_[1]->name || $_[1]->table->name . '_pk') . |
e6fcfabf |
51 | ' PRIMARY KEY (' . |
38d0ddf0 |
52 | join( ', ', map $_[0]->quote($_), $_[1]->fields ) . |
e6fcfabf |
53 | ')' |
54 | } |
55 | |
56 | sub index { |
57 | 'CREATE INDEX ' . |
38d0ddf0 |
58 | $_[0]->quote($_[1]->name || $_[1]->table->name . '_idx') . |
59 | ' ON ' . $_[0]->quote($_[1]->table->name) . |
60 | ' (' . join( ', ', map $_[0]->quote($_), $_[1]->fields ) . ');' |
e6fcfabf |
61 | } |
62 | |
2363a629 |
63 | sub unique_constraint_single { |
64 | my ($self, $constraint) = @_; |
65 | |
66 | 'CONSTRAINT ' . |
67 | $self->unique_constraint_name($constraint) . |
38d0ddf0 |
68 | ' UNIQUE (' . join( ', ', map $self->quote($_), $constraint->fields ) . ')' |
2363a629 |
69 | } |
70 | |
71 | sub unique_constraint_name { |
72 | my ($self, $constraint) = @_; |
38d0ddf0 |
73 | $self->quote($constraint->name || $constraint->table->name . '_uc' ) |
2363a629 |
74 | } |
75 | |
76 | sub unique_constraint_multiple { |
77 | my ($self, $constraint) = @_; |
78 | |
79 | 'CREATE UNIQUE NONCLUSTERED INDEX ' . |
80 | $self->unique_constraint_name($constraint) . |
38d0ddf0 |
81 | ' ON ' . $self->quote($constraint->table->name) . ' (' . |
2363a629 |
82 | join( ', ', $constraint->fields ) . ')' . |
83 | ' WHERE ' . join( ' AND ', |
38d0ddf0 |
84 | map $self->quote($_->name) . ' IS NOT NULL', |
2363a629 |
85 | grep { $_->is_nullable } $constraint->fields ) . ';' |
86 | } |
87 | |
38d0ddf0 |
88 | sub foreign_key_constraint { |
89 | my ($self, $constraint) = @_; |
90 | |
91 | my $on_delete = uc ($constraint->on_delete || ''); |
92 | my $on_update = uc ($constraint->on_update || ''); |
93 | |
94 | # The default implicit constraint action in MSSQL is RESTRICT |
95 | # but you can not specify it explicitly. Go figure :) |
96 | for (map uc $_ || '', $on_delete, $on_update) { |
97 | undef $_ if $_ eq 'RESTRICT' |
98 | } |
99 | |
100 | 'ALTER TABLE ' . $self->quote($constraint->table->name) . |
101 | ' ADD CONSTRAINT ' . |
102 | $self->quote($constraint->name || $constraint->table->name . '_fk') . |
103 | ' FOREIGN KEY' . |
104 | ' (' . join( ', ', map $self->quote($_), $constraint->fields ) . ') REFERENCES '. |
105 | $self->quote($constraint->reference_table) . |
106 | ' (' . join( ', ', map $self->quote($_), $constraint->reference_fields ) . ')' |
107 | . ( |
108 | $on_delete && $on_delete ne "NO ACTION" |
109 | ? ' ON DELETE ' . $on_delete |
110 | : '' |
111 | ) . ( |
112 | $on_update && $on_update ne "NO ACTION" |
113 | ? ' ON UPDATE ' . $on_update |
114 | : '' |
115 | ) . ';'; |
116 | } |
117 | |
280d92ba |
118 | sub enum_constraint_name { |
119 | my ($self, $field_name) = @_; |
120 | $self->quote($field_name . '_chk' ) |
121 | } |
122 | |
123 | sub enum_constraint { |
124 | my ( $self, $field_name, $vals ) = @_; |
125 | |
126 | return ( |
127 | 'CONSTRAINT ' . $self->enum_constraint_name($field_name) . |
128 | ' CHECK (' . $self->quote($field_name) . |
129 | ' IN (' . join( ',', map qq('$_'), @$vals ) . '))' |
130 | ) |
131 | } |
132 | |
2ce8cf9b |
133 | sub constraints { |
134 | my ($self, $table) = @_; |
135 | |
136 | (map $self->enum_constraint($_->name, { $_->extra }->{list} || []), |
137 | grep { 'enum' eq lc $_->data_type } $table->get_fields), |
138 | |
139 | (map $self->primary_key_constraint($_), |
140 | grep { $_->type eq PRIMARY_KEY } $table->get_constraints), |
141 | |
142 | (map $self->unique_constraint_single($_), |
143 | grep { |
144 | $_->type eq UNIQUE && |
145 | !grep { $_->is_nullable } $_->fields |
146 | } $table->get_constraints), |
147 | } |
148 | |
7a16a53e |
149 | sub table { |
150 | my ($self, $table) = @_; |
9a6c1bf9 |
151 | join ( "\n", $self->table_comments($table), '' ) . |
3f9e80bf |
152 | join ( "\n\n", |
3f9e80bf |
153 | 'CREATE TABLE ' . $self->quote($table->name) . " (\n". |
154 | join( ",\n", |
155 | map { " $_" } |
156 | $self->fields($table), |
157 | $self->constraints($table), |
158 | ) . |
9a6c1bf9 |
159 | "\n);", |
160 | $self->unique_constraints_multiple($table), |
161 | $self->indices($table), |
3f9e80bf |
162 | ) |
163 | } |
164 | |
165 | sub unique_constraints_multiple { |
166 | my ($self, $table) = @_; |
167 | (map $self->unique_constraint_multiple($_), |
168 | grep { |
169 | $_->type eq UNIQUE && |
170 | grep { $_->is_nullable } $_->fields |
171 | } $table->get_constraints) |
7a16a53e |
172 | } |
173 | |
11bfa991 |
174 | sub drop_table { |
175 | my ($self, $table) = @_; |
176 | my $name = $table->name; |
177 | my $q_name = $self->quote($name); |
178 | "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" . |
9b76e208 |
179 | " DROP TABLE $q_name;" |
11bfa991 |
180 | } |
181 | |
97a16cf4 |
182 | sub remove_table_constraints { |
183 | my ($self, $table) = @_; |
184 | my $name = $table->name; |
185 | my $q_name = $self->quote($name); |
186 | "IF EXISTS (SELECT name FROM sysobjects WHERE name = '$name' AND type = 'U')" . |
9b76e208 |
187 | " ALTER TABLE $q_name NOCHECK CONSTRAINT all;" |
97a16cf4 |
188 | } |
189 | |
f9356e0d |
190 | sub drop_tables { |
191 | my ($self, $schema) = shift; |
192 | |
193 | if ($self->add_drop_table) { |
194 | my @tables = sort { $b->order <=> $a->order } $schema->get_tables; |
195 | return join "\n", ( |
196 | ( $self->add_comments ? ( |
197 | '--', |
198 | '-- Turn off constraints', |
199 | '--', |
200 | '', |
201 | ) : () ), |
202 | (map $self->remove_table_constraints($_), @tables), |
203 | ( $self->add_comments ? ( |
204 | '--', |
205 | '-- Drop tables', |
206 | '--', |
207 | '', |
208 | ) : () ), |
209 | (map $self->drop_table($_), @tables), |
210 | ) |
211 | } |
212 | return ''; |
213 | } |
214 | |
c7091660 |
215 | sub foreign_key_constraints { |
216 | my ($self, $schema) = @_; |
217 | ( map $self->foreign_key_constraint($_), |
218 | grep { $_->type eq FOREIGN_KEY } |
219 | map $_->get_constraints, |
220 | $schema->get_tables ) |
221 | } |
222 | |
9a6c1bf9 |
223 | sub schema { |
224 | my ($self, $schema) = @_; |
225 | |
226 | $self->header_comments . |
227 | $self->drop_tables($schema) . |
228 | join("\n\n", map $self->table($_), grep { $_->name } $schema->get_tables) . |
229 | "\n" . join "\n", $self->foreign_key_constraints($schema) |
230 | } |
231 | |
1ea76bff |
232 | 1; |
233 | |