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