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 target_schema
  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, $output_db, $options) = @_;
  49     $options ||= {};
  50
  51     my $obj = SQL::Translator::Diff->new( {
  52       %$options,
  53       source_schema => $source_schema,
  54       target_schema => $target_schema,
  55       output_db     => $output_db
  56     } );
  57
  58     $obj->compute_differences->produce_diff_sql;
  59 }
  60
  61 sub new {
  62   my ($class, $values) = @_;
  63   $values->{$_} ||= [] foreach @diff_arrays;
  64   $values->{table_diff_hash} = {};
  65
  66   $values->{producer_options} ||= {};
  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       $preprocess->($source_schema);
  83       $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           $self->producer_options
 185         );
 186       }
 187     } else {
 188
 189       # If we have any table renames we need to do those first;
 190       my %flattened_diffs;
 191       foreach my $table ( sort keys %{$self->table_diff_hash} ) {
 192         my $table_diff = $self->table_diff_hash->{$table};
 193         for (@diff_hash_keys) {
 194           push( @{ $flattened_diffs{ $func_map{$_} } ||= [] }, @{ $table_diff->{$_} } );
 195         }
 196       }
 197
 198       push @diffs, map( {
 199           if (@{ $flattened_diffs{$_} || [] }) {
 200             my $meth = $producer_class->can($_);
 201
 202             $meth ? map {
 203                     my $sql = $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $self->producer_options );
 204                     $sql ?  ("$sql") : ();
 205                   } @{ $flattened_diffs{$_} }
 206                   : $self->ignore_missing_methods
 207                   ? "-- $producer_class cant $_"
 208                   : die "$producer_class cant $_";
 209           } else { () }
 210
 211         } qw/rename_table
 212              alter_drop_constraint
 213              alter_drop_index
 214              drop_field
 215              add_field
 216              alter_field
 217              rename_field
 218              alter_create_index
 219              alter_create_constraint
 220              alter_table/),
 221     }
 222
 223     if (my @tables = @{ $self->tables_to_create } ) {
 224       my $translator = new SQL::Translator(
 225         producer_type => $self->output_db,
 226         add_drop_table => 0,
 227         no_comments => 1,
 228         # TODO: sort out options
 229         %{ $self->producer_options }
 230       );
 231       $translator->producer_args->{no_transaction} = 1;
 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->output_db !~ /^(?:MySQL|SQLite|PostgreSQL)$/ ) {
 259         unshift(@diffs, "-- Output database @{[$self->output_db]} is untested/unsupported!!!");
 260       }
 261
 262       my @return =
 263         map { $_ ? ( $_ =~ /;$/xms ? $_ : "$_;\n\n" ) : "\n" }
 264         ("-- Convert schema '$src_name' to '$tar_name':", @diffs);
 265
 266       return wantarray ? @return : join('', @return);
 267     }
 268     return undef;
 269
 270 }
 271
 272 sub diff_table_indexes {
 273   my ($self, $src_table, $tar_table) = @_;
 274
 275   my (%checked_indices);
 276   INDEX_CREATE:
 277   for my $i_tar ( $tar_table->get_indices ) {
 278     for my $i_src ( $src_table->get_indices ) {
 279       if ( $i_tar->equals($i_src, $self->case_insensitive, $self->ignore_index_names) ) {
 280         $checked_indices{$i_src} = 1;
 281         next INDEX_CREATE;
 282       }
 283     }
 284     push @{$self->table_diff_hash->{$tar_table}{indexes_to_create}}, $i_tar;
 285   }
 286
 287   INDEX_DROP:
 288   for my $i_src ( $src_table->get_indices ) {
 289     next if !$self->ignore_index_names && $checked_indices{$i_src};
 290     for my $i_tar ( $tar_table->get_indices ) {
 291       next INDEX_DROP if $i_src->equals($i_tar, $self->case_insensitive, $self->ignore_index_names);
 292     }
 293     push @{$self->table_diff_hash->{$tar_table}{indexes_to_drop}}, $i_src;
 294   }
 295 }
 296
 297
 298 sub diff_table_constraints {
 299   my ($self, $src_table, $tar_table) = @_;
 300
 301   my(%checked_constraints);
 302   CONSTRAINT_CREATE:
 303   for my $c_tar ( $tar_table->get_constraints ) {
 304     for my $c_src ( $src_table->get_constraints ) {
 305
 306       # This is a bit of a hack - needed for renaming tables to work
 307       local $c_src->{table} = $tar_table;
 308
 309       if ( $c_tar->equals($c_src, $self->case_insensitive, $self->ignore_constraint_names) ) {
 310         $checked_constraints{$c_src} = 1;
 311         next CONSTRAINT_CREATE;
 312       }
 313     }
 314     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_create} }, $c_tar;
 315   }
 316
 317
 318   CONSTRAINT_DROP:
 319   for my $c_src ( $src_table->get_constraints ) {
 320
 321     # This is a bit of a hack - needed for renaming tables to work
 322     local $c_src->{table} = $tar_table;
 323
 324     next if !$self->ignore_constraint_names && $checked_constraints{$c_src};
 325     for my $c_tar ( $tar_table->get_constraints ) {
 326       next CONSTRAINT_DROP if $c_src->equals($c_tar, $self->case_insensitive, $self->ignore_constraint_names);
 327     }
 328
 329     push @{ $self->table_diff_hash->{$tar_table}{constraints_to_drop} }, $c_src;
 330   }
 331
 332 }
 333
 334 sub diff_table_fields {
 335   my ($self, $src_table, $tar_table) = @_;
 336
 337   # List of ones ew've renamed from so we dont drop them
 338   my %renamed_source_fields;
 339
 340   for my $tar_table_field ( $tar_table->get_fields ) {
 341     my $f_tar_name      = $tar_table_field->name;
 342
 343     if (my $old_name = $tar_table_field->extra->{renamed_from}) {
 344       my $src_table_field = $src_table->get_field( $old_name, $self->case_insensitive );
 345       unless ($src_table_field) {
 346         warn qq#Renamed column can't find old column "@{[$src_table->name]}.$old_name" for renamed column\n#;
 347         delete $tar_table_field->extra->{renamed_from};
 348       } else {
 349         push @{$self->table_diff_hash->{$tar_table}{fields_to_rename} }, [ $src_table_field, $tar_table_field ];
 350         $renamed_source_fields{$old_name} = 1;
 351         next;
 352       }
 353     }
 354
 355     my $src_table_field = $src_table->get_field( $f_tar_name, $self->case_insensitive );
 356
 357     unless ( $src_table_field ) {
 358       push @{$self->table_diff_hash->{$tar_table}{fields_to_create}}, $tar_table_field;
 359       next;
 360     }
 361
 362     # field exists, something changed. This is a bit complex. Parsers can
 363     # normalize types, but only some of them do, so compare the normalized and
 364     # parsed types for each field to each other
 365     if ( !$tar_table_field->equals($src_table_field, $self->case_insensitive) &&
 366          !$tar_table_field->equals($src_table_field->parsed_field, $self->case_insensitive) &&
 367          !$tar_table_field->parsed_field->equals($src_table_field, $self->case_insensitive) &&
 368          !$tar_table_field->parsed_field->equals($src_table_field->parsed_field, $self->case_insensitive) ) {
 369
 370       # Some producers might need src field to diff against
 371       push @{$self->table_diff_hash->{$tar_table}{fields_to_alter}}, [ $src_table_field, $tar_table_field ];
 372       next;
 373     }
 374   }
 375
 376
 377   # Now check to see if any fields from src_table need to be dropped
 378   for my $src_table_field ( $src_table->get_fields ) {
 379     my $f_src_name      = $src_table_field->name;
 380     next if $renamed_source_fields{$f_src_name};
 381
 382     my $tar_table_field = $tar_table->get_field( $f_src_name, $self->case_insensitive );
 383
 384     unless ( $tar_table_field ) {
 385       push @{$self->table_diff_hash->{$tar_table}{fields_to_drop}}, $src_table_field;
 386       next;
 387     }
 388   }
 389 }
 390
 391 sub diff_table_options {
 392   my ($self, $src_table, $tar_table) = @_;
 393
 394   my $cmp = sub {
 395     my ($a_name, undef, $b_name, undef) = ( %$a, %$b );
 396     $a_name cmp $b_name;
 397   };
 398   # Need to sort the options so we dont get supruious diffs.
 399   my (@src_opts, @tar_opts);
 400   @src_opts = sort $cmp $src_table->options;
 401   @tar_opts = sort $cmp $tar_table->options;
 402
 403
 404   # If there's a difference, just re-set all the options
 405   push @{ $self->table_diff_hash->{$tar_table}{table_options} }, $tar_table
 406     unless $src_table->_compare_objects( \@src_opts, \@tar_opts );
 407 }
 408
 409 1;
 410
 411 __END__
 412
 413 =head1 NAME
 414
 415 SQL::Translator::Diff
 416
 417 =head1 DESCRIPTION
 418
 419 Takes two input SQL::Translator::Schemas (or SQL files) and produces ALTER
 420 statments to make them the same
 421
 422 =head1 SNYOPSIS
 423
 424 Simplest usage:
 425
 426  use SQL::Translator::Diff;
 427  my $sql = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL', $options_hash)
 428
 429 OO usage:
 430
 431  use SQL::Translator::Diff;
 432  my $diff = SQL::Translator::Diff->new({
 433    output_db     => 'MySQL',
 434    source_schema => $source_schema,
 435    target_schema => $target_schema,
 436    %$options_hash,
 437  })->compute_differences->produce_diff_sql;
 438
 439 =head1 OPTIONS
 440
 441 =over
 442
 443 =item B<ignore_index_names>
 444
 445 Match indexes based on types and fields, ignoring name.
 446
 447 =item B<ignore_constraint_names>
 448
 449 Match constrains based on types, fields and tables, ignoring name.
 450
 451 =item B<output_db>
 452
 453 Which producer to use to produce the output.
 454
 455 =item B<case_insensitive>
 456
 457 Ignore case of table, field, index and constraint names when comparing
 458
 459 =item B<no_batch_alters>
 460
 461 Produce each alter as a distinct C<ALTER TABLE> statement even if the producer
 462 supports the ability to do all alters for a table as one statement.
 463
 464 =item B<ignore_missing_methods>
 465
 466 If the diff would need a method that is missing from the producer, just emit a
 467 comment showing the method is missing, rather than dieing with an error
 468
 469 =back
 470
 471 =head1 PRODUCER FUNCTIONS
 472
 473 The following producer functions should be implemented for completeness. If
 474 any of them are needed for a given diff, but not found, an error will be
 475 thrown.
 476
 477 =over
 478
 479 =item * C<alter_create_constraint($con)>
 480
 481 =item * C<alter_drop_constraint($con)>
 482
 483 =item * C<alter_create_index($idx)>
 484
 485 =item * C<alter_drop_index($idx)>
 486
 487 =item * C<add_field($fld)>
 488
 489 =item * C<alter_field($old_fld, $new_fld)>
 490
 491 =item * C<rename_field($old_fld, $new_fld)>
 492
 493 =item * C<drop_field($fld)>
 494
 495 =item * C<alter_table($table)>
 496
 497 =item * C<drop_table($table)>
 498
 499 =item * C<rename_table($old_table, $new_table)> (optional)
 500
 501 =item * C<batch_alter_table($table, $hash)> (optional)
 502
 503 If the producer supports C<batch_alter_table>, it will be called with the
 504 table to alter and a hash, the keys of which will be the method names listed
 505 above; values will be arrays of fields or constraints to operate on. In the
 506 case of the field functions that take two arguments this will appear as a hash.
 507
 508 I.e. the hash might look something like the following:
 509
 510  {
 511    alter_create_constraint => [ $constraint1, $constraint2 ],
 512    add_field   => [ $field ],
 513    alter_field => [ [$old_field, $new_field] ]
 514  }
 515
 516
 517 =item * C<preprocess_schema($class, $schema)> (optional)
 518
 519 C<preprocess_schema> is called by the Diff code to allow the producer to
 520 normalize any data it needs to first. For example, the MySQL producer uses
 521 this method to ensure that FK contraint names are unique.
 522
 523 Basicaly any changes that need to be made to produce the SQL file for the
 524 schema should be done here, so that a diff between a parsed SQL file and (say)
 525 a parsed DBIx::Class::Schema object will be sane.
 526
 527 (As an aside, DBIx::Class, for instance, uses the presence of a
 528 C<preprocess_schema> function on the producer to know that it can diff between
 529 the previous SQL file and its own internal representation. Without this method
 530 on th producer it will diff the two SQL files which is slower, but known to
 531 work better on old-style producers.)
 532
 533 =back
 534
 535
 536 =head1 AUTHOR
 537
 538 Original Author(s) unknown.
 539
 540 Refactor/re-write and more comprehensive tests by Ash Berlin C<< ash@cpan.org >>.
 541
 542 Redevelopment sponsored by Takkle Inc.
 543
 544 =cut