lib/SQL/Translator/Diff.pm

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