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