1 package SQL::Translator::Diff;
4 ## SQLT schema diffing code
9 use SQL::Translator::Schema::Constants;
11 use base 'Class::Accessor::Fast';
13 # Input/option accessors
14 __PACKAGE__->mk_accessors(qw/
15 ignore_index_names ignore_constraint_names ignore_view_sql
16 ignore_proc_sql output_db source_schema source_db target_schema target_db
17 case_insensitive no_batch_alters ignore_missing_methods
25 my @diff_hash_keys = qw/
38 __PACKAGE__->mk_accessors(@diff_arrays, 'table_diff_hash');
42 ## we are getting instructions on how to turn the source into the target
43 ## source == original, target == new (hmm, if I need to comment this, should I rename the vars again ??)
44 ## _schema isa SQL::Translator::Schema
45 ## _db is the name of the producer/db it came out of/into
46 ## results are formatted to the source preferences
48 my ($source_schema, $source_db, $target_schema, $target_db, $options) = @_;
51 my $obj = SQL::Translator::Diff->new( {
53 source_schema => $source_schema,
54 source_db => $source_db,
55 target_schema => $target_schema,
56 target_db => $target_db
59 $obj->compute_differences->produce_diff_sql;
63 my ($class, $values) = @_;
64 $values->{$_} ||= [] foreach @diff_arrays;
65 $values->{table_diff_hash} = {};
67 $values->{output_db} ||= $values->{source_db};
68 return $class->SUPER::new($values);
71 sub compute_differences {
74 my $target_schema = $self->target_schema;
75 my $source_schema = $self->source_schema;
77 my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
78 eval "require $producer_class";
81 if (my $preprocess = $producer_class->can('preprocess_schema')) {
82 $producer_class->$preprocess($source_schema);
83 $producer_class->$preprocess($target_schema);
86 my %src_tables_checked = ();
87 my @tar_tables = sort { $a->name cmp $b->name } $target_schema->get_tables;
88 ## do original/source tables exist in target?
89 for my $tar_table ( @tar_tables ) {
90 my $tar_table_name = $tar_table->name;
94 $self->table_diff_hash->{$tar_table_name} = {
95 map {$_ => [] } @diff_hash_keys
98 if (my $old_name = $tar_table->extra('renamed_from')) {
99 $src_table = $source_schema->get_table( $old_name, $self->case_insensitive );
101 $self->table_diff_hash->{$tar_table_name}{table_renamed_from} = [ [$src_table, $tar_table] ];
103 delete $tar_table->extra->{renamed_from};
104 warn qq#Renamed table can't find old table "$old_name" for renamed table\n#;
107 $src_table = $source_schema->get_table( $tar_table_name, $self->case_insensitive );
110 unless ( $src_table ) {
112 ## add table(s) later.
113 push @{$self->tables_to_create}, $tar_table;
117 my $src_table_name = $src_table->name;
118 $src_table_name = lc $src_table_name if $self->case_insensitive;
119 $src_tables_checked{$src_table_name} = 1;
122 $self->diff_table_options($src_table, $tar_table);
124 ## Compare fields, their types, defaults, sizes etc etc
125 $self->diff_table_fields($src_table, $tar_table);
127 $self->diff_table_indexes($src_table, $tar_table);
128 $self->diff_table_constraints($src_table, $tar_table);
130 } # end of target_schema->get_tables loop
132 for my $src_table ( $source_schema->get_tables ) {
133 my $src_table_name = $src_table->name;
135 $src_table_name = lc $src_table_name if $self->case_insensitive;
137 push @{ $self->tables_to_drop}, $src_table
138 unless $src_tables_checked{$src_table_name};
144 sub produce_diff_sql {
147 my $target_schema = $self->target_schema;
148 my $source_schema = $self->source_schema;
149 my $tar_name = $target_schema->name;
150 my $src_name = $source_schema->name;
152 my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
153 eval "require $producer_class";
156 # Map of name we store under => producer method name
158 constraints_to_create => 'alter_create_constraint',
159 constraints_to_drop => 'alter_drop_constraint',
160 indexes_to_create => 'alter_create_index',
161 indexes_to_drop => 'alter_drop_index',
162 fields_to_create => 'add_field',
163 fields_to_alter => 'alter_field',
164 fields_to_rename => 'rename_field',
165 fields_to_drop => 'drop_field',
166 table_options => 'alter_table',
167 table_renamed_from => 'rename_table',
171 if (!$self->no_batch_alters &&
172 (my $batch_alter = $producer_class->can('batch_alter_table')) )
174 # Good - Producer supports batch altering of tables.
175 foreach my $table ( sort keys %{$self->table_diff_hash} ) {
176 my $tar_table = $target_schema->get_table($table)
177 || $source_schema->get_table($table);
179 push @diffs, $batch_alter->($tar_table,
181 $func_map{$_} => $self->table_diff_hash->{$table}{$_}
188 # If we have any table renames we need to do those first;
190 foreach my $table ( sort keys %{$self->table_diff_hash} ) {
191 my $table_diff = $self->table_diff_hash->{$table};
192 for (@diff_hash_keys) {
193 push( @{ $flattened_diffs{ $func_map{$_} } ||= [] }, @{ $table_diff->{$_} } );
198 if (@{ $flattened_diffs{$_} || [] }) {
199 my $meth = $producer_class->can($_);
201 $meth ? map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ? ("$sql;") : () } @{ $flattened_diffs{$_} }
202 : $self->ignore_missing_methods
203 ? "-- $producer_class cant $_"
204 : die "$producer_class cant $_";
208 alter_drop_constraint
215 alter_create_constraint
219 if (my @tables = @{ $self->tables_to_create } ) {
220 my $translator = new SQL::Translator(
221 producer_type => $self->output_db,
224 # TODO: sort out options
225 quote_table_names => 0,
226 quote_field_names => 0,
228 my $schema = $translator->schema;
230 $schema->add_table($_) for @tables;
233 # Remove begin/commit here, since we wrap everything in one.
234 grep { $_ !~ /^(?:COMMIT|START(?: TRANSACTION)?|BEGIN(?: TRANSACTION)?);/ } $producer_class->can('produce')->($translator);
237 if (my @tables_to_drop = @{ $self->{tables_to_drop} || []} ) {
238 my $meth = $producer_class->can('drop_table');
240 push @diffs, $meth ? map( { $meth->($_) } @tables_to_drop )
241 : $self->ignore_missing_methods
242 ? "-- $producer_class cant drop_table"
243 : die "$producer_class cant drop_table";
247 unshift @diffs, "BEGIN;\n";
248 push @diffs, "\nCOMMIT;\n";
250 @diffs = ("-- No differences found\n\n");
254 if ( $self->target_db !~ /^(?:MySQL|SQLite)$/ ) {
255 unshift(@diffs, "-- Target database @{[$self->target_db]} is untested/unsupported!!!");
257 return join( "\n", "-- Convert schema '$src_name' to '$tar_name':\n", @diffs);
263 sub diff_table_indexes {
264 my ($self, $src_table, $tar_table) = @_;
266 my (%checked_indices);
268 for my $i_tar ( $tar_table->get_indices ) {
269 for my $i_src ( $src_table->get_indices ) {
270 if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
271 $checked_indices{$i_src} = 1;
275 push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
279 for my $i_src ( $src_table->get_indices ) {
280 next if !$self->ignore_index_names && $checked_indices{$i_src};
281 for my $i_tar ( $tar_table->get_indices ) {
282 next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
284 push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
289 sub diff_table_constraints {
290 my ($self, $src_table, $tar_table) = @_;
292 my(%checked_constraints);
294 for my $c_tar ( $tar_table->get_constraints ) {
295 for my $c_src ( $src_table->get_constraints ) {
297 # This is a bit of a hack - needed for renaming tables to work
298 local $c_src->{table} = $tar_table;
300 if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
301 $checked_constraints{$c_src} = 1;
302 next CONSTRAINT_CREATE;
305 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
310 for my $c_src ( $src_table->get_constraints ) {
312 # This is a bit of a hack - needed for renaming tables to work
313 local $c_src->{table} = $tar_table;
315 next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
316 for my $c_tar ( $tar_table->get_constraints ) {
317 next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
320 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
325 sub diff_table_fields {
326 my ($self, $src_table, $tar_table) = @_;
328 # List of ones ew've renamed from so we dont drop them
329 my %renamed_source_fields;
331 for my $tar_table_field ( $tar_table->get_fields ) {
332 my $f_tar_name = $tar_table_field->name;
334 if (my $old_name = $tar_table_field->extra->{renamed_from}) {
335 my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
336 unless ($src_table_field) {
337 warn qq#Renamed column can't find old column "@{[$src_table->name]}.$old_name" for renamed column\n#;
338 delete $tar_table_field->extra->{renamed_from};
340 push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
341 $renamed_source_fields{$old_name} = 1;
346 my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
348 unless ( $src_table_field ) {
349 push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
353 # field exists, something changed. This is a bit complex. Parsers can
354 # normalize types, but only some of them do, so compare the normalized and
355 # parsed types for each field to each other
356 if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
357 !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
358 !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
359 !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
361 # Some producers might need src field to diff against
362 push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
368 # Now check to see if any fields from src_table need to be dropped
369 for my $src_table_field ( $src_table->get_fields ) {
370 my $f_src_name = $src_table_field->name;
371 next if $renamed_source_fields{$f_src_name};
373 my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
375 unless ( $tar_table_field ) {
376 push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
382 sub diff_table_options {
383 my ($self, $src_table, $tar_table) = @_;
386 # If there's a difference, just re-set all the options
387 push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
388 unless $src_table->_compare_objects( scalar $src_table->options, scalar $tar_table->options );
397 SQL::Translator::Diff
401 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
402 statments to make them the same
408 use SQL::Translator::Diff;
409 my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
413 use SQL::Translator::Diff;
414 my $diff = SQL::Translator::Diff->new({
415 output_db => 'MySQL',
416 source_schema => $source_schema,
417 target_schema => $target_schema,
419 })->compute_differences->produce_diff_sql;
425 =item B<ignore_index_names>
427 Match indexes based on types and fields, ignoring name.
429 =item B<ignore_constraint_names>
431 Match constrains based on types, fields and tables, ignoring name.
435 Which producer to use to produce the output.
437 =item B<case_insensitive>
439 Ignore case of table, field, index and constraint names when comparing
441 =item B<no_batch_alters>
443 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
444 supports the ability to do all alters for a table as one statement.
446 =item B<ignore_missing_methods>
448 If the diff would need a method that is missing from the producer, just emit a
449 comment showing the method is missing, rather than dieing with an error
453 =head1 PRODUCER FUNCTIONS
455 The following producer functions should be implemented for completeness. If
456 any of them are needed for a given diff, but not found, an error will be
461 =item * C<alter_create_constraint($con)>
463 =item * C<alter_drop_constraint($con)>
465 =item * C<alter_create_index($idx)>
467 =item * C<alter_drop_index($idx)>
469 =item * C<add_field($fld)>
471 =item * C<alter_field($old_fld, $new_fld)>
473 =item * C<rename_field($old_fld, $new_fld)>
475 =item * C<drop_field($fld)>
477 =item * C<alter_table($table)>
479 =item * C<drop_table($table)>
481 =item * C<rename_table($old_table, $new_table)> (optional)
483 =item * C<batch_alter_table($table, $hash)> (optional)
488 If the producer supports C<batch_alter_table>, it will be called with the
489 table to alter and a hash, the keys of which will be the method names listed
490 above; values will be arrays of fields or constraints to operate on. In the
491 case of the field functions that take two arguments this will appear as a hash.
493 I.e. the hash might look something like the following:
496 alter_create_constraint => [ $constraint1, $constraint2 ],
497 add_field => [ $field ],
498 alter_field => [ [$old_field, $new_field] ]
503 Original Author(s) unknown.
505 Refactor and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
507 Redevelopment sponsored by Takkle Inc.