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                     map { $_ ? "$_" : () } $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $self->producer_args );
 252                   } @{ $flattened_diffs{$_} }
 253                   : $self->ignore_missing_methods
 254                   ? "-- $producer_class cant $_"
 255                   : die "$producer_class cant $_";
 256           } else { () }
 257
 258         } qw/rename_table
 259              alter_drop_constraint
 260              alter_drop_index
 261              drop_field
 262              add_field
 263              alter_field
 264              rename_field
 265              alter_create_index
 266              alter_create_constraint
 267              alter_table/),
 268     }
 269
 270     if (my @tables = @{ $self->tables_to_create } ) {
 271       my $translator = SQL::Translator->new(
 272         producer_type => $self->output_db,
 273         add_drop_table => 0,
 274         no_comments => 1,
 275         # TODO: sort out options
 276         %{ $self->producer_args }
 277       );
 278       $translator->producer_args->{no_transaction} = 1;
 279       my $schema = $translator->schema;
 280
 281       $schema->add_table($_) for @tables;
 282
 283       unshift @diffs,
 284         # Remove begin/commit here, since we wrap everything in one.
 285         grep { $_ !~ /^(?:COMMIT|START(?: TRANSACTION)?|BEGIN(?: TRANSACTION)?)/ } $producer_class->can('produce')->($translator);
 286     }
 287
 288     if (my @tables_to_drop = @{ $self->{tables_to_drop} || []} ) {
 289       my $meth = $producer_class->can('drop_table');
 290
 291       push @diffs, $meth ? ( map { $meth->($_, $self->producer_args) } @tables_to_drop)
 292                          : $self->ignore_missing_methods
 293                          ? "-- $producer_class cant drop_table"
 294                          : die "$producer_class cant drop_table";
 295     }
 296
 297     if (@diffs) {
 298       unshift @diffs, "BEGIN";
 299       push    @diffs, "\nCOMMIT";
 300     } else {
 301       @diffs = ("-- No differences found");
 302     }
 303
 304     if ( @diffs ) {
 305       if ( $self->output_db !~ /^(?:MySQL|SQLite|PostgreSQL)$/ ) {
 306         unshift(@diffs, "-- Output database @{[$self->output_db]} is untested/unsupported!!!");
 307       }
 308
 309       my @return =
 310         map { $_ ? ( $_ =~ /;\s*\z/xms ? $_ : "$_;\n\n" ) : "\n" }
 311         ("-- Convert schema '$src_name' to '$tar_name':", @diffs);
 312
 313       return wantarray ? @return : join('', @return);
 314     }
 315     return undef;
 316
 317 }
 318
 319 sub diff_table_indexes {
 320   my ($self, $src_table, $tar_table) = @_;
 321
 322   my (%checked_indices);
 323   INDEX_CREATE:
 324   for my $i_tar ( $tar_table->get_indices ) {
 325     for my $i_src ( $src_table->get_indices ) {
 326       if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
 327         $checked_indices{$i_src} = 1;
 328         next INDEX_CREATE;
 329       }
 330     }
 331     push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
 332   }
 333
 334   INDEX_DROP:
 335   for my $i_src ( $src_table->get_indices ) {
 336     next if !$self->ignore_index_names && $checked_indices{$i_src};
 337     for my $i_tar ( $tar_table->get_indices ) {
 338       next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
 339     }
 340     push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
 341   }
 342 }
 343
 344
 345 sub diff_table_constraints {
 346   my ($self, $src_table, $tar_table) = @_;
 347
 348   my(%checked_constraints);
 349   CONSTRAINT_CREATE:
 350   for my $c_tar ( $tar_table->get_constraints ) {
 351     for my $c_src ( $src_table->get_constraints ) {
 352
 353       # This is a bit of a hack - needed for renaming tables to work
 354       local $c_src->{table} = $tar_table;
 355
 356       if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
 357         $checked_constraints{$c_src} = 1;
 358         next CONSTRAINT_CREATE;
 359       }
 360     }
 361     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
 362   }
 363
 364
 365   CONSTRAINT_DROP:
 366   for my $c_src ( $src_table->get_constraints ) {
 367
 368     # This is a bit of a hack - needed for renaming tables to work
 369     local $c_src->{table} = $tar_table;
 370
 371     next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
 372     for my $c_tar ( $tar_table->get_constraints ) {
 373       next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
 374     }
 375
 376     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
 377   }
 378
 379 }
 380
 381 sub diff_table_fields {
 382   my ($self, $src_table, $tar_table) = @_;
 383
 384   # List of ones we've renamed from so we don't drop them
 385   my %renamed_source_fields;
 386
 387   for my $tar_table_field ( $tar_table->get_fields ) {
 388     my $f_tar_name      = $tar_table_field->name;
 389
 390     if (my $old_name = $tar_table_field->extra->{renamed_from}) {
 391       my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
 392       unless ($src_table_field) {
 393         carp qq#Renamed column can't find old column "@{[$src_table->name]}.$old_name" for renamed column\n#;
 394         delete $tar_table_field->extra->{renamed_from};
 395       } else {
 396         push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
 397         $renamed_source_fields{$old_name} = 1;
 398         next;
 399       }
 400     }
 401
 402     my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
 403
 404     unless ( $src_table_field ) {
 405       push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
 406       next;
 407     }
 408
 409     # field exists, something changed. This is a bit complex. Parsers can
 410     # normalize types, but only some of them do, so compare the normalized and
 411     # parsed types for each field to each other
 412     if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
 413          !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
 414          !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
 415          !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
 416
 417       # Some producers might need src field to diff against
 418       push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
 419       next;
 420     }
 421   }
 422
 423
 424   # Now check to see if any fields from src_table need to be dropped
 425   for my $src_table_field ( $src_table->get_fields ) {
 426     my $f_src_name      = $src_table_field->name;
 427     next if $renamed_source_fields{$f_src_name};
 428
 429     my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
 430
 431     unless ( $tar_table_field ) {
 432       push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
 433       next;
 434     }
 435   }
 436 }
 437
 438 sub diff_table_options {
 439   my ($self, $src_table, $tar_table) = @_;
 440
 441   my $cmp = sub {
 442     my ($a_name, undef, $b_name, undef) = ( %$a, %$b );
 443     $a_name cmp $b_name;
 444   };
 445   # Need to sort the options so we don't get spurious diffs.
 446   my (@src_opts, @tar_opts);
 447   @src_opts = sort $cmp $src_table->options;
 448   @tar_opts = sort $cmp $tar_table->options;
 449
 450
 451   # If there's a difference, just re-set all the options
 452   push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
 453     unless $src_table->_compare_objects( \@src_opts, \@tar_opts );
 454 }
 455
 456 # support producer_options as an alias for producer_args for legacy code.
 457 sub producer_options {
 458   my $self = shift;
 459
 460   return $self->producer_args( @_ );
 461 }
 462
 463 1;
 464
 465 __END__
 466
 467 =head1 NAME
 468
 469 SQL::Translator::Diff - determine differences between two schemas
 470
 471 =head1 DESCRIPTION
 472
 473 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
 474 statements to make them the same
 475
 476 =head1 SNYOPSIS
 477
 478 Simplest usage:
 479
 480  use SQL::Translator::Diff;
 481  my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
 482
 483 OO usage:
 484
 485  use SQL::Translator::Diff;
 486  my $diff = SQL::Translator::Diff->new({
 487    output_db     => 'MySQL',
 488    source_schema => $source_schema,
 489    target_schema => $target_schema,
 490    %$options_hash,
 491  })->compute_differences->produce_diff_sql;
 492
 493 =head1 OPTIONS
 494
 495 =over
 496
 497 =item B<ignore_index_names>
 498
 499 Match indexes based on types and fields, ignoring name.
 500
 501 =item B<ignore_constraint_names>
 502
 503 Match constrains based on types, fields and tables, ignoring name.
 504
 505 =item B<output_db>
 506
 507 Which producer to use to produce the output.
 508
 509 =item B<case_insensitive>
 510
 511 Ignore case of table, field, index and constraint names when comparing
 512
 513 =item B<no_batch_alters>
 514
 515 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
 516 supports the ability to do all alters for a table as one statement.
 517
 518 =item B<ignore_missing_methods>
 519
 520 If the diff would need a method that is missing from the producer, just emit a
 521 comment showing the method is missing, rather than dieing with an error
 522
 523 =item B<producer_args>
 524
 525 Hash of extra arguments passed to L<SQL::Translator/new> and the below
 526 L</PRODUCER FUNCTIONS>.
 527
 528 =back
 529
 530 =head1 PRODUCER FUNCTIONS
 531
 532 The following producer functions should be implemented for completeness. If
 533 any of them are needed for a given diff, but not found, an error will be
 534 thrown.
 535
 536 =over
 537
 538 =item * C<alter_create_constraint($con, $args)>
 539
 540 =item * C<alter_drop_constraint($con, $args)>
 541
 542 =item * C<alter_create_index($idx, $args)>
 543
 544 =item * C<alter_drop_index($idx, $args)>
 545
 546 =item * C<add_field($fld, $args)>
 547
 548 =item * C<alter_field($old_fld, $new_fld, $args)>
 549
 550 =item * C<rename_field($old_fld, $new_fld, $args)>
 551
 552 =item * C<drop_field($fld, $args)>
 553
 554 =item * C<alter_table($table, $args)>
 555
 556 =item * C<drop_table($table, $args)>
 557
 558 =item * C<rename_table($old_table, $new_table, $args)> (optional)
 559
 560 =item * C<batch_alter_table($table, $hash, $args)> (optional)
 561
 562 If the producer supports C<batch_alter_table>, it will be called with the
 563 table to alter and a hash, the keys of which will be the method names listed
 564 above; values will be arrays of fields or constraints to operate on. In the
 565 case of the field functions that take two arguments this will appear as an
 566 array reference.
 567
 568 I.e. the hash might look something like the following:
 569
 570  {
 571    alter_create_constraint => [ $constraint1, $constraint2 ],
 572    add_field   => [ $field ],
 573    alter_field => [ [$old_field, $new_field] ]
 574  }
 575
 576
 577 =item * C<preprocess_schema($class, $schema)> (optional)
 578
 579 C<preprocess_schema> is called by the Diff code to allow the producer to
 580 normalize any data it needs to first. For example, the MySQL producer uses
 581 this method to ensure that FK constraint names are unique.
 582
 583 Basicaly any changes that need to be made to produce the SQL file for the
 584 schema should be done here, so that a diff between a parsed SQL file and (say)
 585 a parsed DBIx::Class::Schema object will be sane.
 586
 587 (As an aside, DBIx::Class, for instance, uses the presence of a
 588 C<preprocess_schema> function on the producer to know that it can diff between
 589 the previous SQL file and its own internal representation. Without this method
 590 on th producer it will diff the two SQL files which is slower, but known to
 591 work better on old-style producers.)
 592
 593 =back
 594
 595
 596 =head1 AUTHOR
 597
 598 Original Author(s) unknown.
 599
 600 Refactor/re-write and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
 601
 602 Redevelopment sponsored by Takkle Inc.
 603
 604 =cut