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 target_schema
17 case_insensitive no_batch_alters ignore_missing_methods producer_options
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, $output_db, $options) = @_;
51 my $obj = SQL::Translator::Diff->new( {
53 source_schema => $source_schema,
54 target_schema => $target_schema,
55 output_db => $output_db
58 $obj->compute_differences->produce_diff_sql;
62 my ($class, $values) = @_;
63 $values->{$_} ||= [] foreach @diff_arrays;
64 $values->{table_diff_hash} = {};
66 $values->{producer_options} ||= {};
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}{$_}
184 $self->producer_options
189 # If we have any table renames we need to do those first;
191 foreach my $table ( sort keys %{$self->table_diff_hash} ) {
192 my $table_diff = $self->table_diff_hash->{$table};
193 for (@diff_hash_keys) {
194 push( @{ $flattened_diffs{ $func_map{$_} } ||= [] }, @{ $table_diff->{$_} } );
199 if (@{ $flattened_diffs{$_} || [] }) {
200 my $meth = $producer_class->can($_);
203 my $sql = $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $self->producer_options );
204 $sql ? ("$sql") : ();
205 } @{ $flattened_diffs{$_} }
206 : $self->ignore_missing_methods
207 ? "-- $producer_class cant $_"
208 : die "$producer_class cant $_";
212 alter_drop_constraint
219 alter_create_constraint
223 if (my @tables = @{ $self->tables_to_create } ) {
224 my $translator = new SQL::Translator(
225 producer_type => $self->output_db,
228 # TODO: sort out options
229 %{ $self->producer_options }
231 $translator->producer_args->{no_transaction} = 1;
232 my $schema = $translator->schema;
234 $schema->add_table($_) for @tables;
237 # Remove begin/commit here, since we wrap everything in one.
238 grep { $_ !~ /^(?:COMMIT|START(?: TRANSACTION)?|BEGIN(?: TRANSACTION)?)/ } $producer_class->can('produce')->($translator);
241 if (my @tables_to_drop = @{ $self->{tables_to_drop} || []} ) {
242 my $meth = $producer_class->can('drop_table');
244 push @diffs, $meth ? ( map { $meth->($_, $self->producer_options) } @tables_to_drop)
245 : $self->ignore_missing_methods
246 ? "-- $producer_class cant drop_table"
247 : die "$producer_class cant drop_table";
251 unshift @diffs, "BEGIN";
252 push @diffs, "\nCOMMIT";
254 @diffs = ("-- No differences found");
258 if ( $self->output_db !~ /^(?:MySQL|SQLite|PostgreSQL)$/ ) {
259 unshift(@diffs, "-- Output database @{[$self->output_db]} is untested/unsupported!!!");
261 return join '', map { $_ ? ( $_ =~ /;$/xms ? $_ : "$_;\n\n" ) : "\n" }
262 ("-- Convert schema '$src_name' to '$tar_name':", @diffs);
268 sub diff_table_indexes {
269 my ($self, $src_table, $tar_table) = @_;
271 my (%checked_indices);
273 for my $i_tar ( $tar_table->get_indices ) {
274 for my $i_src ( $src_table->get_indices ) {
275 if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
276 $checked_indices{$i_src} = 1;
280 push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
284 for my $i_src ( $src_table->get_indices ) {
285 next if !$self->ignore_index_names && $checked_indices{$i_src};
286 for my $i_tar ( $tar_table->get_indices ) {
287 next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
289 push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
294 sub diff_table_constraints {
295 my ($self, $src_table, $tar_table) = @_;
297 my(%checked_constraints);
299 for my $c_tar ( $tar_table->get_constraints ) {
300 for my $c_src ( $src_table->get_constraints ) {
302 # This is a bit of a hack - needed for renaming tables to work
303 local $c_src->{table} = $tar_table;
305 if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
306 $checked_constraints{$c_src} = 1;
307 next CONSTRAINT_CREATE;
310 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
315 for my $c_src ( $src_table->get_constraints ) {
317 # This is a bit of a hack - needed for renaming tables to work
318 local $c_src->{table} = $tar_table;
320 next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
321 for my $c_tar ( $tar_table->get_constraints ) {
322 next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
325 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
330 sub diff_table_fields {
331 my ($self, $src_table, $tar_table) = @_;
333 # List of ones ew've renamed from so we dont drop them
334 my %renamed_source_fields;
336 for my $tar_table_field ( $tar_table->get_fields ) {
337 my $f_tar_name = $tar_table_field->name;
339 if (my $old_name = $tar_table_field->extra->{renamed_from}) {
340 my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
341 unless ($src_table_field) {
342 warn qq#Renamed column can't find old column "@{[$src_table->name]}.$old_name" for renamed column\n#;
343 delete $tar_table_field->extra->{renamed_from};
345 push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
346 $renamed_source_fields{$old_name} = 1;
351 my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
353 unless ( $src_table_field ) {
354 push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
358 # field exists, something changed. This is a bit complex. Parsers can
359 # normalize types, but only some of them do, so compare the normalized and
360 # parsed types for each field to each other
361 if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
362 !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
363 !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
364 !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
366 # Some producers might need src field to diff against
367 push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
373 # Now check to see if any fields from src_table need to be dropped
374 for my $src_table_field ( $src_table->get_fields ) {
375 my $f_src_name = $src_table_field->name;
376 next if $renamed_source_fields{$f_src_name};
378 my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
380 unless ( $tar_table_field ) {
381 push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
387 sub diff_table_options {
388 my ($self, $src_table, $tar_table) = @_;
391 my ($a_name, undef, $b_name, undef) = ( %$a, %$b );
394 # Need to sort the options so we dont get supruious diffs.
395 my (@src_opts, @tar_opts);
396 @src_opts = sort $cmp $src_table->options;
397 @tar_opts = sort $cmp $tar_table->options;
400 # If there's a difference, just re-set all the options
401 push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
402 unless $src_table->_compare_objects( \@src_opts, \@tar_opts );
411 SQL::Translator::Diff
415 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
416 statments to make them the same
422 use SQL::Translator::Diff;
423 my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
427 use SQL::Translator::Diff;
428 my $diff = SQL::Translator::Diff->new({
429 output_db => 'MySQL',
430 source_schema => $source_schema,
431 target_schema => $target_schema,
433 })->compute_differences->produce_diff_sql;
439 =item B<ignore_index_names>
441 Match indexes based on types and fields, ignoring name.
443 =item B<ignore_constraint_names>
445 Match constrains based on types, fields and tables, ignoring name.
449 Which producer to use to produce the output.
451 =item B<case_insensitive>
453 Ignore case of table, field, index and constraint names when comparing
455 =item B<no_batch_alters>
457 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
458 supports the ability to do all alters for a table as one statement.
460 =item B<ignore_missing_methods>
462 If the diff would need a method that is missing from the producer, just emit a
463 comment showing the method is missing, rather than dieing with an error
467 =head1 PRODUCER FUNCTIONS
469 The following producer functions should be implemented for completeness. If
470 any of them are needed for a given diff, but not found, an error will be
475 =item * C<alter_create_constraint($con)>
477 =item * C<alter_drop_constraint($con)>
479 =item * C<alter_create_index($idx)>
481 =item * C<alter_drop_index($idx)>
483 =item * C<add_field($fld)>
485 =item * C<alter_field($old_fld, $new_fld)>
487 =item * C<rename_field($old_fld, $new_fld)>
489 =item * C<drop_field($fld)>
491 =item * C<alter_table($table)>
493 =item * C<drop_table($table)>
495 =item * C<rename_table($old_table, $new_table)> (optional)
497 =item * C<batch_alter_table($table, $hash)> (optional)
499 If the producer supports C<batch_alter_table>, it will be called with the
500 table to alter and a hash, the keys of which will be the method names listed
501 above; values will be arrays of fields or constraints to operate on. In the
502 case of the field functions that take two arguments this will appear as a hash.
504 I.e. the hash might look something like the following:
507 alter_create_constraint => [ $constraint1, $constraint2 ],
508 add_field => [ $field ],
509 alter_field => [ [$old_field, $new_field] ]
513 =item * C<preprocess_schema($class, $schema)> (optional)
515 C<preprocess_schema> is called by the Diff code to allow the producer to
516 normalize any data it needs to first. For example, the MySQL producer uses
517 this method to ensure that FK contraint names are unique.
519 Basicaly any changes that need to be made to produce the SQL file for the
520 schema should be done here, so that a diff between a parsed SQL file and (say)
521 a parsed DBIx::Class::Schema object will be sane.
523 (As an aside, DBIx::Class, for instance, uses the presence of a
524 C<preprocess_schema> function on the producer to know that it can diff between
525 the previous SQL file and its own internal representation. Without this method
526 on th producer it will diff the two SQL files which is slower, but known to
527 work better on old-style producers.)
534 Original Author(s) unknown.
536 Refactor/re-write and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
538 Redevelopment sponsored by Takkle Inc.