lib/SQL/Translator/Diff.pm

   1 package SQL::Translator::Diff;
   2
   3
   4 ## SQLT schema diffing code
   5 use strict;
   6 use warnings;
   7
   8 use Data::Dumper;
   9 use SQL::Translator::Schema::Constants;
  10
  11 use base 'Class::Accessor::Fast';
  12
  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
  18 /);
  19
  20 my @diff_arrays = qw/
  21   tables_to_drop
  22   tables_to_create
  23 /;
  24
  25 my @diff_hash_keys = qw/
  26   constraints_to_create
  27   constraints_to_drop
  28   indexes_to_create
  29   indexes_to_drop
  30   fields_to_create
  31   fields_to_alter
  32   fields_to_rename
  33   fields_to_drop
  34   table_options
  35 /;
  36
  37 __PACKAGE__->mk_accessors(@diff_arrays, 'table_diff_hash');
  38
  39 sub schema_diff {
  40     #  use Data::Dumper;
  41     ## we are getting instructions on how to turn the source into the target
  42     ## source == original, target == new (hmm, if I need to comment this, should I rename the vars again ??)
  43     ## _schema isa SQL::Translator::Schema
  44     ## _db is the name of the producer/db it came out of/into
  45     ## results are formatted to the source preferences
  46
  47     my ($source_schema, $source_db, $target_schema, $target_db, $options) = @_;
  48     $options ||= {};
  49
  50     my $obj = SQL::Translator::Diff->new( {
  51       %$options,
  52       source_schema => $source_schema,
  53       source_db     => $source_db,
  54       target_schema => $target_schema,
  55       target_db     => $target_db
  56     } );
  57
  58     $obj->compute_differences->produce_diff_sql;
  59 }
  60
  61 sub new {
  62   my ($class, $values) = @_;
  63   $values->{$_} ||= [] foreach @diff_arrays;
  64   $values->{table_diff_hash} = {};
  65
  66   $values->{output_db} ||= $values->{source_db};
  67   return $class->SUPER::new($values);
  68 }
  69
  70 sub compute_differences {
  71     my ($self) = @_;
  72
  73     my $target_schema = $self->target_schema;
  74     my $source_schema = $self->source_schema;
  75
  76     my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
  77     eval "require $producer_class";
  78     die $@ if $@;
  79
  80     if (my $preprocess = $producer_class->can('preprocess_schema')) {
  81       $producer_class->$preprocess($source_schema);
  82       $producer_class->$preprocess($target_schema);
  83     }
  84
  85     my @tar_tables = sort { $a->name cmp $b->name } $target_schema->get_tables;
  86     ## do original/source tables exist in target?
  87     for my $tar_table ( @tar_tables ) {
  88       my $tar_table_name = $tar_table->name;
  89       my $src_table      = $source_schema->get_table( $tar_table_name, $self->case_insensitive );
  90
  91       unless ( $src_table ) {
  92         ## table is new
  93         ## add table(s) later.
  94         push @{$self->tables_to_create}, $tar_table;
  95         next;
  96       }
  97
  98       $self->table_diff_hash->{$tar_table_name} = {
  99         map {$_ => [] } @diff_hash_keys
 100       };
 101
 102       $self->diff_table_options($src_table, $tar_table);
 103
 104       ## Compare fields, their types, defaults, sizes etc etc
 105       $self->diff_table_fields($src_table, $tar_table);
 106
 107       $self->diff_table_indexes($src_table, $tar_table);
 108       $self->diff_table_constraints($src_table, $tar_table);
 109
 110     } # end of target_schema->get_tables loop
 111
 112     for my $src_table ( $source_schema->get_tables ) {
 113       my $src_table_name = $src_table->name;
 114       my $tar_table      = $target_schema->get_table( $src_table_name, $self->case_insensitive );
 115
 116       unless ( $tar_table ) {
 117         $self->table_diff_hash->{$src_table_name} = {
 118           map {$_ => [] } @diff_hash_keys
 119         };
 120
 121         push @{ $self->tables_to_drop}, $src_table;
 122         next;
 123       }
 124     }
 125
 126     return $self;
 127 }
 128
 129 sub produce_diff_sql {
 130     my ($self) = @_;
 131
 132     my $target_schema = $self->target_schema;
 133     my $source_schema = $self->source_schema;
 134     my $tar_name  = $target_schema->name;
 135     my $src_name  = $source_schema->name;
 136
 137     my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
 138     eval "require $producer_class";
 139     die $@ if $@;
 140
 141     # Map of name we store under => producer method name
 142     my %func_map = (
 143       constraints_to_create => 'alter_create_constraint',
 144       constraints_to_drop   => 'alter_drop_constraint',
 145       indexes_to_create     => 'alter_create_index',
 146       indexes_to_drop       => 'alter_drop_index',
 147       fields_to_create      => 'add_field',
 148       fields_to_alter       => 'alter_field',
 149       fields_to_rename      => 'rename_field',
 150       fields_to_drop        => 'drop_field',
 151       table_options         => 'alter_table'
 152     );
 153     my @diffs;
 154
 155     if (!$self->no_batch_alters &&
 156         (my $batch_alter = $producer_class->can('batch_alter_table')) )
 157     {
 158       # Good - Producer supports batch altering of tables.
 159       foreach my $table ( sort keys %{$self->table_diff_hash} ) {
 160         my $tar_table = $target_schema->get_table($table)
 161                      || $source_schema->get_table($table);
 162
 163         push @diffs, $batch_alter->($tar_table,
 164           { map {
 165               $func_map{$_} => $self->table_diff_hash->{$table}{$_}
 166             } keys %func_map
 167           }
 168         );
 169       }
 170     } else {
 171
 172       my %flattened_diffs;
 173       foreach my $table ( sort keys %{$self->table_diff_hash} ) {
 174         my $table_diff = $self->table_diff_hash->{$table};
 175         for (@diff_hash_keys) {
 176           push( @{ $flattened_diffs{ $func_map{$_} } ||= [] }, @{ $table_diff->{$_} } );
 177         }
 178       }
 179
 180       push @diffs, map( {
 181           if (@{$flattened_diffs{$_}}) {
 182             my $meth = $producer_class->can($_);
 183
 184             $meth ? map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ?  ("$sql;") : () } @{ $flattened_diffs{$_} }
 185                   : $self->ignore_missing_methods
 186                   ? "-- $producer_class cant $_"
 187                   : die "$producer_class cant $_";
 188           } else { () }
 189
 190         } qw/alter_drop_constraint
 191              alter_drop_index
 192              drop_field
 193              add_field
 194              alter_field
 195              rename_field
 196              alter_create_index
 197              alter_create_constraint
 198              alter_table/),
 199     }
 200
 201     if (my @tables = @{ $self->tables_to_create } ) {
 202       my $translator = new SQL::Translator(
 203         producer_type => $self->output_db,
 204         add_drop_table => 0,
 205         no_comments => 1,
 206         # TODO: sort out options
 207         quote_table_names => 0,
 208         quote_field_names => 0,
 209       );
 210       my $schema = $translator->schema;
 211
 212       $schema->add_table($_) for @tables;
 213
 214       unshift @diffs,
 215         # Remove begin/commit here, since we wrap everything in one.
 216         grep { $_ !~ /^(?:COMMIT|BEGIN(?: TRANSACTION)?);/ } $producer_class->can('produce')->($translator);
 217     }
 218
 219     if (my @tables_to_drop = @{ $self->{tables_to_drop} || []} ) {
 220       my $meth = $producer_class->can('drop_table');
 221
 222       push @diffs, $meth ? map( { $meth->($_) } @tables_to_drop )
 223                          : $self->ignore_missing_methods
 224                          ? "-- $producer_class cant drop_table"
 225                          : die "$producer_class cant drop_table";
 226     }
 227
 228     if (@diffs) {
 229       unshift @diffs, "BEGIN TRANSACTION;\n";
 230       push    @diffs, "\nCOMMIT;\n";
 231     } else {
 232       @diffs = ("-- No differences found\n\n");
 233     }
 234
 235     if ( @diffs ) {
 236       if ( $self->target_db !~ /^(?:MySQL|SQLite)$/ ) {
 237         unshift(@diffs, "-- Target database @{[$self->target_db]} is untested/unsupported!!!");
 238       }
 239       return join( "\n", "-- Convert schema '$src_name' to '$tar_name':\n", @diffs);
 240     }
 241     return undef;
 242
 243 }
 244
 245 sub diff_table_indexes {
 246   my ($self, $src_table, $tar_table) = @_;
 247
 248   my (%checked_indices);
 249   INDEX_CREATE:
 250   for my $i_tar ( $tar_table->get_indices ) {
 251     for my $i_src ( $src_table->get_indices ) {
 252       if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
 253         $checked_indices{$i_src} = 1;
 254         next INDEX_CREATE;
 255       }
 256     }
 257     push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
 258   }
 259
 260   INDEX_DROP:
 261   for my $i_src ( $src_table->get_indices ) {
 262     next if !$self->ignore_index_names && $checked_indices{$i_src};
 263     for my $i_tar ( $tar_table->get_indices ) {
 264       next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
 265     }
 266     push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
 267   }
 268 }
 269
 270
 271 sub diff_table_constraints {
 272   my ($self, $src_table, $tar_table) = @_;
 273
 274   my(%checked_constraints);
 275   CONSTRAINT_CREATE:
 276   for my $c_tar ( $tar_table->get_constraints ) {
 277     for my $c_src ( $src_table->get_constraints ) {
 278       if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
 279         $checked_constraints{$c_src} = 1;
 280         next CONSTRAINT_CREATE;
 281       }
 282     }
 283     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
 284   }
 285
 286
 287   CONSTRAINT_DROP:
 288   for my $c_src ( $src_table->get_constraints ) {
 289     next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
 290     for my $c_tar ( $tar_table->get_constraints ) {
 291       next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
 292     }
 293
 294     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
 295   }
 296
 297 }
 298
 299 sub diff_table_fields {
 300   my ($self, $src_table, $tar_table) = @_;
 301
 302   # List of ones ew've renamed from so we dont drop them
 303   my %renamed_source_fields;
 304
 305   for my $tar_table_field ( $tar_table->get_fields ) {
 306     my $f_tar_name      = $tar_table_field->name;
 307
 308     if (my $old_name = $tar_table_field->extra->{renamed_from}) {
 309       my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
 310       die qq#Renamed cant find "@{[$src_table->name]}.$old_name" for renamed column\n# unless $src_table_field;
 311       push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
 312       $renamed_source_fields{$old_name} = 1;
 313       next;
 314     }
 315
 316     my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
 317
 318     unless ( $src_table_field ) {
 319       push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
 320       next;
 321     }
 322
 323     # field exists, something changed. This is a bit complex. Parsers can
 324     # normalize types, but only some of them do, so compare the normalized and
 325     # parsed types for each field to each other
 326     if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
 327          !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
 328          !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
 329          !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
 330
 331       # Some producers might need src field to diff against
 332       push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
 333       next;
 334     }
 335   }
 336
 337
 338   # Now check to see if any fields from src_table need to be dropped
 339   for my $src_table_field ( $src_table->get_fields ) {
 340     my $f_src_name      = $src_table_field->name;
 341     next if $renamed_source_fields{$f_src_name};
 342
 343     my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
 344
 345     unless ( $tar_table_field ) {
 346       push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
 347       next;
 348     }
 349   }
 350 }
 351
 352 sub diff_table_options {
 353   my ($self, $src_table, $tar_table) = @_;
 354
 355
 356   # If there's a difference, just re-set all the options
 357   push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
 358     unless $src_table->_compare_objects( scalar $src_table->options, scalar $tar_table->options );
 359 }
 360
 361 1;
 362
 363 __END__
 364
 365 =head1 NAME
 366
 367 SQL::Translator::Diff
 368
 369 =head1 DESCRIPTION
 370
 371 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
 372 statments to make them the same
 373
 374 =head1 SNYOPSIS
 375
 376 Simplest usage:
 377
 378  use SQL::Translator::Diff;
 379  my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
 380
 381 OO usage:
 382
 383  use SQL::Translator::Diff;
 384  my $diff = SQL::Translator::Diff->new({
 385    output_db     => 'MySQL',
 386    source_schema => $source_schema,
 387    target_schema => $target_schema,
 388    %$options_hash,
 389  })->compute_differences->produce_diff_sql;
 390
 391 =head1 OPTIONS
 392
 393 =over
 394
 395 =item B<ignore_index_names>
 396
 397 Match indexes based on types and fields, ignoring name.
 398
 399 =item B<ignore_constraint_names>
 400
 401 Match constrains based on types, fields and tables, ignoring name.
 402
 403 =item B<output_db>
 404
 405 Which producer to use to produce the output.
 406
 407 =item B<case_insensitive>
 408
 409 Ignore case of table, field, index and constraint names when comparing
 410
 411 =item B<no_batch_alters>
 412
 413 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
 414 supports the ability to do all alters for a table as one statement.
 415
 416 =item B<ignore_missing_methods>
 417
 418 If the diff would need a method that is missing from the producer, just emit a
 419 comment showing the method is missing, rather than dieing with an error
 420
 421 =back
 422
 423 =head1 PRODUCER FUNCTIONS
 424
 425 The following producer functions should be implemented for completeness. If
 426 any of them are needed for a given diff, but not found, an error will be
 427 thrown.
 428
 429 =over
 430
 431 =item * C<alter_create_constraint($con)>
 432
 433 =item * C<alter_drop_constraint($con)>
 434
 435 =item * C<alter_create_index($idx)>
 436
 437 =item * C<alter_drop_index($idx)>
 438
 439 =item * C<add_field($fld)>
 440
 441 =item * C<alter_field($old_fld, $new_fld)>
 442
 443 =item * C<rename_field($old_fld, $new_fld)>
 444
 445 =item * C<drop_field($fld)>
 446
 447 =item * C<alter_table($table)>
 448
 449 =item * C<drop_table($table)>
 450
 451 =item * C<batch_alter_table($table, $hash)> (optional)
 452
 453 =back
 454
 455 If the producer supports C<batch_alter_table>, it will be called with the
 456 table to alter and a hash, the keys of which will be the method names listed
 457 above; values will be arrays of fields or constraints to operate on. In the
 458 case of the field functions that take two arguments this will appear as a hash.
 459
 460 I.e. the hash might look something like the following:
 461
 462  {
 463    alter_create_constraint => [ $constraint1, $constraint2 ],
 464    add_field   => [ $field ],
 465    alter_field => [ [$old_field, $new_field] ]
 466  }
 467
 468 =head1 AUTHOR
 469
 470 Original Author(s) unknown.
 471
 472 Refactor and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
 473
 474 Redevelopment sponsored by Takkle Inc.
 475
 476 =cut