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 $preprocess->($source_schema);
83 $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)
485 If the producer supports C<batch_alter_table>, it will be called with the
486 table to alter and a hash, the keys of which will be the method names listed
487 above; values will be arrays of fields or constraints to operate on. In the
488 case of the field functions that take two arguments this will appear as a hash.
490 I.e. the hash might look something like the following:
493 alter_create_constraint => [ $constraint1, $constraint2 ],
494 add_field => [ $field ],
495 alter_field => [ [$old_field, $new_field] ]
499 =item * C<preprocess_schema($class, $schema)> (optional)
501 C<preprocess_schema> is called by the Diff code to allow the producer to
502 normalize any data it needs to first. For example, the MySQL producer uses
503 this method to ensure that FK contraint names are unique.
505 Basicaly any changes that need to be made to produce the SQL file for the
506 schema should be done here, so that a diff between a parsed SQL file and (say)
507 a parsed DBIx::Class::Schema object will be sane.
509 (As an aside, DBIx::Class, for instance, uses the presence of a
510 C<preprocess_schema> function on the producer to know that it can diff between
511 the previous SQL file and its own internal representation. Without this method
512 on th producer it will diff the two SQL files which is slower, but known to
513 work better on old-style producers.)
520 Original Author(s) unknown.
522 Refactor/re-write and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
524 Redevelopment sponsored by Takkle Inc.