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