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