[dbsrgits/SQL-Translator.git] / bin / sqlt-diff

#!/usr/bin/perl -w
# vim: set ft=perl:

# -------------------------------------------------------------------
# $Id: sqlt-diff,v 1.7 2005-06-27 22:09:42 duality72 Exp $
# -------------------------------------------------------------------
# Copyright (C) 2002-4 The SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=head1 NAME

sqlt-diff - find the differences b/w two schemas

=head1 SYNOPSIS

For help:

  sqlt-diff -h|--help

For a list of all valid parsers:

  sqlt -l|--list

To diff two schemas:

  sqlt-diff [options] file_name1=parser file_name2=parser

Options:

  -d|--debug   Show debugging info

=head1 DESCRIPTION

sqlt-diff is a utility for creating a file of SQL commands necessary to
transform the first schema provided to the second.  While not yet 
exhaustive in its ability to mutate the entire schema, it will report the 
following

=over

=item * New tables

Using the Producer class of the target (second) schema, any tables missing
in the first schema will be generated in their entirety (fields, constraints,
indices).

=item * Missing/altered fields

Any fields missing or altered between the two schemas will be reported 
as:

  ALTER TABLE <table_name> 
    [DROP <field_name>] 
    [CHANGE <field_name> <datatype> (<size>)] ;

=item * Missing/altered indices

Any indices missing or of a different type or on different fields will be
indicated.  Indices that should be dropped will be reported as such:
 
  DROP INDEX <index_name> ON <table_name> ;

An index of a different type or on different fields will be reported as a 
new index as such:

  CREATE [<index_type>] INDEX [<index_name>] ON <table_name> 
    ( <field_name>[,<field_name>] ) ;

=back

"ALTER/DROP TABLE" and "CREATE INDEX" statements B<are not> generated by
the Producer, unfortunately, and may require massaging before being passed to
your target database.

=cut

# -------------------------------------------------------------------

use strict;
use Pod::Usage;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;

use vars qw( $VERSION );
$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;

my ( @input, $list, $help, $debug );
for my $arg ( @ARGV ) {
    if ( $arg =~ m/^-?-l(ist)?$/ ) {
        $list = 1;
    }
    elsif ( $arg =~ m/^-?-h(elp)?$/ ) {
        $help = 1;
    }
    elsif ( $arg =~ m/^-?-d(ebug)?$/ ) {
        $debug = 1; 
    }
    elsif ( $arg =~ m/^([^=]+)=(.+)$/ ) {
        push @input, { file => $1, parser => $2 };
    }
    else {
        pod2usage( msg => "Unknown argument '$arg'" );
    }
}

pod2usage(1) if $help;
pod2usage('Please specify only two schemas to diff') if scalar @input > 2;

my $tr            = SQL::Translator->new;
my @parsers       = $tr->list_parsers;
my %valid_parsers = map { $_, 1 } @parsers;

if ( $list ) {
    print "\nParsers:\n", map { "\t$_\n" } sort @parsers;
    print "\n";
    exit(0);
}

pod2usage( msg => 'Too many file args' ) if @input > 2;

my ( $source_schema, $source_db, $target_schema, $target_db );
my $i = 2;
for my $in ( @input ) {
    my $file   = $in->{'file'};
    my $parser = $in->{'parser'};

    die "Unable to read file '$file'\n" unless -r $file;
    die "'$parser' is an invalid parser\n" unless $valid_parsers{ $parser };

    my $t = SQL::Translator->new;
    $t->debug( $debug );
    $t->parser( $parser )            or die $tr->error;
    $t->producer( 'YAML' )           or die $tr->error;
    my $out = $t->translate( $file ) or die $tr->error;
    my $schema = $t->schema;
    unless ( $schema->name ) {
        $schema->name( $file );
    }

    if ( $i == 1 ) {
        $source_schema = $schema;
        $source_db     = $parser;
    }
    else {
        $target_schema = $schema;
        $target_db     = $parser;
    }
    $i--;
}
my $case_insensitive = $target_db =~ /SQLServer/;

my $s1_name  = $source_schema->name;
my $s2_name  = $target_schema->name;
my ( @new_tables, @diffs , @diffs_at_end);
for my $t1 ( $source_schema->get_tables ) {
    my $t1_name = $t1->name;
    my $t2      = $target_schema->get_table( $t1_name, $case_insensitive );

    warn "TABLE '$s1_name.$t1_name'\n" if $debug;
    unless ( $t2 ) {
        warn "Couldn't find table '$s1_name.$t1_name' in '$s2_name'\n" 
            if $debug;
        if ( $target_db =~ /SQLServer/ ) {
			for my $constraint ( $t1->get_constraints ) {
				next if $constraint->type eq PRIMARY_KEY;
				push @diffs_at_end, "ALTER TABLE $t1_name ADD ".
					constraint_to_string($constraint, $source_schema).";";
				$t1->drop_constraint($constraint);
			}
        }
        push @new_tables, $t1;
        next;
    }
    
    # Go through our options
	my $options_different = 0;
	my %checkedOptions;
OPTION:
	for my $t1_option_ref ( $t1->options ) {
		my($key1, $value1) = %{$t1_option_ref};
		for my $t2_option_ref ( $t2->options ) {
			my($key2, $value2) = %{$t2_option_ref};
			if ( $key1 eq $key2 ) {
				if ( defined $value1 != defined $value2 ) {
					$options_different = 1;
					last OPTION;
				}
				if ( defined $value1 && $value1 ne $value2 ) {
					$options_different = 1;
					last OPTION;
				}
				$checkedOptions{$key1} = 1;
				next OPTION;
			}
		}
		$options_different = 1;
		last OPTION;
	}
    # Go through the other table's options
    unless ( $options_different ) {
	    for my $t2_option_ref ( $t2->options ) {
	    	my($key, $value) = %{$t2_option_ref};
	    	next if $checkedOptions{$key};
	    	$options_different = 1;
	    	last;
	    }
    }
    # If there's a difference, just re-set all the options
    my @diffs_table_options;
    if ( $options_different ) {
    	my @options = ();
    	foreach my $option_ref ( $t1->options ) {
    		my($key, $value) = %{$option_ref};
    		push(@options, defined $value ? "$key=$value" : $key);
    	}
    	my $options = join(' ', @options);
		@diffs_table_options = ("ALTER TABLE $t1_name $options;");
    }
	
    my $t2_name = $t2->name;
    my(@diffs_table_adds, @diffs_table_changes);
    for my $t1_field ( $t1->get_fields ) {
        my $f1_type      = $t1_field->data_type;
        my $f1_size      = $t1_field->size;
        my $f1_name      = $t1_field->name;
        my $f1_nullable  = $t1_field->is_nullable;
        my $f1_default   = $t1_field->default_value;
        my $f1_auto_inc  = $t1_field->is_auto_increment;
        my $t2_field     = $t2->get_field( $f1_name );
        my $f1_full_name = "$s1_name.$t1_name.$t1_name";
        warn "FIELD '$f1_full_name'\n" if $debug;

        my $f2_full_name = "$s2_name.$t2_name.$f1_name";

        unless ( $t2_field ) {
            warn "Couldn't find field '$f2_full_name' in '$t2_name'\n" 
                if $debug;
            my $temp_default_value = 0;
            if ( $target_db =~ /SQLServer/ && !$f1_nullable && !defined $f1_default ) {
            	# SQL Server doesn't allow adding non-nullable, non-default columns
            	# so we add it with a default value, then remove the default value
            	$temp_default_value = 1;
            	my(@numeric_types) = qw(decimal numeric float real int bigint smallint tinyint);
            	$f1_default = grep($_ eq $f1_type, @numeric_types) ? 0 : '';
            }
            push @diffs_table_adds, sprintf( "ALTER TABLE %s ADD %s %s%s%s%s%s;",
                $t1_name, $f1_name, $f1_type,
                ($f1_size && $f1_type !~ /(blob|text)$/) ? "($f1_size)" : '',
                $f1_nullable ? '' : ' NOT NULL',
                !defined $f1_default ? ''
                	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
                	: " DEFAULT '$f1_default'",
                $f1_auto_inc ? ' AUTO_INCREMENT' : '',
            );
            if ( $temp_default_value ) {
            	undef $f1_default;
	            push @diffs_table_adds, sprintf( "ALTER TABLE %s %s %s%s %s%s%s%s%s;",
	                $t1_name, $target_db =~ /SQLServer/ ? "ALTER COLUMN" : "CHANGE",
	                $f1_name, $target_db =~ /MySQL/ ? " $f1_name" : '',
	                $f1_type, ($f1_size && $f1_type !~ /(blob|text)$/) ? "($f1_size)" : '',
	                $f1_nullable ? '' : ' NOT NULL',
	                !defined $f1_default || $target_db =~ /SQLServer/ ? ''
	                	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	                	: " DEFAULT '$f1_default'",
	                $f1_auto_inc ? ' AUTO_INCREMENT' : '',
	            );
            }
            next;
        }

        my $f2_type = $t2_field->data_type;
        my $f2_size = $t2_field->size || '';
        my $f2_nullable  = $t2_field->is_nullable;
        my $f2_default   = $t2_field->default_value;
        my $f2_auto_inc  = $t2_field->is_auto_increment;

        if ( !$t1_field->equals($t2_field, $case_insensitive) ) {
        	# SQLServer timstamp fields can't be altered, so we drop and add instead
        	if ( $target_db =~ /SQLServer/ && $f2_type eq "timestamp" ) {
        		push @diffs_table_changes, "ALTER TABLE $t1_name DROP COLUMN $f1_name;";
	            push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD %s %s%s%s%s%s;",
	                $t1_name, $f1_name, $f1_type,
	                ($f1_size && $f1_type !~ /(blob|text)$/) ? "($f1_size)" : '',
	                $f1_nullable ? '' : ' NOT NULL',
	                !defined $f1_default ? ''
	                	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	                	: " DEFAULT '$f1_default'",
	                $f1_auto_inc ? ' AUTO_INCREMENT' : '',
	            );
	            next;
        	}
        		
            push @diffs_table_changes, sprintf( "ALTER TABLE %s %s %s%s %s%s%s%s%s;",
                $t1_name, $target_db =~ /SQLServer/ ? "ALTER COLUMN" : "CHANGE",
                $f1_name, $target_db =~ /MySQL/ ? " $f1_name" : '',
                $f1_type, ($f1_size && $f1_type !~ /(blob|text)$/) ? "($f1_size)" : '',
                $f1_nullable ? '' : ' NOT NULL',
                !defined $f1_default || $target_db =~ /SQLServer/ ? ''
                	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
                	: " DEFAULT '$f1_default'",
                $f1_auto_inc ? ' AUTO_INCREMENT' : '',
            );
            if ( defined $f1_default && $target_db =~ /SQLServer/ ) {
            	# Adding a column with a default value for SQL Server means adding a 
            	# constraint and setting existing NULLs to the default value
            	push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD CONSTRAINT DF_%s_%s %s FOR %s;",
            		$t1_name, $t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'DEFAULT NULL'
                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'DEFAULT CURRENT_TIMESTAMP'
                	: "DEFAULT '$f1_default'", $f1_name,
                );
            	push @diffs_table_changes, sprintf( "UPDATE %s SET %s = %s WHERE %s IS NULL;",
            		$t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'NULL'
                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'CURRENT_TIMESTAMP'
                	: "'$f1_default'", $f1_name,
                );
            }
        }
    }
    
	my(%table2_indices, @diffs_index_creates, @diffs_index_drops);
	for my $i2 ( $t2->get_indices ) {
		$table2_indices{$i2} = $i2;
	}
INDEX:
	for my $i1 ( $t1->get_indices ) {
		for my $i2 ( keys %table2_indices ) {
			$i2 = $table2_indices{$i2};
			if ( $i1->equals($i2, $case_insensitive) ) {
				delete $table2_indices{$i2};
				next INDEX;
			}
		}
		push @diffs_index_creates, sprintf(
                "CREATE %sINDEX%s ON %s (%s);",
                $i1->type eq NORMAL ? '' : $i1->type." ",
                $i1->name ? " ".$i1->name : '',
                $t1_name,
                join(",", $i1->fields),
            );
	}
	for my $i2 ( keys %table2_indices ) {
		$i2 = $table2_indices{$i2};
		$target_db =~ /SQLServer/
			? push @diffs_index_drops, "DROP INDEX $t1_name.".$i2->name.";"
			: push @diffs_index_drops, "DROP INDEX ".$i2->name." on $t1_name;";
	}
    
	my(%table2_constraints, @diffs_constraint_adds, @diffs_constraint_drops);
	for my $c2 ( $t2->get_constraints ) {
		$table2_constraints{$c2} = $c2;
	}
CONSTRAINT:
	for my $c1 ( $t1->get_constraints ) {
		for my $c2 ( keys %table2_constraints ) {
			$c2 = $table2_constraints{$c2};
			if ( $c1->equals($c2, $case_insensitive) ) {
				delete $table2_constraints{$c2};
				next CONSTRAINT;
			}
		}
		push @diffs_constraint_adds, "ALTER TABLE $t1_name ADD ".
			constraint_to_string($c1, $source_schema).";";
	}
	for my $c2 ( keys %table2_constraints ) {
		$c2 = $table2_constraints{$c2};
		if ( $c2->type eq UNIQUE ) {
			push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP INDEX ".
				$c2->name.";";
		} elsif ( $target_db =~ /SQLServer/ ) {
			push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->name.";";
		} else {
			push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->type.
				($c2->type eq FOREIGN_KEY ? " ".$c2->name : '').";";
		}
	}
	
	push @diffs, @diffs_index_drops, @diffs_constraint_drops,
		@diffs_table_options, @diffs_table_adds, @diffs_table_changes,
		@diffs_constraint_adds, @diffs_index_creates;
}

for my $t2 ( $target_schema->get_tables ) {
    my $t2_name = $t2->name;
    my $t1      = $source_schema->get_table( $t2_name, $target_db =~ /SQLServer/ );

    unless ( $t1 ) {
    	if ( $target_db =~ /SQLServer/ ) {
			for my $constraint ( $t2->get_constraints ) {
				next if $constraint->type eq PRIMARY_KEY;
				push @diffs, "ALTER TABLE $t2_name DROP ".$constraint->name.";";
			}
    	}
        push @diffs_at_end, "DROP TABLE $t2_name;";
        next;
    }

    for my $t2_field ( $t2->get_fields ) {
        my $f2_name      = $t2_field->name;
        my $t1_field     = $t1->get_field( $f2_name );
        unless ( $t1_field ) {
        	my $modifier = $target_db =~ /SQLServer/ ? "COLUMN " : '';
            push @diffs, "ALTER TABLE $t2_name DROP $modifier$f2_name;";
        }
    }
}

if ( @new_tables ) {
    my $dummy_tr = SQL::Translator->new;
    $dummy_tr->schema->add_table( $_ ) for @new_tables;
    my $producer = $dummy_tr->producer( $target_db );
    unshift @diffs, $producer->( $dummy_tr );
}
push(@diffs, @diffs_at_end);

if ( @diffs ) {
    print join( "\n", 
        "-- Convert schema '$s2_name' to '$s1_name':\n", @diffs, '' 
    );
}
else {
    print "There were no differences.\n";
}

sub constraint_to_string {
	my $c = shift;
	my $schema = shift or die "No schema given";
	my @fields = $c->fields or return '';

	if ( $c->type eq PRIMARY_KEY ) {
		return 'PRIMARY KEY (' . join(', ', @fields). ')';
	}
	elsif ( $c->type eq UNIQUE ) {
		return 'UNIQUE '.
			(defined $c->name ? $c->name.' ' : '').
			'(' . join(', ', @fields). ')';
	}
	elsif ( $c->type eq FOREIGN_KEY ) {
		my $def = join(' ', 
			map { $_ || () } 'CONSTRAINT', $c->name, 'FOREIGN KEY' 
		);

		$def .= ' (' . join( ', ', @fields ) . ')';

		$def .= ' REFERENCES ' . $c->reference_table;

		my @rfields = map { $_ || () } $c->reference_fields;
		unless ( @rfields ) {
			my $rtable_name = $c->reference_table;
			if ( my $ref_table = $schema->get_table( $rtable_name ) ) {
				push @rfields, $ref_table->primary_key;
			}
			else {
				warn "Can't find reference table '$rtable_name' " .
					"in schema\n";
			}
		}

		if ( @rfields ) {
			$def .= ' (' . join( ', ', @rfields ) . ')';
		}
		else {
			warn "FK constraint on " . 'some table' . '.' .
				join('', @fields) . " has no reference fields\n";
		}

		if ( $c->match_type ) {
			$def .= ' MATCH ' . 
				( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
		}

		if ( $c->on_delete ) {
			$def .= ' ON DELETE '.join( ' ', $c->on_delete );
		}

		if ( $c->on_update ) {
			$def .= ' ON UPDATE '.join( ' ', $c->on_update );
		}

		return $def;
	}
}
            
# -------------------------------------------------------------------
# Bring out number weight & measure in a year of dearth.
# William Blake
# -------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.

=head1 SEE ALSO

SQL::Translator, L<http://sqlfairy.sourceforge.net>.

=cut
Commit	Line	Data
e12ca55a	1	#!/usr/bin/perl -w
	2	# vim: set ft=perl:
	3
	4	# -------------------------------------------------------------------
d71512a6	5	# $Id: sqlt-diff,v 1.7 2005-06-27 22:09:42 duality72 Exp $
e12ca55a	6	# -------------------------------------------------------------------
daf4f623	7	# Copyright (C) 2002-4 The SQLFairy Authors
e12ca55a	8	#
	9	# This program is free software; you can redistribute it and/or
	10	# modify it under the terms of the GNU General Public License as
	11	# published by the Free Software Foundation; version 2.
	12	#
	13	# This program is distributed in the hope that it will be useful, but
	14	# WITHOUT ANY WARRANTY; without even the implied warranty of
	15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	16	# General Public License for more details.
	17	#
	18	# You should have received a copy of the GNU General Public License
	19	# along with this program; if not, write to the Free Software
	20	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	21	# 02111-1307 USA
	22	# -------------------------------------------------------------------
	23
	24	=head1 NAME
	25
	26	sqlt-diff - find the differences b/w two schemas
	27
	28	=head1 SYNOPSIS
	29
	30	For help:
	31
	32	sqlt-diff -h\|--help
	33
	34	For a list of all valid parsers:
	35
	36	sqlt -l\|--list
	37
	38	To diff two schemas:
	39
21f5bf40	40	sqlt-diff [options] file_name1=parser file_name2=parser
e12ca55a	41
	42	Options:
	43
	44	-d\|--debug Show debugging info
	45
	46	=head1 DESCRIPTION
	47
942485ea	48	sqlt-diff is a utility for creating a file of SQL commands necessary to
	49	transform the first schema provided to the second. While not yet
	50	exhaustive in its ability to mutate the entire schema, it will report the
	51	following
	52
	53	=over
	54
	55	=item * New tables
	56
	57	Using the Producer class of the target (second) schema, any tables missing
	58	in the first schema will be generated in their entirety (fields, constraints,
	59	indices).
	60
	61	=item * Missing/altered fields
	62
	63	Any fields missing or altered between the two schemas will be reported
	64	as:
	65
	66	ALTER TABLE <table_name>
	67	[DROP <field_name>]
	68	[CHANGE <field_name> <datatype> (<size>)] ;
	69
	70	=item * Missing/altered indices
	71
	72	Any indices missing or of a different type or on different fields will be
	73	indicated. Indices that should be dropped will be reported as such:
	74
	75	DROP INDEX <index_name> ON <table_name> ;
	76
	77	An index of a different type or on different fields will be reported as a
	78	new index as such:
	79
	80	CREATE [<index_type>] INDEX [<index_name>] ON <table_name>
	81	( <field_name>[,<field_name>] ) ;
	82
	83	=back
	84
	85	"ALTER/DROP TABLE" and "CREATE INDEX" statements B<are not> generated by
	86	the Producer, unfortunately, and may require massaging before being passed to
	87	your target database.
e12ca55a	88
	89	=cut
	90
	91	# -------------------------------------------------------------------
	92
	93	use strict;
	94	use Pod::Usage;
	95	use Data::Dumper;
	96	use SQL::Translator;
942485ea	97	use SQL::Translator::Schema::Constants;
e12ca55a	98
e12ca55a	99	use vars qw( $VERSION );
d71512a6	100	$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
e12ca55a	101
	102	my ( @input, $list, $help, $debug );
	103	for my $arg ( @ARGV ) {
	104	if ( $arg =~ m/^-?-l(ist)?$/ ) {
	105	$list = 1;
	106	}
	107	elsif ( $arg =~ m/^-?-h(elp)?$/ ) {
	108	$help = 1;
	109	}
	110	elsif ( $arg =~ m/^-?-d(ebug)?$/ ) {
	111	$debug = 1;
	112	}
	113	elsif ( $arg =~ m/^([^=]+)=(.+)$/ ) {
	114	push @input, { file => $1, parser => $2 };
	115	}
	116	else {
	117	pod2usage( msg => "Unknown argument '$arg'" );
	118	}
	119	}
	120
	121	pod2usage(1) if $help;
942485ea	122	pod2usage('Please specify only two schemas to diff') if scalar @input > 2;
e12ca55a	123
	124	my $tr = SQL::Translator->new;
	125	my @parsers = $tr->list_parsers;
	126	my %valid_parsers = map { $_, 1 } @parsers;
	127
	128	if ( $list ) {
	129	print "\nParsers:\n", map { "\t$_\n" } sort @parsers;
	130	print "\n";
	131	exit(0);
	132	}
	133
	134	pod2usage( msg => 'Too many file args' ) if @input > 2;
	135
942485ea	136	my ( $source_schema, $source_db, $target_schema, $target_db );
942485ea	137	my $i = 2;
e12ca55a	138	for my $in ( @input ) {
	139	my $file = $in->{'file'};
	140	my $parser = $in->{'parser'};
	141
	142	die "Unable to read file '$file'\n" unless -r $file;
	143	die "'$parser' is an invalid parser\n" unless $valid_parsers{ $parser };
	144
	145	my $t = SQL::Translator->new;
	146	$t->debug( $debug );
	147	$t->parser( $parser ) or die $tr->error;
	148	$t->producer( 'YAML' ) or die $tr->error;
	149	my $out = $t->translate( $file ) or die $tr->error;
	150	my $schema = $t->schema;
	151	unless ( $schema->name ) {
	152	$schema->name( $file );
	153	}
	154
	155	if ( $i == 1 ) {
942485ea	156	$source_schema = $schema;
942485ea	157	$source_db = $parser;
e12ca55a	158	}
e12ca55a	159	else {
942485ea	160	$target_schema = $schema;
942485ea	161	$target_db = $parser;
e12ca55a	162	}
942485ea	163	$i--;
e12ca55a	164	}
d71512a6	165	my $case_insensitive = $target_db =~ /SQLServer/;
e12ca55a	166
942485ea	167	my $s1_name = $source_schema->name;
942485ea	168	my $s2_name = $target_schema->name;
d71512a6	169	my ( @new_tables, @diffs , @diffs_at_end);
942485ea	170	for my $t1 ( $source_schema->get_tables ) {
942485ea	171	my $t1_name = $t1->name;
d71512a6	172	my $t2 = $target_schema->get_table( $t1_name, $case_insensitive );
942485ea	173
8b3b2f0c	174	warn "TABLE '$s1_name.$t1_name'\n" if $debug;
942485ea	175	unless ( $t2 ) {
8b3b2f0c	176	warn "Couldn't find table '$s1_name.$t1_name' in '$s2_name'\n"
8b3b2f0c	177	if $debug;
d71512a6	178	if ( $target_db =~ /SQLServer/ ) {
	179	for my $constraint ( $t1->get_constraints ) {
	180	next if $constraint->type eq PRIMARY_KEY;
	181	push @diffs_at_end, "ALTER TABLE $t1_name ADD ".
	182	constraint_to_string($constraint, $source_schema).";";
	183	$t1->drop_constraint($constraint);
	184	}
	185	}
942485ea	186	push @new_tables, $t1;
	187	next;
	188	}
d71512a6	189
	190	# Go through our options
	191	my $options_different = 0;
	192	my %checkedOptions;
	193	OPTION:
	194	for my $t1_option_ref ( $t1->options ) {
	195	my($key1, $value1) = %{$t1_option_ref};
	196	for my $t2_option_ref ( $t2->options ) {
	197	my($key2, $value2) = %{$t2_option_ref};
	198	if ( $key1 eq $key2 ) {
	199	if ( defined $value1 != defined $value2 ) {
	200	$options_different = 1;
	201	last OPTION;
	202	}
	203	if ( defined $value1 && $value1 ne $value2 ) {
	204	$options_different = 1;
	205	last OPTION;
	206	}
	207	$checkedOptions{$key1} = 1;
	208	next OPTION;
	209	}
	210	}
	211	$options_different = 1;
	212	last OPTION;
	213	}
	214	# Go through the other table's options
	215	unless ( $options_different ) {
	216	for my $t2_option_ref ( $t2->options ) {
	217	my($key, $value) = %{$t2_option_ref};
	218	next if $checkedOptions{$key};
	219	$options_different = 1;
	220	last;
	221	}
	222	}
	223	# If there's a difference, just re-set all the options
	224	my @diffs_table_options;
	225	if ( $options_different ) {
	226	my @options = ();
	227	foreach my $option_ref ( $t1->options ) {
	228	my($key, $value) = %{$option_ref};
	229	push(@options, defined $value ? "$key=$value" : $key);
	230	}
	231	my $options = join(' ', @options);
	232	@diffs_table_options = ("ALTER TABLE $t1_name $options;");
	233	}
	234
942485ea	235	my $t2_name = $t2->name;
d71512a6	236	my(@diffs_table_adds, @diffs_table_changes);
942485ea	237	for my $t1_field ( $t1->get_fields ) {
afdf6a1c	238	my $f1_type = $t1_field->data_type;
	239	my $f1_size = $t1_field->size;
	240	my $f1_name = $t1_field->name;
d71512a6	241	my $f1_nullable = $t1_field->is_nullable;
	242	my $f1_default = $t1_field->default_value;
	243	my $f1_auto_inc = $t1_field->is_auto_increment;
afdf6a1c	244	my $t2_field = $t2->get_field( $f1_name );
942485ea	245	my $f1_full_name = "$s1_name.$t1_name.$t1_name";
8b3b2f0c	246	warn "FIELD '$f1_full_name'\n" if $debug;
e12ca55a	247
afdf6a1c	248	my $f2_full_name = "$s2_name.$t2_name.$f1_name";
e12ca55a	249
942485ea	250	unless ( $t2_field ) {
8b3b2f0c	251	warn "Couldn't find field '$f2_full_name' in '$t2_name'\n"
8b3b2f0c	252	if $debug;
d71512a6	253	my $temp_default_value = 0;
	254	if ( $target_db =~ /SQLServer/ && !$f1_nullable && !defined $f1_default ) {
	255	# SQL Server doesn't allow adding non-nullable, non-default columns
	256	# so we add it with a default value, then remove the default value
	257	$temp_default_value = 1;
	258	my(@numeric_types) = qw(decimal numeric float real int bigint smallint tinyint);
	259	$f1_default = grep($_ eq $f1_type, @numeric_types) ? 0 : '';
	260	}
	261	push @diffs_table_adds, sprintf( "ALTER TABLE %s ADD %s %s%s%s%s%s;",
afdf6a1c	262	$t1_name, $f1_name, $f1_type,
d71512a6	263	($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
	264	$f1_nullable ? '' : ' NOT NULL',
	265	!defined $f1_default ? ''
	266	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	267	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	268	: " DEFAULT '$f1_default'",
	269	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
afdf6a1c	270	);
d71512a6	271	if ( $temp_default_value ) {
	272	undef $f1_default;
	273	push @diffs_table_adds, sprintf( "ALTER TABLE %s %s %s%s %s%s%s%s%s;",
	274	$t1_name, $target_db =~ /SQLServer/ ? "ALTER COLUMN" : "CHANGE",
	275	$f1_name, $target_db =~ /MySQL/ ? " $f1_name" : '',
	276	$f1_type, ($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
	277	$f1_nullable ? '' : ' NOT NULL',
	278	!defined $f1_default \|\| $target_db =~ /SQLServer/ ? ''
	279	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	280	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	281	: " DEFAULT '$f1_default'",
	282	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
	283	);
	284	}
e12ca55a	285	next;
	286	}
	287
afdf6a1c	288	my $f2_type = $t2_field->data_type;
d71512a6	289	my $f2_size = $t2_field->size \|\| '';
	290	my $f2_nullable = $t2_field->is_nullable;
	291	my $f2_default = $t2_field->default_value;
	292	my $f2_auto_inc = $t2_field->is_auto_increment;
	293
	294	if ( !$t1_field->equals($t2_field, $case_insensitive) ) {
	295	# SQLServer timstamp fields can't be altered, so we drop and add instead
	296	if ( $target_db =~ /SQLServer/ && $f2_type eq "timestamp" ) {
	297	push @diffs_table_changes, "ALTER TABLE $t1_name DROP COLUMN $f1_name;";
	298	push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD %s %s%s%s%s%s;",
	299	$t1_name, $f1_name, $f1_type,
	300	($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
	301	$f1_nullable ? '' : ' NOT NULL',
	302	!defined $f1_default ? ''
	303	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	304	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	305	: " DEFAULT '$f1_default'",
	306	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
	307	);
	308	next;
	309	}
	310
	311	push @diffs_table_changes, sprintf( "ALTER TABLE %s %s %s%s %s%s%s%s%s;",
	312	$t1_name, $target_db =~ /SQLServer/ ? "ALTER COLUMN" : "CHANGE",
	313	$f1_name, $target_db =~ /MySQL/ ? " $f1_name" : '',
	314	$f1_type, ($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
	315	$f1_nullable ? '' : ' NOT NULL',
	316	!defined $f1_default \|\| $target_db =~ /SQLServer/ ? ''
	317	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	318	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	319	: " DEFAULT '$f1_default'",
	320	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
afdf6a1c	321	);
d71512a6	322	if ( defined $f1_default && $target_db =~ /SQLServer/ ) {
	323	# Adding a column with a default value for SQL Server means adding a
	324	# constraint and setting existing NULLs to the default value
	325	push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD CONSTRAINT DF_%s_%s %s FOR %s;",
	326	$t1_name, $t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'DEFAULT NULL'
	327	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'DEFAULT CURRENT_TIMESTAMP'
	328	: "DEFAULT '$f1_default'", $f1_name,
	329	);
	330	push @diffs_table_changes, sprintf( "UPDATE %s SET %s = %s WHERE %s IS NULL;",
	331	$t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'NULL'
	332	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'CURRENT_TIMESTAMP'
	333	: "'$f1_default'", $f1_name,
	334	);
e12ca55a	335	}
	336	}
	337	}
d71512a6	338
	339	my(%table2_indices, @diffs_index_creates, @diffs_index_drops);
	340	for my $i2 ( $t2->get_indices ) {
	341	$table2_indices{$i2} = $i2;
	342	}
	343	INDEX:
	344	for my $i1 ( $t1->get_indices ) {
	345	for my $i2 ( keys %table2_indices ) {
	346	$i2 = $table2_indices{$i2};
	347	if ( $i1->equals($i2, $case_insensitive) ) {
	348	delete $table2_indices{$i2};
	349	next INDEX;
	350	}
	351	}
	352	push @diffs_index_creates, sprintf(
942485ea	353	"CREATE %sINDEX%s ON %s (%s);",
d71512a6	354	$i1->type eq NORMAL ? '' : $i1->type." ",
d71512a6	355	$i1->name ? " ".$i1->name : '',
942485ea	356	$t1_name,
d71512a6	357	join(",", $i1->fields),
942485ea	358	);
d71512a6	359	}
	360	for my $i2 ( keys %table2_indices ) {
	361	$i2 = $table2_indices{$i2};
	362	$target_db =~ /SQLServer/
	363	? push @diffs_index_drops, "DROP INDEX $t1_name.".$i2->name.";"
	364	: push @diffs_index_drops, "DROP INDEX ".$i2->name." on $t1_name;";
	365	}
	366
	367	my(%table2_constraints, @diffs_constraint_adds, @diffs_constraint_drops);
	368	for my $c2 ( $t2->get_constraints ) {
	369	$table2_constraints{$c2} = $c2;
	370	}
	371	CONSTRAINT:
	372	for my $c1 ( $t1->get_constraints ) {
	373	for my $c2 ( keys %table2_constraints ) {
	374	$c2 = $table2_constraints{$c2};
	375	if ( $c1->equals($c2, $case_insensitive) ) {
	376	delete $table2_constraints{$c2};
	377	next CONSTRAINT;
	378	}
	379	}
	380	push @diffs_constraint_adds, "ALTER TABLE $t1_name ADD ".
	381	constraint_to_string($c1, $source_schema).";";
	382	}
	383	for my $c2 ( keys %table2_constraints ) {
	384	$c2 = $table2_constraints{$c2};
	385	if ( $c2->type eq UNIQUE ) {
	386	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP INDEX ".
	387	$c2->name.";";
	388	} elsif ( $target_db =~ /SQLServer/ ) {
	389	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->name.";";
	390	} else {
	391	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->type.
	392	($c2->type eq FOREIGN_KEY ? " ".$c2->name : '').";";
	393	}
	394	}
	395
	396	push @diffs, @diffs_index_drops, @diffs_constraint_drops,
	397	@diffs_table_options, @diffs_table_adds, @diffs_table_changes,
	398	@diffs_constraint_adds, @diffs_index_creates;
942485ea	399	}
	400
	401	for my $t2 ( $target_schema->get_tables ) {
	402	my $t2_name = $t2->name;
d71512a6	403	my $t1 = $source_schema->get_table( $t2_name, $target_db =~ /SQLServer/ );
942485ea	404
942485ea	405	unless ( $t1 ) {
d71512a6	406	if ( $target_db =~ /SQLServer/ ) {
	407	for my $constraint ( $t2->get_constraints ) {
	408	next if $constraint->type eq PRIMARY_KEY;
	409	push @diffs, "ALTER TABLE $t2_name DROP ".$constraint->name.";";
	410	}
	411	}
	412	push @diffs_at_end, "DROP TABLE $t2_name;";
942485ea	413	next;
	414	}
	415
	416	for my $t2_field ( $t2->get_fields ) {
	417	my $f2_name = $t2_field->name;
	418	my $t1_field = $t1->get_field( $f2_name );
	419	unless ( $t1_field ) {
d71512a6	420	my $modifier = $target_db =~ /SQLServer/ ? "COLUMN " : '';
d71512a6	421	push @diffs, "ALTER TABLE $t2_name DROP $modifier$f2_name;";
942485ea	422	}
	423	}
	424	}
	425
	426	if ( @new_tables ) {
	427	my $dummy_tr = SQL::Translator->new;
	428	$dummy_tr->schema->add_table( $_ ) for @new_tables;
	429	my $producer = $dummy_tr->producer( $target_db );
	430	unshift @diffs, $producer->( $dummy_tr );
e12ca55a	431	}
d71512a6	432	push(@diffs, @diffs_at_end);
e12ca55a	433
e12ca55a	434	if ( @diffs ) {
942485ea	435	print join( "\n",
8b3b2f0c	436	"-- Convert schema '$s2_name' to '$s1_name':\n", @diffs, ''
942485ea	437	);
e12ca55a	438	}
	439	else {
	440	print "There were no differences.\n";
	441	}
	442
d71512a6	443	sub constraint_to_string {
	444	my $c = shift;
	445	my $schema = shift or die "No schema given";
	446	my @fields = $c->fields or return '';
	447
	448	if ( $c->type eq PRIMARY_KEY ) {
	449	return 'PRIMARY KEY (' . join(', ', @fields). ')';
	450	}
	451	elsif ( $c->type eq UNIQUE ) {
	452	return 'UNIQUE '.
	453	(defined $c->name ? $c->name.' ' : '').
	454	'(' . join(', ', @fields). ')';
	455	}
	456	elsif ( $c->type eq FOREIGN_KEY ) {
	457	my $def = join(' ',
	458	map { $_ \|\| () } 'CONSTRAINT', $c->name, 'FOREIGN KEY'
	459	);
	460
	461	$def .= ' (' . join( ', ', @fields ) . ')';
	462
	463	$def .= ' REFERENCES ' . $c->reference_table;
	464
	465	my @rfields = map { $_ \|\| () } $c->reference_fields;
	466	unless ( @rfields ) {
	467	my $rtable_name = $c->reference_table;
	468	if ( my $ref_table = $schema->get_table( $rtable_name ) ) {
	469	push @rfields, $ref_table->primary_key;
	470	}
	471	else {
	472	warn "Can't find reference table '$rtable_name' " .
	473	"in schema\n";
	474	}
	475	}
	476
	477	if ( @rfields ) {
	478	$def .= ' (' . join( ', ', @rfields ) . ')';
	479	}
	480	else {
	481	warn "FK constraint on " . 'some table' . '.' .
	482	join('', @fields) . " has no reference fields\n";
	483	}
	484
	485	if ( $c->match_type ) {
	486	$def .= ' MATCH ' .
	487	( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
	488	}
	489
	490	if ( $c->on_delete ) {
	491	$def .= ' ON DELETE '.join( ' ', $c->on_delete );
	492	}
	493
	494	if ( $c->on_update ) {
	495	$def .= ' ON UPDATE '.join( ' ', $c->on_update );
	496	}
	497
	498	return $def;
	499	}
	500	}
	501
e12ca55a	502	# -------------------------------------------------------------------
	503	# Bring out number weight & measure in a year of dearth.
	504	# William Blake
	505	# -------------------------------------------------------------------
	506
	507	=pod
	508
	509	=head1 AUTHOR
	510
	511	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
	512
	513	=head1 SEE ALSO
	514
	515	SQL::Translator, L<http://sqlfairy.sourceforge.net>.
	516
	517	=cut