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