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 my $schema = $translator->schema;
233 $schema->add_table($_) for @tables;
236 # Remove begin/commit here, since we wrap everything in one.
237 grep { $_ !~ /^(?:COMMIT|START(?: TRANSACTION)?|BEGIN(?: TRANSACTION)?)/ } $producer_class->can('produce')->($translator);
240 if (my @tables_to_drop = @{ $self->{tables_to_drop} || []} ) {
241 my $meth = $producer_class->can('drop_table');
243 push @diffs, $meth ? ( map { $meth->($_, $self->producer_options) } @tables_to_drop)
244 : $self->ignore_missing_methods
245 ? "-- $producer_class cant drop_table"
246 : die "$producer_class cant drop_table";
250 unshift @diffs, "BEGIN";
251 push @diffs, "\nCOMMIT";
253 @diffs = ("-- No differences found");
257 if ( $self->output_db !~ /^(?:MySQL|SQLite)$/ ) {
258 unshift(@diffs, "-- Output database @{[$self->output_db]} is untested/unsupported!!!");
260 return join '', map { $_ ? "$_;\n\n" : "\n" } ("-- Convert schema '$src_name' to '$tar_name':", @diffs);
266 sub diff_table_indexes {
267 my ($self, $src_table, $tar_table) = @_;
269 my (%checked_indices);
271 for my $i_tar ( $tar_table->get_indices ) {
272 for my $i_src ( $src_table->get_indices ) {
273 if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
274 $checked_indices{$i_src} = 1;
278 push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
282 for my $i_src ( $src_table->get_indices ) {
283 next if !$self->ignore_index_names && $checked_indices{$i_src};
284 for my $i_tar ( $tar_table->get_indices ) {
285 next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
287 push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
292 sub diff_table_constraints {
293 my ($self, $src_table, $tar_table) = @_;
295 my(%checked_constraints);
297 for my $c_tar ( $tar_table->get_constraints ) {
298 for my $c_src ( $src_table->get_constraints ) {
300 # This is a bit of a hack - needed for renaming tables to work
301 local $c_src->{table} = $tar_table;
303 if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
304 $checked_constraints{$c_src} = 1;
305 next CONSTRAINT_CREATE;
308 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
313 for my $c_src ( $src_table->get_constraints ) {
315 # This is a bit of a hack - needed for renaming tables to work
316 local $c_src->{table} = $tar_table;
318 next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
319 for my $c_tar ( $tar_table->get_constraints ) {
320 next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
323 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
328 sub diff_table_fields {
329 my ($self, $src_table, $tar_table) = @_;
331 # List of ones ew've renamed from so we dont drop them
332 my %renamed_source_fields;
334 for my $tar_table_field ( $tar_table->get_fields ) {
335 my $f_tar_name = $tar_table_field->name;
337 if (my $old_name = $tar_table_field->extra->{renamed_from}) {
338 my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
339 unless ($src_table_field) {
340 warn qq#Renamed column can't find old column "@{[$src_table->name]}.$old_name" for renamed column\n#;
341 delete $tar_table_field->extra->{renamed_from};
343 push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
344 $renamed_source_fields{$old_name} = 1;
349 my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
351 unless ( $src_table_field ) {
352 push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
356 # field exists, something changed. This is a bit complex. Parsers can
357 # normalize types, but only some of them do, so compare the normalized and
358 # parsed types for each field to each other
359 if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
360 !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
361 !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
362 !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
364 # Some producers might need src field to diff against
365 push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
371 # Now check to see if any fields from src_table need to be dropped
372 for my $src_table_field ( $src_table->get_fields ) {
373 my $f_src_name = $src_table_field->name;
374 next if $renamed_source_fields{$f_src_name};
376 my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
378 unless ( $tar_table_field ) {
379 push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
385 sub diff_table_options {
386 my ($self, $src_table, $tar_table) = @_;
389 my ($a_name, undef, $b_name, undef) = ( %$a, %$b );
392 # Need to sort the options so we dont get supruious diffs.
393 my (@src_opts, @tar_opts);
394 @src_opts = sort $cmp $src_table->options;
395 @tar_opts = sort $cmp $tar_table->options;
398 # If there's a difference, just re-set all the options
399 push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
400 unless $src_table->_compare_objects( \@src_opts, \@tar_opts );
409 SQL::Translator::Diff
413 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
414 statments to make them the same
420 use SQL::Translator::Diff;
421 my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
425 use SQL::Translator::Diff;
426 my $diff = SQL::Translator::Diff->new({
427 output_db => 'MySQL',
428 source_schema => $source_schema,
429 target_schema => $target_schema,
431 })->compute_differences->produce_diff_sql;
437 =item B<ignore_index_names>
439 Match indexes based on types and fields, ignoring name.
441 =item B<ignore_constraint_names>
443 Match constrains based on types, fields and tables, ignoring name.
447 Which producer to use to produce the output.
449 =item B<case_insensitive>
451 Ignore case of table, field, index and constraint names when comparing
453 =item B<no_batch_alters>
455 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
456 supports the ability to do all alters for a table as one statement.
458 =item B<ignore_missing_methods>
460 If the diff would need a method that is missing from the producer, just emit a
461 comment showing the method is missing, rather than dieing with an error
465 =head1 PRODUCER FUNCTIONS
467 The following producer functions should be implemented for completeness. If
468 any of them are needed for a given diff, but not found, an error will be
473 =item * C<alter_create_constraint($con)>
475 =item * C<alter_drop_constraint($con)>
477 =item * C<alter_create_index($idx)>
479 =item * C<alter_drop_index($idx)>
481 =item * C<add_field($fld)>
483 =item * C<alter_field($old_fld, $new_fld)>
485 =item * C<rename_field($old_fld, $new_fld)>
487 =item * C<drop_field($fld)>
489 =item * C<alter_table($table)>
491 =item * C<drop_table($table)>
493 =item * C<rename_table($old_table, $new_table)> (optional)
495 =item * C<batch_alter_table($table, $hash)> (optional)
497 If the producer supports C<batch_alter_table>, it will be called with the
498 table to alter and a hash, the keys of which will be the method names listed
499 above; values will be arrays of fields or constraints to operate on. In the
500 case of the field functions that take two arguments this will appear as a hash.
502 I.e. the hash might look something like the following:
505 alter_create_constraint => [ $constraint1, $constraint2 ],
506 add_field => [ $field ],
507 alter_field => [ [$old_field, $new_field] ]
511 =item * C<preprocess_schema($class, $schema)> (optional)
513 C<preprocess_schema> is called by the Diff code to allow the producer to
514 normalize any data it needs to first. For example, the MySQL producer uses
515 this method to ensure that FK contraint names are unique.
517 Basicaly any changes that need to be made to produce the SQL file for the
518 schema should be done here, so that a diff between a parsed SQL file and (say)
519 a parsed DBIx::Class::Schema object will be sane.
521 (As an aside, DBIx::Class, for instance, uses the presence of a
522 C<preprocess_schema> function on the producer to know that it can diff between
523 the previous SQL file and its own internal representation. Without this method
524 on th producer it will diff the two SQL files which is slower, but known to
525 work better on old-style producers.)
532 Original Author(s) unknown.
534 Refactor/re-write and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
536 Redevelopment sponsored by Takkle Inc.