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!!!");
263 map { $_ ? ( $_ =~ /;$/xms ? $_ : "$_;\n\n" ) : "\n" }
264 ("-- Convert schema '$src_name' to '$tar_name':", @diffs);
266 return wantarray ? @return : join('', @return);
272 sub diff_table_indexes {
273 my ($self, $src_table, $tar_table) = @_;
275 my (%checked_indices);
277 for my $i_tar ( $tar_table->get_indices ) {
278 for my $i_src ( $src_table->get_indices ) {
279 if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
280 $checked_indices{$i_src} = 1;
284 push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
288 for my $i_src ( $src_table->get_indices ) {
289 next if !$self->ignore_index_names && $checked_indices{$i_src};
290 for my $i_tar ( $tar_table->get_indices ) {
291 next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
293 push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
298 sub diff_table_constraints {
299 my ($self, $src_table, $tar_table) = @_;
301 my(%checked_constraints);
303 for my $c_tar ( $tar_table->get_constraints ) {
304 for my $c_src ( $src_table->get_constraints ) {
306 # This is a bit of a hack - needed for renaming tables to work
307 local $c_src->{table} = $tar_table;
309 if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
310 $checked_constraints{$c_src} = 1;
311 next CONSTRAINT_CREATE;
314 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
319 for my $c_src ( $src_table->get_constraints ) {
321 # This is a bit of a hack - needed for renaming tables to work
322 local $c_src->{table} = $tar_table;
324 next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
325 for my $c_tar ( $tar_table->get_constraints ) {
326 next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
329 push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
334 sub diff_table_fields {
335 my ($self, $src_table, $tar_table) = @_;
337 # List of ones ew've renamed from so we dont drop them
338 my %renamed_source_fields;
340 for my $tar_table_field ( $tar_table->get_fields ) {
341 my $f_tar_name = $tar_table_field->name;
343 if (my $old_name = $tar_table_field->extra->{renamed_from}) {
344 my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
345 unless ($src_table_field) {
346 warn qq#Renamed column can't find old column "@{[$src_table->name]}.$old_name" for renamed column\n#;
347 delete $tar_table_field->extra->{renamed_from};
349 push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
350 $renamed_source_fields{$old_name} = 1;
355 my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
357 unless ( $src_table_field ) {
358 push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
362 # field exists, something changed. This is a bit complex. Parsers can
363 # normalize types, but only some of them do, so compare the normalized and
364 # parsed types for each field to each other
365 if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
366 !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
367 !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
368 !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
370 # Some producers might need src field to diff against
371 push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
377 # Now check to see if any fields from src_table need to be dropped
378 for my $src_table_field ( $src_table->get_fields ) {
379 my $f_src_name = $src_table_field->name;
380 next if $renamed_source_fields{$f_src_name};
382 my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
384 unless ( $tar_table_field ) {
385 push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
391 sub diff_table_options {
392 my ($self, $src_table, $tar_table) = @_;
395 my ($a_name, undef, $b_name, undef) = ( %$a, %$b );
398 # Need to sort the options so we dont get supruious diffs.
399 my (@src_opts, @tar_opts);
400 @src_opts = sort $cmp $src_table->options;
401 @tar_opts = sort $cmp $tar_table->options;
404 # If there's a difference, just re-set all the options
405 push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
406 unless $src_table->_compare_objects( \@src_opts, \@tar_opts );
415 SQL::Translator::Diff
419 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
420 statments to make them the same
426 use SQL::Translator::Diff;
427 my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
431 use SQL::Translator::Diff;
432 my $diff = SQL::Translator::Diff->new({
433 output_db => 'MySQL',
434 source_schema => $source_schema,
435 target_schema => $target_schema,
437 })->compute_differences->produce_diff_sql;
443 =item B<ignore_index_names>
445 Match indexes based on types and fields, ignoring name.
447 =item B<ignore_constraint_names>
449 Match constrains based on types, fields and tables, ignoring name.
453 Which producer to use to produce the output.
455 =item B<case_insensitive>
457 Ignore case of table, field, index and constraint names when comparing
459 =item B<no_batch_alters>
461 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
462 supports the ability to do all alters for a table as one statement.
464 =item B<ignore_missing_methods>
466 If the diff would need a method that is missing from the producer, just emit a
467 comment showing the method is missing, rather than dieing with an error
471 =head1 PRODUCER FUNCTIONS
473 The following producer functions should be implemented for completeness. If
474 any of them are needed for a given diff, but not found, an error will be
479 =item * C<alter_create_constraint($con)>
481 =item * C<alter_drop_constraint($con)>
483 =item * C<alter_create_index($idx)>
485 =item * C<alter_drop_index($idx)>
487 =item * C<add_field($fld)>
489 =item * C<alter_field($old_fld, $new_fld)>
491 =item * C<rename_field($old_fld, $new_fld)>
493 =item * C<drop_field($fld)>
495 =item * C<alter_table($table)>
497 =item * C<drop_table($table)>
499 =item * C<rename_table($old_table, $new_table)> (optional)
501 =item * C<batch_alter_table($table, $hash)> (optional)
503 If the producer supports C<batch_alter_table>, it will be called with the
504 table to alter and a hash, the keys of which will be the method names listed
505 above; values will be arrays of fields or constraints to operate on. In the
506 case of the field functions that take two arguments this will appear as a hash.
508 I.e. the hash might look something like the following:
511 alter_create_constraint => [ $constraint1, $constraint2 ],
512 add_field => [ $field ],
513 alter_field => [ [$old_field, $new_field] ]
517 =item * C<preprocess_schema($class, $schema)> (optional)
519 C<preprocess_schema> is called by the Diff code to allow the producer to
520 normalize any data it needs to first. For example, the MySQL producer uses
521 this method to ensure that FK contraint names are unique.
523 Basicaly any changes that need to be made to produce the SQL file for the
524 schema should be done here, so that a diff between a parsed SQL file and (say)
525 a parsed DBIx::Class::Schema object will be sane.
527 (As an aside, DBIx::Class, for instance, uses the presence of a
528 C<preprocess_schema> function on the producer to know that it can diff between
529 the previous SQL file and its own internal representation. Without this method
530 on th producer it will diff the two SQL files which is slower, but known to
531 work better on old-style producers.)
538 Original Author(s) unknown.
540 Refactor/re-write and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
542 Redevelopment sponsored by Takkle Inc.