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 Carp::Clan qw/^SQL::Translator/;
  10 use SQL::Translator::Schema::Constants;
  11 use Sub::Quote qw(quote_sub);
  12 use Moo;
  13
  14 has ignore_index_names => (
  15   is => 'rw',
  16 );
  17 has ignore_constraint_names => (
  18   is => 'rw',
  19 );
  20 has ignore_view_sql => (
  21   is => 'rw',
  22 );
  23 has ignore_proc_sql => (
  24   is => 'rw',
  25 );
  26 has output_db => (
  27   is => 'rw',
  28 );
  29 has source_schema => (
  30   is => 'rw',
  31 );
  32 has target_schema => (
  33   is => 'rw',
  34 );
  35 has case_insensitive => (
  36   is => 'rw',
  37 );
  38 has no_batch_alters => (
  39   is => 'rw',
  40 );
  41 has ignore_missing_methods => (
  42   is => 'rw',
  43 );
  44 has producer_args => (
  45   is => 'rw',
  46   lazy => 1,
  47   default => quote_sub '{}',
  48 );
  49 has tables_to_drop => (
  50   is => 'rw',
  51   lazy => 1,
  52   default => quote_sub '[]',
  53 );
  54 has tables_to_create => (
  55   is => 'rw',
  56   lazy => 1,
  57   default => quote_sub '[]',
  58 );
  59 has table_diff_hash => (
  60   is => 'rw',
  61   lazy => 1,
  62   default => quote_sub '{}',
  63 );
  64
  65 my @diff_arrays = qw/
  66   tables_to_drop
  67   tables_to_create
  68 /;
  69
  70 my @diff_hash_keys = qw/
  71   constraints_to_create
  72   constraints_to_drop
  73   indexes_to_create
  74   indexes_to_drop
  75   fields_to_create
  76   fields_to_alter
  77   fields_to_rename
  78   fields_to_drop
  79   table_options
  80   table_renamed_from
  81 /;
  82
  83 sub schema_diff {
  84     #  use Data::Dumper;
  85     ## we are getting instructions on how to turn the source into the target
  86     ## source == original, target == new (hmm, if I need to comment this, should I rename the vars again ??)
  87     ## _schema isa SQL::Translator::Schema
  88     ## _db is the name of the producer/db it came out of/into
  89     ## results are formatted to the source preferences
  90
  91     my ($source_schema, $source_db, $target_schema, $output_db, $options) = @_;
  92     $options ||= {};
  93
  94     my $obj = SQL::Translator::Diff->new( {
  95       %$options,
  96       source_schema => $source_schema,
  97       target_schema => $target_schema,
  98       output_db     => $output_db
  99     } );
 100
 101     $obj->compute_differences->produce_diff_sql;
 102 }
 103
 104 sub BUILD {
 105   my ($self, $args) = @_;
 106   if ($args->{producer_options}) {
 107     carp 'producer_options is deprecated. Please use producer_args';
 108     $self->producer_args({
 109       %{$args->{producer_options}},
 110       %{$self->producer_args}
 111     });
 112   }
 113
 114   if (! $self->output_db) {
 115     $self->output_db($args->{source_db})
 116   }
 117 }
 118
 119 sub compute_differences {
 120     my ($self) = @_;
 121
 122     my $target_schema = $self->target_schema;
 123     my $source_schema = $self->source_schema;
 124
 125     my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
 126     eval "require $producer_class";
 127     die $@ if $@;
 128
 129     if (my $preprocess = $producer_class->can('preprocess_schema')) {
 130       $preprocess->($source_schema);
 131       $preprocess->($target_schema);
 132     }
 133
 134     my %src_tables_checked = ();
 135     my @tar_tables = sort { $a->name cmp $b->name } $target_schema->get_tables;
 136     ## do original/source tables exist in target?
 137     for my $tar_table ( @tar_tables ) {
 138       my $tar_table_name = $tar_table->name;
 139
 140       my $src_table;
 141
 142       $self->table_diff_hash->{$tar_table_name} = {
 143         map {$_ => [] } @diff_hash_keys
 144       };
 145
 146       if (my $old_name = $tar_table->extra('renamed_from')) {
 147         $src_table = $source_schema->get_table( $old_name, $self->case_insensitive );
 148         if ($src_table) {
 149           $self->table_diff_hash->{$tar_table_name}{table_renamed_from} = [ [$src_table, $tar_table] ];
 150         } else {
 151           delete $tar_table->extra->{renamed_from};
 152           carp qq#Renamed table can't find old table "$old_name" for renamed table\n#;
 153         }
 154       } else {
 155         $src_table = $source_schema->get_table( $tar_table_name, $self->case_insensitive );
 156       }
 157
 158       unless ( $src_table ) {
 159         ## table is new
 160         ## add table(s) later.
 161         push @{$self->tables_to_create}, $tar_table;
 162         next;
 163       }
 164
 165       my $src_table_name = $src_table->name;
 166       $src_table_name = lc $src_table_name if $self->case_insensitive;
 167       $src_tables_checked{$src_table_name} = 1;
 168
 169
 170       $self->diff_table_options($src_table, $tar_table);
 171
 172       ## Compare fields, their types, defaults, sizes etc etc
 173       $self->diff_table_fields($src_table, $tar_table);
 174
 175       $self->diff_table_indexes($src_table, $tar_table);
 176       $self->diff_table_constraints($src_table, $tar_table);
 177
 178     } # end of target_schema->get_tables loop
 179
 180     for my $src_table ( $source_schema->get_tables ) {
 181       my $src_table_name = $src_table->name;
 182
 183       $src_table_name = lc $src_table_name if $self->case_insensitive;
 184
 185       push @{ $self->tables_to_drop}, $src_table
 186         unless $src_tables_checked{$src_table_name};
 187     }
 188
 189     return $self;
 190 }
 191
 192 sub produce_diff_sql {
 193     my ($self) = @_;
 194
 195     my $target_schema = $self->target_schema;
 196     my $source_schema = $self->source_schema;
 197     my $tar_name  = $target_schema->name;
 198     my $src_name  = $source_schema->name;
 199
 200     my $producer_class = "SQL::Translator::Producer::@{[$self->output_db]}";
 201     eval "require $producer_class";
 202     die $@ if $@;
 203
 204     # Map of name we store under => producer method name
 205     my %func_map = (
 206       constraints_to_create => 'alter_create_constraint',
 207       constraints_to_drop   => 'alter_drop_constraint',
 208       indexes_to_create     => 'alter_create_index',
 209       indexes_to_drop       => 'alter_drop_index',
 210       fields_to_create      => 'add_field',
 211       fields_to_alter       => 'alter_field',
 212       fields_to_rename      => 'rename_field',
 213       fields_to_drop        => 'drop_field',
 214       table_options         => 'alter_table',
 215       table_renamed_from    => 'rename_table',
 216     );
 217     my @diffs;
 218
 219     if (!$self->no_batch_alters &&
 220         (my $batch_alter = $producer_class->can('batch_alter_table')) )
 221     {
 222       # Good - Producer supports batch altering of tables.
 223       foreach my $table ( sort keys %{$self->table_diff_hash} ) {
 224         my $tar_table = $target_schema->get_table($table)
 225                      || $source_schema->get_table($table);
 226
 227         push @diffs, $batch_alter->($tar_table,
 228           { map {
 229               $func_map{$_} => $self->table_diff_hash->{$table}{$_}
 230             } keys %func_map
 231           },
 232           $self->producer_args
 233         );
 234       }
 235     } else {
 236
 237       # If we have any table renames we need to do those first;
 238       my %flattened_diffs;
 239       foreach my $table ( sort keys %{$self->table_diff_hash} ) {
 240         my $table_diff = $self->table_diff_hash->{$table};
 241         for (@diff_hash_keys) {
 242           push( @{ $flattened_diffs{ $func_map{$_} } ||= [] }, @{ $table_diff->{$_} } );
 243         }
 244       }
 245
 246       push @diffs, map( {
 247           if (@{ $flattened_diffs{$_} || [] }) {
 248             my $meth = $producer_class->can($_);
 249
 250             $meth ? map {
 251                     my $sql = $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $self->producer_args );
 252                     $sql ?  ("$sql") : ();
 253                   } @{ $flattened_diffs{$_} }
 254                   : $self->ignore_missing_methods
 255                   ? "-- $producer_class cant $_"
 256                   : die "$producer_class cant $_";
 257           } else { () }
 258
 259         } qw/rename_table
 260              alter_drop_constraint
 261              alter_drop_index
 262              drop_field
 263              add_field
 264              alter_field
 265              rename_field
 266              alter_create_index
 267              alter_create_constraint
 268              alter_table/),
 269     }
 270
 271     if (my @tables = @{ $self->tables_to_create } ) {
 272       my $translator = SQL::Translator->new(
 273         producer_type => $self->output_db,
 274         add_drop_table => 0,
 275         no_comments => 1,
 276         # TODO: sort out options
 277         %{ $self->producer_args }
 278       );
 279       $translator->producer_args->{no_transaction} = 1;
 280       my $schema = $translator->schema;
 281
 282       $schema->add_table($_) for @tables;
 283
 284       unshift @diffs,
 285         # Remove begin/commit here, since we wrap everything in one.
 286         grep { $_ !~ /^(?:COMMIT|START(?: TRANSACTION)?|BEGIN(?: TRANSACTION)?)/ } $producer_class->can('produce')->($translator);
 287     }
 288
 289     if (my @tables_to_drop = @{ $self->{tables_to_drop} || []} ) {
 290       my $meth = $producer_class->can('drop_table');
 291
 292       push @diffs, $meth ? ( map { $meth->($_, $self->producer_args) } @tables_to_drop)
 293                          : $self->ignore_missing_methods
 294                          ? "-- $producer_class cant drop_table"
 295                          : die "$producer_class cant drop_table";
 296     }
 297
 298     if (@diffs) {
 299       unshift @diffs, "BEGIN";
 300       push    @diffs, "\nCOMMIT";
 301     } else {
 302       @diffs = ("-- No differences found");
 303     }
 304
 305     if ( @diffs ) {
 306       if ( $self->output_db !~ /^(?:MySQL|SQLite|PostgreSQL)$/ ) {
 307         unshift(@diffs, "-- Output database @{[$self->output_db]} is untested/unsupported!!!");
 308       }
 309
 310       my @return =
 311         map { $_ ? ( $_ =~ /;$/xms ? $_ : "$_;\n\n" ) : "\n" }
 312         ("-- Convert schema '$src_name' to '$tar_name':", @diffs);
 313
 314       return wantarray ? @return : join('', @return);
 315     }
 316     return undef;
 317
 318 }
 319
 320 sub diff_table_indexes {
 321   my ($self, $src_table, $tar_table) = @_;
 322
 323   my (%checked_indices);
 324   INDEX_CREATE:
 325   for my $i_tar ( $tar_table->get_indices ) {
 326     for my $i_src ( $src_table->get_indices ) {
 327       if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
 328         $checked_indices{$i_src} = 1;
 329         next INDEX_CREATE;
 330       }
 331     }
 332     push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
 333   }
 334
 335   INDEX_DROP:
 336   for my $i_src ( $src_table->get_indices ) {
 337     next if !$self->ignore_index_names && $checked_indices{$i_src};
 338     for my $i_tar ( $tar_table->get_indices ) {
 339       next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
 340     }
 341     push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
 342   }
 343 }
 344
 345
 346 sub diff_table_constraints {
 347   my ($self, $src_table, $tar_table) = @_;
 348
 349   my(%checked_constraints);
 350   CONSTRAINT_CREATE:
 351   for my $c_tar ( $tar_table->get_constraints ) {
 352     for my $c_src ( $src_table->get_constraints ) {
 353
 354       # This is a bit of a hack - needed for renaming tables to work
 355       local $c_src->{table} = $tar_table;
 356
 357       if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
 358         $checked_constraints{$c_src} = 1;
 359         next CONSTRAINT_CREATE;
 360       }
 361     }
 362     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
 363   }
 364
 365
 366   CONSTRAINT_DROP:
 367   for my $c_src ( $src_table->get_constraints ) {
 368
 369     # This is a bit of a hack - needed for renaming tables to work
 370     local $c_src->{table} = $tar_table;
 371
 372     next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
 373     for my $c_tar ( $tar_table->get_constraints ) {
 374       next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
 375     }
 376
 377     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
 378   }
 379
 380 }
 381
 382 sub diff_table_fields {
 383   my ($self, $src_table, $tar_table) = @_;
 384
 385   # List of ones ew've renamed from so we dont drop them
 386   my %renamed_source_fields;
 387
 388   for my $tar_table_field ( $tar_table->get_fields ) {
 389     my $f_tar_name      = $tar_table_field->name;
 390
 391     if (my $old_name = $tar_table_field->extra->{renamed_from}) {
 392       my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
 393       unless ($src_table_field) {
 394         carp qq#Renamed column can't find old column "@{[$src_table->name]}.$old_name" for renamed column\n#;
 395         delete $tar_table_field->extra->{renamed_from};
 396       } else {
 397         push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
 398         $renamed_source_fields{$old_name} = 1;
 399         next;
 400       }
 401     }
 402
 403     my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
 404
 405     unless ( $src_table_field ) {
 406       push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
 407       next;
 408     }
 409
 410     # field exists, something changed. This is a bit complex. Parsers can
 411     # normalize types, but only some of them do, so compare the normalized and
 412     # parsed types for each field to each other
 413     if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
 414          !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
 415          !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
 416          !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
 417
 418       # Some producers might need src field to diff against
 419       push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
 420       next;
 421     }
 422   }
 423
 424
 425   # Now check to see if any fields from src_table need to be dropped
 426   for my $src_table_field ( $src_table->get_fields ) {
 427     my $f_src_name      = $src_table_field->name;
 428     next if $renamed_source_fields{$f_src_name};
 429
 430     my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
 431
 432     unless ( $tar_table_field ) {
 433       push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
 434       next;
 435     }
 436   }
 437 }
 438
 439 sub diff_table_options {
 440   my ($self, $src_table, $tar_table) = @_;
 441
 442   my $cmp = sub {
 443     my ($a_name, undef, $b_name, undef) = ( %$a, %$b );
 444     $a_name cmp $b_name;
 445   };
 446   # Need to sort the options so we dont get supruious diffs.
 447   my (@src_opts, @tar_opts);
 448   @src_opts = sort $cmp $src_table->options;
 449   @tar_opts = sort $cmp $tar_table->options;
 450
 451
 452   # If there's a difference, just re-set all the options
 453   push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
 454     unless $src_table->_compare_objects( \@src_opts, \@tar_opts );
 455 }
 456
 457 # support producer_options as an alias for producer_args for legacy code.
 458 sub producer_options {
 459   my $self = shift;
 460
 461   return $self->producer_args( @_ );
 462 }
 463
 464 1;
 465
 466 __END__
 467
 468 =head1 NAME
 469
 470 SQL::Translator::Diff - determine differences between two schemas
 471
 472 =head1 DESCRIPTION
 473
 474 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
 475 statments to make them the same
 476
 477 =head1 SNYOPSIS
 478
 479 Simplest usage:
 480
 481  use SQL::Translator::Diff;
 482  my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
 483
 484 OO usage:
 485
 486  use SQL::Translator::Diff;
 487  my $diff = SQL::Translator::Diff->new({
 488    output_db     => 'MySQL',
 489    source_schema => $source_schema,
 490    target_schema => $target_schema,
 491    %$options_hash,
 492  })->compute_differences->produce_diff_sql;
 493
 494 =head1 OPTIONS
 495
 496 =over
 497
 498 =item B<ignore_index_names>
 499
 500 Match indexes based on types and fields, ignoring name.
 501
 502 =item B<ignore_constraint_names>
 503
 504 Match constrains based on types, fields and tables, ignoring name.
 505
 506 =item B<output_db>
 507
 508 Which producer to use to produce the output.
 509
 510 =item B<case_insensitive>
 511
 512 Ignore case of table, field, index and constraint names when comparing
 513
 514 =item B<no_batch_alters>
 515
 516 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
 517 supports the ability to do all alters for a table as one statement.
 518
 519 =item B<ignore_missing_methods>
 520
 521 If the diff would need a method that is missing from the producer, just emit a
 522 comment showing the method is missing, rather than dieing with an error
 523
 524 =back
 525
 526 =head1 PRODUCER FUNCTIONS
 527
 528 The following producer functions should be implemented for completeness. If
 529 any of them are needed for a given diff, but not found, an error will be
 530 thrown.
 531
 532 =over
 533
 534 =item * C<alter_create_constraint($con)>
 535
 536 =item * C<alter_drop_constraint($con)>
 537
 538 =item * C<alter_create_index($idx)>
 539
 540 =item * C<alter_drop_index($idx)>
 541
 542 =item * C<add_field($fld)>
 543
 544 =item * C<alter_field($old_fld, $new_fld)>
 545
 546 =item * C<rename_field($old_fld, $new_fld)>
 547
 548 =item * C<drop_field($fld)>
 549
 550 =item * C<alter_table($table)>
 551
 552 =item * C<drop_table($table)>
 553
 554 =item * C<rename_table($old_table, $new_table)> (optional)
 555
 556 =item * C<batch_alter_table($table, $hash)> (optional)
 557
 558 If the producer supports C<batch_alter_table>, it will be called with the
 559 table to alter and a hash, the keys of which will be the method names listed
 560 above; values will be arrays of fields or constraints to operate on. In the
 561 case of the field functions that take two arguments this will appear as a hash.
 562
 563 I.e. the hash might look something like the following:
 564
 565  {
 566    alter_create_constraint => [ $constraint1, $constraint2 ],
 567    add_field   => [ $field ],
 568    alter_field => [ [$old_field, $new_field] ]
 569  }
 570
 571
 572 =item * C<preprocess_schema($class, $schema)> (optional)
 573
 574 C<preprocess_schema> is called by the Diff code to allow the producer to
 575 normalize any data it needs to first. For example, the MySQL producer uses
 576 this method to ensure that FK contraint names are unique.
 577
 578 Basicaly any changes that need to be made to produce the SQL file for the
 579 schema should be done here, so that a diff between a parsed SQL file and (say)
 580 a parsed DBIx::Class::Schema object will be sane.
 581
 582 (As an aside, DBIx::Class, for instance, uses the presence of a
 583 C<preprocess_schema> function on the producer to know that it can diff between
 584 the previous SQL file and its own internal representation. Without this method
 585 on th producer it will diff the two SQL files which is slower, but known to
 586 work better on old-style producers.)
 587
 588 =back
 589
 590
 591 =head1 AUTHOR
 592
 593 Original Author(s) unknown.
 594
 595 Refactor/re-write and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
 596
 597 Redevelopment sponsored by Takkle Inc.
 598
 599 =cut