Commit | Line | Data |
4f4fd192 |
1 | use MooseX::Declare; |
2 | role SQL::Translator::Parser::DDL::MySQL { |
acfd88b5 |
3 | use MooseX::Types::Moose qw(Str); |
4 | use MooseX::MultiMethods; |
5 | use SQL::Translator::Constants qw(:sqlt_types :sqlt_constants); |
6 | use aliased 'SQL::Translator::Object::Column'; |
7 | use aliased 'SQL::Translator::Object::Constraint'; |
8 | use aliased 'SQL::Translator::Object::ForeignKey'; |
9 | use aliased 'SQL::Translator::Object::Index'; |
10 | use aliased 'SQL::Translator::Object::PrimaryKey'; |
11 | use aliased 'SQL::Translator::Object::Schema'; |
12 | use aliased 'SQL::Translator::Object::Table'; |
13 | |
14 | around _build_data_type_mapping { |
15 | my $data_type_mapping = $self->$orig; |
16 | $data_type_mapping->{date} = SQL_DATE(); |
17 | |
18 | return $data_type_mapping; |
19 | }; |
20 | |
bf2a7e53 |
21 | multi method parse(Schema $data) { $data } |
acfd88b5 |
22 | |
bf2a7e53 |
23 | multi method parse(Str $data) { |
acfd88b5 |
24 | my $parser = Parse::RecDescent->new($self->grammar); |
25 | |
acfd88b5 |
26 | unless (defined $parser) { |
27 | return $self->error("Error instantiating Parse::RecDescent ". |
28 | "instance: Bad grammar"); |
29 | } |
30 | |
31 | # my $parser_version = parse_mysql_version( |
32 | # $translator->parser_args->{mysql_parser_version}, 'mysql' |
33 | # ) || DEFAULT_PARSER_VERSION; |
34 | my $parser_version = 30000; |
35 | |
36 | while ($data =~ s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es) { } |
bf2a7e53 |
37 | |
acfd88b5 |
38 | my $result = $parser->startrule($data); |
acfd88b5 |
39 | die "Parse failed" unless defined $result; |
acfd88b5 |
40 | |
bf2a7e53 |
41 | my $translator = $self->translator; |
42 | my $schema = $translator->schema; |
acfd88b5 |
43 | $schema->name($result->{'database_name'}) if $result->{'database_name'}; |
44 | |
45 | my @tables = sort { $result->{'tables'}{ $a }{'order'} <=> $result->{'tables'}{ $b }{'order'} } keys %{ $result->{'tables'} }; |
46 | |
47 | for my $table_name ( @tables ) { |
48 | my $tdata = $result->{tables}{ $table_name }; |
bf2a7e53 |
49 | my $table = Table->new({ name => $tdata->{table_name}, schema => $schema }); |
acfd88b5 |
50 | $schema->add_table($table); |
51 | $table->comments( join "\n", @{$tdata->{comments}} ) if $tdata->{comments}; |
52 | |
53 | my @fields = sort { $tdata->{'fields'}->{$a}->{'order'} <=> $tdata->{'fields'}->{$b}->{'order'} } keys %{ $tdata->{'fields'} }; |
54 | |
55 | for my $fname ( @fields ) { |
56 | my $fdata = $tdata->{fields}{ $fname }; |
57 | my $field = Column->new({ |
58 | name => $fdata->{name}, |
59 | data_type => $fdata->{data_type}, |
60 | sql_data_type => $self->data_type_mapping->{$fdata->{data_type}} || -999999, |
61 | size => $fdata->{size}, |
62 | default_value => $fdata->{default}, |
63 | is_auto_increment => $fdata->{is_auto_inc}, |
64 | is_nullable => $fdata->{null}, |
65 | is_primary_key => $fdata->{is_primary_key} ? 1 : 0, |
02989ef4 |
66 | comments => $fdata->{comments}, |
67 | table => $table, |
acfd88b5 |
68 | }); |
69 | $table->add_column($field); |
70 | |
71 | $table->primary_key( $field->name ) if $fdata->{'is_primary_key'}; |
72 | |
73 | my %extra; |
74 | for my $qual ( qw[ binary unsigned zerofill list collate ], |
75 | 'character set', 'on update' ) { |
76 | if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) { |
77 | next if ref $val eq 'ARRAY' && !@$val; |
78 | $extra{$qual} = $val; |
79 | #$field->extra( $qual, $val ); |
80 | } |
81 | } |
82 | $field->extra(\%extra); |
83 | |
84 | if ( $fdata->{has_index} ) { |
ec2351fe |
85 | my $index = Index->new({ name => '', type => 'NORMAL', table => $table }); |
acfd88b5 |
86 | $index->add_column($table->get_column($fdata->{name})); |
87 | $table->add_index($index); |
88 | } |
89 | |
90 | if ( $fdata->{is_unique} ) { |
91 | push @{ $tdata->{constraints} }, { name => '', type => 'UNIQUE', fields => [ $fdata->{name} ] }; |
acfd88b5 |
92 | } |
93 | |
94 | for my $cdata ( @{ $fdata->{constraints} } ) { |
95 | next unless lc $cdata->{type} eq 'foreign_key'; |
96 | $cdata->{fields} ||= [ $field->name ]; |
97 | push @{ $tdata->{constraints} }, $cdata; |
98 | } |
99 | } |
100 | |
101 | for my $idata ( @{ $tdata->{indices} || [] } ) { |
02989ef4 |
102 | my $index = Index->new({ name => $idata->{name} || '', type => uc($idata->{type}), table => $table }); |
acfd88b5 |
103 | map { $index->add_column($table->get_column($_)) } @{$idata->{fields}}; |
104 | $table->add_index($index); |
105 | } |
106 | |
107 | |
108 | # if ( my @options = @{ $tdata->{'table_options'} || [] } ) { |
109 | # my @cleaned_options; |
110 | # my @ignore_opts = $self->parser_args->{'ignore_opts'} |
111 | # ? split( /,/, $self->parser_args->{'ignore_opts'} ) |
112 | # : (); |
113 | # if (@ignore_opts) { |
114 | # my $ignores = { map { $_ => 1 } @ignore_opts }; |
115 | # foreach my $option (@options) { |
116 | # # make sure the option isn't in ignore list |
117 | # my ($option_key) = keys %$option; |
118 | # if ( !exists $ignores->{$option_key} ) { |
119 | # push @cleaned_options, $option; |
120 | # } |
121 | # } |
122 | # } else { |
123 | # @cleaned_options = @options; |
124 | # } |
125 | # $table->options( \@cleaned_options ) or die $table->error; |
126 | # } |
127 | |
128 | for my $cdata ( @{ $tdata->{constraints} || [] } ) { |
129 | my $constraint; |
130 | if (uc $cdata->{type} eq 'PRIMARY_KEY') { |
acf110dc |
131 | $constraint = PrimaryKey->new({ name => $cdata->{name} || '', table => $table }); |
132 | $table->get_column($_)->is_primary_key(1) for @{$cdata->{fields}}; |
acfd88b5 |
133 | } elsif (uc $cdata->{type} eq 'FOREIGN_KEY') { |
acf110dc |
134 | $constraint = ForeignKey->new({ name => $cdata->{name} || '', |
02989ef4 |
135 | table => $table, |
acfd88b5 |
136 | reference_table => $cdata->{reference_table}, |
137 | reference_columns => $cdata->{reference_fields}, |
138 | on_delete => $cdata->{on_delete} || $cdata->{on_delete_do}, |
139 | on_update => $cdata->{on_update} || $cdata->{on_update_do} }); |
140 | $table->get_column($_)->is_foreign_key(1) for @{$cdata->{fields}}; |
141 | $table->get_column($_)->foreign_key_reference($constraint) for @{$cdata->{fields}}; |
142 | } else { |
acf110dc |
143 | $constraint = Constraint->new({ name => $cdata->{name} || '', type => uc $cdata->{type}, table => $table }); |
acfd88b5 |
144 | } |
acf110dc |
145 | $constraint->add_column($table->get_column($_)) for @{$cdata->{fields}}; |
acfd88b5 |
146 | $table->add_constraint($constraint); |
acfd88b5 |
147 | } |
148 | |
149 | # After the constrains and PK/idxs have been created, |
150 | # we normalize fields |
151 | normalize_field($_) for $table->get_fields; |
152 | } |
153 | |
84f95c6e |
154 | for my $proc_name ( keys %{ $result->{procedures} } ) { |
155 | my $procedure = Procedure->new({ name => $proc_name, |
156 | owner => $result->{procedures}->{$proc_name}->{owner}, |
157 | sql => $result->{procedures}->{$proc_name}->{sql} |
158 | }); |
159 | $schema->add_procedure($procedure); |
160 | } |
acfd88b5 |
161 | |
84f95c6e |
162 | for my $view_name ( keys %{ $result->{'views'} } ) { |
163 | my $view = View->new({ |
164 | name => $view_name, |
165 | sql => $result->{'views'}->{$view_name}->{sql}, |
166 | }); |
167 | $schema->add_view($view); |
168 | } |
169 | return 1; |
acfd88b5 |
170 | } |
171 | |
172 | # Takes a field, and returns |
173 | method normalize_field { |
174 | my ($size, $type, $list, $changed); # = @_; |
175 | |
176 | $size = $self->size || 0; |
177 | $type = $self->data_type; |
178 | $list = $self->extra->{list} || []; |
179 | |
180 | if ( !ref $size && $size == 0 ) { |
181 | if ( lc $type eq 'tinyint' ) { |
182 | $changed = $size != 4; |
183 | $size = 4; |
184 | } |
185 | elsif ( lc $type eq 'smallint' ) { |
186 | $changed = $size != 6; |
187 | $size = 6; |
188 | } |
189 | elsif ( lc $type eq 'mediumint' ) { |
190 | $changed = $size != 9; |
191 | $size = 9; |
192 | } |
193 | elsif ( $type =~ /^int(eger)?$/i ) { |
194 | $changed = $size != 11 || $type ne 'int'; |
195 | $type = 'int'; |
196 | $size = 11; |
197 | } |
198 | elsif ( lc $type eq 'bigint' ) { |
199 | $changed = $size != 20; |
200 | $size = 20; |
201 | } |
202 | elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) { |
203 | my $old_size = (ref $size || '') eq 'ARRAY' ? $size : []; |
204 | $changed = @$old_size != 2 |
205 | || $old_size->[0] != 8 |
206 | || $old_size->[1] != 2; |
207 | $size = [8,2]; |
208 | } |
209 | } |
210 | |
211 | if ( $type =~ /^tiny(text|blob)$/i ) { |
212 | $changed = $size != 255; |
213 | $size = 255; |
214 | } |
215 | elsif ( $type =~ /^(blob|text)$/i ) { |
216 | $changed = $size != 65_535; |
217 | $size = 65_535; |
218 | } |
219 | elsif ( $type =~ /^medium(blob|text)$/i ) { |
220 | $changed = $size != 16_777_215; |
221 | $size = 16_777_215; |
222 | } |
223 | elsif ( $type =~ /^long(blob|text)$/i ) { |
224 | $changed = $size != 4_294_967_295; |
225 | $size = 4_294_967_295; |
226 | } |
227 | |
228 | if ( $type =~ /(set|enum)/i && !$size ) { |
229 | my %extra = $self->extra; |
230 | my $longest = 0; |
231 | for my $len ( map { length } @{ $extra{'list'} || [] } ) { |
232 | $longest = $len if $len > $longest; |
233 | } |
234 | $changed = 1; |
235 | $size = $longest if $longest; |
236 | } |
237 | |
238 | # if ( $changed ) { |
239 | # We only want to clone the field, not *everything* |
240 | # { |
241 | # local $field->{table} = undef; |
242 | # $field->parsed_field( dclone( $field ) ); |
243 | # $field->parsed_field->{table} = $field->table; |
244 | # } |
245 | $self->size( $size ); |
246 | $self->data_type( $type ); |
247 | # $column->sql_data_type( $self->data_type_mapping->{$type} || -99999 ); |
248 | $self->extra->{list} = $list if @$list; |
249 | # } |
bf2a7e53 |
250 | return 1; |
acfd88b5 |
251 | } |
4f4fd192 |
252 | } |