Commit | Line | Data |
1ea76bff |
1 | package SQL::Translator::Generator::DDL::SQLServer; |
2 | |
22c0c10f |
3 | =head1 NAME |
4 | |
5 | SQL::Translator::Generator::DDL::SQLServer - A Moo based MS SQL Server DDL |
6 | generation engine. |
7 | |
8 | =head1 DESCRIPTION |
9 | |
10 | I<documentation volunteers needed> |
11 | |
12 | =cut |
d22073f1 |
13 | |
1ea76bff |
14 | use Moo; |
7a16a53e |
15 | use SQL::Translator::Schema::Constants; |
1ea76bff |
16 | |
39bfaa8b |
17 | with 'SQL::Translator::Generator::Role::Quote'; |
1ea76bff |
18 | with 'SQL::Translator::Generator::Role::DDL'; |
19 | |
39bfaa8b |
20 | sub quote_chars { [qw([ ])] } |
21 | sub name_sep { q(.) } |
1ea76bff |
22 | |
f699ffaa |
23 | sub _build_numeric_types { |
24 | +{ |
25 | int => 1, |
26 | } |
27 | } |
28 | |
29 | sub _build_unquoted_defaults { |
30 | +{ |
31 | NULL => 1, |
32 | } |
33 | } |
34 | |
1ea76bff |
35 | sub _build_type_map { |
36 | +{ |
37 | date => 'datetime', |
38 | 'time' => 'datetime', |
39 | } |
40 | } |
41 | |
1ea76bff |
42 | sub _build_sizeless_types { |
43 | +{ map { $_ => 1 } |
44 | qw( tinyint smallint int integer bigint text bit image datetime ) } |
45 | } |
46 | |
47 | sub field { |
48 | my ($self, $field) = @_; |
49 | |
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), |
54 | } |
55 | |
1ea76bff |
56 | sub field_autoinc { ( $_[1]->is_auto_increment ? 'IDENTITY' : () ) } |
57 | |
e6fcfabf |
58 | sub primary_key_constraint { |
59 | 'CONSTRAINT ' . |
38d0ddf0 |
60 | $_[0]->quote($_[1]->name || $_[1]->table->name . '_pk') . |
e6fcfabf |
61 | ' PRIMARY KEY (' . |
38d0ddf0 |
62 | join( ', ', map $_[0]->quote($_), $_[1]->fields ) . |
e6fcfabf |
63 | ')' |
64 | } |
65 | |
66 | sub index { |
67 | 'CREATE INDEX ' . |
38d0ddf0 |
68 | $_[0]->quote($_[1]->name || $_[1]->table->name . '_idx') . |
69 | ' ON ' . $_[0]->quote($_[1]->table->name) . |
70 | ' (' . join( ', ', map $_[0]->quote($_), $_[1]->fields ) . ');' |
e6fcfabf |
71 | } |
72 | |
2363a629 |
73 | sub unique_constraint_single { |
74 | my ($self, $constraint) = @_; |
75 | |
76 | 'CONSTRAINT ' . |
77 | $self->unique_constraint_name($constraint) . |
38d0ddf0 |
78 | ' UNIQUE (' . join( ', ', map $self->quote($_), $constraint->fields ) . ')' |
2363a629 |
79 | } |
80 | |
81 | sub unique_constraint_name { |
82 | my ($self, $constraint) = @_; |
38d0ddf0 |
83 | $self->quote($constraint->name || $constraint->table->name . '_uc' ) |
2363a629 |
84 | } |
85 | |
86 | sub unique_constraint_multiple { |
87 | my ($self, $constraint) = @_; |
88 | |
89 | 'CREATE UNIQUE NONCLUSTERED INDEX ' . |
90 | $self->unique_constraint_name($constraint) . |
38d0ddf0 |
91 | ' ON ' . $self->quote($constraint->table->name) . ' (' . |
bd0a45e0 |
92 | join( ', ', map $self->quote($_), $constraint->fields ) . ')' . |
2363a629 |
93 | ' WHERE ' . join( ' AND ', |
38d0ddf0 |
94 | map $self->quote($_->name) . ' IS NOT NULL', |
2363a629 |
95 | grep { $_->is_nullable } $constraint->fields ) . ';' |
96 | } |
97 | |
38d0ddf0 |
98 | sub foreign_key_constraint { |
99 | my ($self, $constraint) = @_; |
100 | |
101 | my $on_delete = uc ($constraint->on_delete || ''); |
102 | my $on_update = uc ($constraint->on_update || ''); |
103 | |
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' |
108 | } |
109 | |
110 | 'ALTER TABLE ' . $self->quote($constraint->table->name) . |
111 | ' ADD CONSTRAINT ' . |
112 | $self->quote($constraint->name || $constraint->table->name . '_fk') . |
113 | ' FOREIGN KEY' . |
114 | ' (' . join( ', ', map $self->quote($_), $constraint->fields ) . ') REFERENCES '. |
115 | $self->quote($constraint->reference_table) . |
116 | ' (' . join( ', ', map $self->quote($_), $constraint->reference_fields ) . ')' |
117 | . ( |
118 | $on_delete && $on_delete ne "NO ACTION" |
119 | ? ' ON DELETE ' . $on_delete |
120 | : '' |
121 | ) . ( |
122 | $on_update && $on_update ne "NO ACTION" |
123 | ? ' ON UPDATE ' . $on_update |
124 | : '' |
125 | ) . ';'; |
126 | } |
127 | |
280d92ba |
128 | sub enum_constraint_name { |
129 | my ($self, $field_name) = @_; |
130 | $self->quote($field_name . '_chk' ) |
131 | } |
132 | |
133 | sub enum_constraint { |
134 | my ( $self, $field_name, $vals ) = @_; |
135 | |
136 | return ( |
137 | 'CONSTRAINT ' . $self->enum_constraint_name($field_name) . |
138 | ' CHECK (' . $self->quote($field_name) . |
1868ddbe |
139 | ' IN (' . join( ',', map $self->quote_string($_), @$vals ) . '))' |
280d92ba |
140 | ) |
141 | } |
142 | |
2ce8cf9b |
143 | sub constraints { |
144 | my ($self, $table) = @_; |
145 | |
146 | (map $self->enum_constraint($_->name, { $_->extra }->{list} || []), |
147 | grep { 'enum' eq lc $_->data_type } $table->get_fields), |
148 | |
149 | (map $self->primary_key_constraint($_), |
150 | grep { $_->type eq PRIMARY_KEY } $table->get_constraints), |
151 | |
152 | (map $self->unique_constraint_single($_), |
153 | grep { |
154 | $_->type eq UNIQUE && |
155 | !grep { $_->is_nullable } $_->fields |
156 | } $table->get_constraints), |
157 | } |
158 | |
7a16a53e |
159 | sub table { |
160 | my ($self, $table) = @_; |
9a6c1bf9 |
161 | join ( "\n", $self->table_comments($table), '' ) . |
3f9e80bf |
162 | join ( "\n\n", |
3f9e80bf |
163 | 'CREATE TABLE ' . $self->quote($table->name) . " (\n". |
164 | join( ",\n", |
165 | map { " $_" } |
166 | $self->fields($table), |
167 | $self->constraints($table), |
168 | ) . |
9a6c1bf9 |
169 | "\n);", |
170 | $self->unique_constraints_multiple($table), |
171 | $self->indices($table), |
3f9e80bf |
172 | ) |
173 | } |
174 | |
175 | sub unique_constraints_multiple { |
176 | my ($self, $table) = @_; |
177 | (map $self->unique_constraint_multiple($_), |
178 | grep { |
179 | $_->type eq UNIQUE && |
180 | grep { $_->is_nullable } $_->fields |
181 | } $table->get_constraints) |
7a16a53e |
182 | } |
183 | |
11bfa991 |
184 | sub drop_table { |
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 | " DROP TABLE $q_name;" |
11bfa991 |
190 | } |
191 | |
97a16cf4 |
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')" . |
9b76e208 |
197 | " ALTER TABLE $q_name NOCHECK CONSTRAINT all;" |
97a16cf4 |
198 | } |
199 | |
f9356e0d |
200 | sub drop_tables { |
f851dfea |
201 | my ($self, $schema) = @_; |
f9356e0d |
202 | |
203 | if ($self->add_drop_table) { |
204 | my @tables = sort { $b->order <=> $a->order } $schema->get_tables; |
205 | return join "\n", ( |
206 | ( $self->add_comments ? ( |
207 | '--', |
208 | '-- Turn off constraints', |
209 | '--', |
210 | '', |
211 | ) : () ), |
212 | (map $self->remove_table_constraints($_), @tables), |
213 | ( $self->add_comments ? ( |
214 | '--', |
215 | '-- Drop tables', |
216 | '--', |
217 | '', |
218 | ) : () ), |
219 | (map $self->drop_table($_), @tables), |
220 | ) |
221 | } |
222 | return ''; |
223 | } |
224 | |
c7091660 |
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 ) |
231 | } |
232 | |
9a6c1bf9 |
233 | sub schema { |
234 | my ($self, $schema) = @_; |
235 | |
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) |
240 | } |
241 | |
1ea76bff |
242 | 1; |
243 | |
22c0c10f |
244 | =head1 AUTHORS |
245 | |
246 | See the included AUTHORS file: |
247 | L<http://search.cpan.org/dist/SQL-Translator/AUTHORS> |
248 | |
249 | =head1 COPYRIGHT |
250 | |
251 | Copyright (c) 2012 the SQL::Translator L</AUTHORS> as listed above. |
252 | |
253 | =head1 LICENSE |
254 | |
255 | This code is free software and may be distributed under the same terms as Perl |
256 | itself. |
257 | |
258 | =cut |