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   table_renamed_from
  36 /;
  37
  38 __PACKAGE__->mk_accessors(@diff_arrays, 'table_diff_hash');
  39
  40 sub schema_diff {
  41     #  use Data::Dumper;
  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
  47
  48     my ($source_schema, $source_db, $target_schema, $target_db, $options) = @_;
  49     $options ||= {};
  50
  51     my $obj = SQL::Translator::Diff->new( {
  52       %$options,
  53       source_schema => $source_schema,
  54       source_db     => $source_db,
  55       target_schema => $target_schema,
  56       target_db     => $target_db
  57     } );
  58
  59     $obj->compute_differences->produce_diff_sql;
  60 }
  61
  62 sub new {
  63   my ($class, $values) = @_;
  64   $values->{$_} ||= [] foreach @diff_arrays;
  65   $values->{table_diff_hash} = {};
  66
  67   $values->{output_db} ||= $values->{source_db};
  68   return $class->SUPER::new($values);
  69 }
  70
  71 sub compute_differences {
  72     my ($self) = @_;
  73
  74     my $target_schema = $self->target_schema;
  75     my $source_schema = $self->source_schema;
  76
  77     my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
  78     eval "require $producer_class";
  79     die $@ if $@;
  80
  81     if (my $preprocess = $producer_class->can('preprocess_schema')) {
  82       $producer_class->$preprocess($source_schema);
  83       $producer_class->$preprocess($target_schema);
  84     }
  85
  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;
  91
  92       my $src_table;
  93
  94       $self->table_diff_hash->{$tar_table_name} = {
  95         map {$_ => [] } @diff_hash_keys
  96       };
  97
  98       if (my $old_name = $tar_table->extra('renamed_from')) {
  99         $src_table = $source_schema->get_table( $old_name, $self->case_insensitive );
 100         if ($src_table) {
 101           $self->table_diff_hash->{$tar_table_name}{table_renamed_from} = [ [$src_table, $tar_table] ];
 102         } else {
 103           delete $tar_table->extra->{renamed_from};
 104           warn qq#Renamed table can't find old table "$old_name" for renamed table\n#;
 105         }
 106       } else {
 107         $src_table = $source_schema->get_table( $tar_table_name, $self->case_insensitive );
 108       }
 109
 110       unless ( $src_table ) {
 111         ## table is new
 112         ## add table(s) later.
 113         push @{$self->tables_to_create}, $tar_table;
 114         next;
 115       }
 116
 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;
 120
 121
 122       $self->diff_table_options($src_table, $tar_table);
 123
 124       ## Compare fields, their types, defaults, sizes etc etc
 125       $self->diff_table_fields($src_table, $tar_table);
 126
 127       $self->diff_table_indexes($src_table, $tar_table);
 128       $self->diff_table_constraints($src_table, $tar_table);
 129
 130     } # end of target_schema->get_tables loop
 131
 132     for my $src_table ( $source_schema->get_tables ) {
 133       my $src_table_name = $src_table->name;
 134
 135       $src_table_name = lc $src_table_name if $self->case_insensitive;
 136
 137       push @{ $self->tables_to_drop}, $src_table
 138         unless $src_tables_checked{$src_table_name};
 139     }
 140
 141     return $self;
 142 }
 143
 144 sub produce_diff_sql {
 145     my ($self) = @_;
 146
 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;
 151
 152     my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
 153     eval "require $producer_class";
 154     die $@ if $@;
 155
 156     # Map of name we store under => producer method name
 157     my %func_map = (
 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',
 168     );
 169     my @diffs;
 170
 171     if (!$self->no_batch_alters &&
 172         (my $batch_alter = $producer_class->can('batch_alter_table')) )
 173     {
 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);
 178
 179         push @diffs, $batch_alter->($tar_table,
 180           { map {
 181               $func_map{$_} => $self->table_diff_hash->{$table}{$_}
 182             } keys %func_map
 183           }
 184         );
 185       }
 186     } else {
 187
 188       # If we have any table renames we need to do those first;
 189       my %flattened_diffs;
 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->{$_} } );
 194         }
 195       }
 196
 197       push @diffs, map( {
 198           if (@{ $flattened_diffs{$_} || [] }) {
 199             my $meth = $producer_class->can($_);
 200
 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 $_";
 205           } else { () }
 206
 207         } qw/rename_table
 208              alter_drop_constraint
 209              alter_drop_index
 210              drop_field
 211              add_field
 212              alter_field
 213              rename_field
 214              alter_create_index
 215              alter_create_constraint
 216              alter_table/),
 217     }
 218
 219     if (my @tables = @{ $self->tables_to_create } ) {
 220       my $translator = new SQL::Translator(
 221         producer_type => $self->output_db,
 222         add_drop_table => 0,
 223         no_comments => 1,
 224         # TODO: sort out options
 225         quote_table_names => 0,
 226         quote_field_names => 0,
 227       );
 228       my $schema = $translator->schema;
 229
 230       $schema->add_table($_) for @tables;
 231
 232       unshift @diffs,
 233         # Remove begin/commit here, since we wrap everything in one.
 234         grep { $_ !~ /^(?:COMMIT|START(?: TRANSACTION)?|BEGIN(?: TRANSACTION)?);/ } $producer_class->can('produce')->($translator);
 235     }
 236
 237     if (my @tables_to_drop = @{ $self->{tables_to_drop} || []} ) {
 238       my $meth = $producer_class->can('drop_table');
 239
 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";
 244     }
 245
 246     if (@diffs) {
 247       unshift @diffs, "BEGIN;\n";
 248       push    @diffs, "\nCOMMIT;\n";
 249     } else {
 250       @diffs = ("-- No differences found\n\n");
 251     }
 252
 253     if ( @diffs ) {
 254       if ( $self->target_db !~ /^(?:MySQL|SQLite)$/ ) {
 255         unshift(@diffs, "-- Target database @{[$self->target_db]} is untested/unsupported!!!");
 256       }
 257       return join( "\n", "-- Convert schema '$src_name' to '$tar_name':\n", @diffs);
 258     }
 259     return undef;
 260
 261 }
 262
 263 sub diff_table_indexes {
 264   my ($self, $src_table, $tar_table) = @_;
 265
 266   my (%checked_indices);
 267   INDEX_CREATE:
 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;
 272         next INDEX_CREATE;
 273       }
 274     }
 275     push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
 276   }
 277
 278   INDEX_DROP:
 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);
 283     }
 284     push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
 285   }
 286 }
 287
 288
 289 sub diff_table_constraints {
 290   my ($self, $src_table, $tar_table) = @_;
 291
 292   my(%checked_constraints);
 293   CONSTRAINT_CREATE:
 294   for my $c_tar ( $tar_table->get_constraints ) {
 295     for my $c_src ( $src_table->get_constraints ) {
 296
 297       # This is a bit of a hack - needed for renaming tables to work
 298       local $c_src->{table} = $tar_table;
 299
 300       if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
 301         $checked_constraints{$c_src} = 1;
 302         next CONSTRAINT_CREATE;
 303       }
 304     }
 305     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
 306   }
 307
 308
 309   CONSTRAINT_DROP:
 310   for my $c_src ( $src_table->get_constraints ) {
 311
 312     # This is a bit of a hack - needed for renaming tables to work
 313     local $c_src->{table} = $tar_table;
 314
 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);
 318     }
 319
 320     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
 321   }
 322
 323 }
 324
 325 sub diff_table_fields {
 326   my ($self, $src_table, $tar_table) = @_;
 327
 328   # List of ones ew've renamed from so we dont drop them
 329   my %renamed_source_fields;
 330
 331   for my $tar_table_field ( $tar_table->get_fields ) {
 332     my $f_tar_name      = $tar_table_field->name;
 333
 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};
 339       } else {
 340         push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
 341         $renamed_source_fields{$old_name} = 1;
 342         next;
 343       }
 344     }
 345
 346     my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
 347
 348     unless ( $src_table_field ) {
 349       push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
 350       next;
 351     }
 352
 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) ) {
 360
 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 ];
 363       next;
 364     }
 365   }
 366
 367
 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};
 372
 373     my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
 374
 375     unless ( $tar_table_field ) {
 376       push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
 377       next;
 378     }
 379   }
 380 }
 381
 382 sub diff_table_options {
 383   my ($self, $src_table, $tar_table) = @_;
 384
 385
 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 );
 389 }
 390
 391 1;
 392
 393 __END__
 394
 395 =head1 NAME
 396
 397 SQL::Translator::Diff
 398
 399 =head1 DESCRIPTION
 400
 401 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
 402 statments to make them the same
 403
 404 =head1 SNYOPSIS
 405
 406 Simplest usage:
 407
 408  use SQL::Translator::Diff;
 409  my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
 410
 411 OO usage:
 412
 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,
 418    %$options_hash,
 419  })->compute_differences->produce_diff_sql;
 420
 421 =head1 OPTIONS
 422
 423 =over
 424
 425 =item B<ignore_index_names>
 426
 427 Match indexes based on types and fields, ignoring name.
 428
 429 =item B<ignore_constraint_names>
 430
 431 Match constrains based on types, fields and tables, ignoring name.
 432
 433 =item B<output_db>
 434
 435 Which producer to use to produce the output.
 436
 437 =item B<case_insensitive>
 438
 439 Ignore case of table, field, index and constraint names when comparing
 440
 441 =item B<no_batch_alters>
 442
 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.
 445
 446 =item B<ignore_missing_methods>
 447
 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
 450
 451 =back
 452
 453 =head1 PRODUCER FUNCTIONS
 454
 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
 457 thrown.
 458
 459 =over
 460
 461 =item * C<alter_create_constraint($con)>
 462
 463 =item * C<alter_drop_constraint($con)>
 464
 465 =item * C<alter_create_index($idx)>
 466
 467 =item * C<alter_drop_index($idx)>
 468
 469 =item * C<add_field($fld)>
 470
 471 =item * C<alter_field($old_fld, $new_fld)>
 472
 473 =item * C<rename_field($old_fld, $new_fld)>
 474
 475 =item * C<drop_field($fld)>
 476
 477 =item * C<alter_table($table)>
 478
 479 =item * C<drop_table($table)>
 480
 481 =item * C<rename_table($old_table, $new_table)> (optional)
 482
 483 =item * C<batch_alter_table($table, $hash)> (optional)
 484
 485
 486 =back
 487
 488 If the producer supports C<batch_alter_table>, it will be called with the
 489 table to alter and a hash, the keys of which will be the method names listed
 490 above; values will be arrays of fields or constraints to operate on. In the
 491 case of the field functions that take two arguments this will appear as a hash.
 492
 493 I.e. the hash might look something like the following:
 494
 495  {
 496    alter_create_constraint => [ $constraint1, $constraint2 ],
 497    add_field   => [ $field ],
 498    alter_field => [ [$old_field, $new_field] ]
 499  }
 500
 501 =head1 AUTHOR
 502
 503 Original Author(s) unknown.
 504
 505 Refactor and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
 506
 507 Redevelopment sponsored by Takkle Inc.
 508
 509 =cut