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