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

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

# -------------------------------------------------------------------
# $Id: sqlt-diff,v 1.12 2005-08-31 15:42:17 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.12 $ =~ /(\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;
    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|Oracle)/ ) {
			for my $constraint ( $t1->get_constraints ) {
				next if $constraint->type ne FOREIGN_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, $case_insensitive );
        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%s%s;",
                $t1_name, $target_db =~ /Oracle/ ? '(' : '',
                $f1_name, $f1_type,
                ($f1_size && $f1_type !~ /(blob|text)$/) ? "($f1_size)" : '',
                !defined $f1_default ? ''
                	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
                	: " DEFAULT '$f1_default'",
                $f1_nullable ? '' : ' NOT NULL',
                $f1_auto_inc ? ' AUTO_INCREMENT' : '',
                $target_db =~ /Oracle/ ? ')' : '',
            );
            if ( $temp_default_value ) {
            	undef $f1_default;
	            push @diffs_table_adds, sprintf( <<END
DECLARE \@defname VARCHAR(100), \@cmd VARCHAR(1000)
SET \@defname = 
(SELECT name 
FROM sysobjects so JOIN sysconstraints sc
ON so.id = sc.constid 
WHERE object_name(so.parent_obj) = '%s' 
AND so.xtype = 'D'
AND sc.colid = 
 (SELECT colid FROM syscolumns 
 WHERE id = object_id('%s') AND 
 name = '%s'))
SET \@cmd = 'ALTER TABLE %s DROP CONSTRAINT '
+ \@defname
EXEC(\@cmd)
END
					, $t1_name, $t1_name, $f1_name, $t1_name,
	            );
            }
            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 timestamp 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%s%s;",
	                $t1_name, $target_db =~ /Oracle/ ? '(' : '',
	                $f1_name, $f1_type,
	                ($f1_size && $f1_type !~ /(blob|text)$/) ? "($f1_size)" : '',
	                !defined $f1_default ? ''
	                	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	                	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	                	: " DEFAULT '$f1_default'",
	                $f1_nullable ? '' : ' NOT NULL',
	                $f1_auto_inc ? ' AUTO_INCREMENT' : '',
	                $target_db =~ /Oracle/ ? ')' : '',
	            );
	            next;
        	}

			my $changeText = $target_db =~ /SQLServer/ ? 'ALTER COLUMN' :
				$target_db =~ /Oracle/ ? 'MODIFY (' : 'CHANGE';
			my $nullText = $f1_nullable ? '' : ' NOT NULL';
			$nullText = '' if $target_db =~ /Oracle/ && $f1_nullable == $f2_nullable;
            push @diffs_table_changes, sprintf( "ALTER TABLE %s %s %s%s %s%s%s%s%s%s;",
                $t1_name, $changeText,
                $f1_name, $target_db =~ /MySQL/ ? " $f1_name" : '',
                $f1_type, ($f1_size && $f1_type !~ /(blob|text)$/) ? "($f1_size)" : '',
                $nullText,
                !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' : '',
                $target_db =~ /Oracle/ ? ')' : '',
            );
            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(%checked_indices, @diffs_index_creates, @diffs_index_drops);
INDEX:
	for my $i1 ( $t1->get_indices ) {
		for my $i2 ( $t2->get_indices ) {
			if ( $i1->equals($i2, $case_insensitive) ) {
				$checked_indices{$i2} = 1;
				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),
            );
	}
INDEX2:
	for my $i2 ( $t2->get_indices ) {
		next if $checked_indices{$i2};
		for my $i1 ( $t1->get_indices ) {
			next INDEX2 if $i2->equals($i1, $case_insensitive);
		}
		$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(%checked_constraints, @diffs_constraint_drops);
CONSTRAINT:
	for my $c1 ( $t1->get_constraints ) {
		next if $source_db =~ /Oracle/ && $c1->type eq UNIQUE && $c1->name =~ /^SYS_/i;
		for my $c2 ( $t2->get_constraints ) {
			if ( $c1->equals($c2, $case_insensitive) ) {
				$checked_constraints{$c2} = 1;
				next CONSTRAINT;
			}
		}
		push @diffs_at_end, "ALTER TABLE $t1_name ADD ".
			constraint_to_string($c1, $source_schema).";";
	}
CONSTRAINT2:
	for my $c2 ( $t2->get_constraints ) {
		next if $checked_constraints{$c2};
		for my $c1 ( $t1->get_constraints ) {
			next CONSTRAINT2 if $c2->equals($c1, $case_insensitive);
		}
		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_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, "\n"
    );
    exit(1);
}
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->field_names or return '';

	if ( $c->type eq PRIMARY_KEY ) {
		if ( $target_db =~ /Oracle/ ) {
			return (defined $c->name ? 'CONSTRAINT '.$c->name.' ' : '') .
				'PRIMARY KEY (' . join(', ', @fields). ')';
		} else {
			return 'PRIMARY KEY (' . join(', ', @fields). ')';
		}
	}
	elsif ( $c->type eq UNIQUE ) {
		if ( $target_db =~ /Oracle/ ) {
			return (defined $c->name ? 'CONSTRAINT '.$c->name.' ' : '') .
				'UNIQUE (' . join(', ', @fields). ')';
		} else {
			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	# -------------------------------------------------------------------
ef45b16b	5	# $Id: sqlt-diff,v 1.12 2005-08-31 15:42:17 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 );
ef45b16b	100	$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\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;
e12ca55a	148	my $out = $t->translate( $file ) or die $tr->error;
	149	my $schema = $t->schema;
	150	unless ( $schema->name ) {
	151	$schema->name( $file );
	152	}
	153
	154	if ( $i == 1 ) {
942485ea	155	$source_schema = $schema;
942485ea	156	$source_db = $parser;
e12ca55a	157	}
e12ca55a	158	else {
942485ea	159	$target_schema = $schema;
942485ea	160	$target_db = $parser;
e12ca55a	161	}
942485ea	162	$i--;
e12ca55a	163	}
d71512a6	164	my $case_insensitive = $target_db =~ /SQLServer/;
e12ca55a	165
942485ea	166	my $s1_name = $source_schema->name;
942485ea	167	my $s2_name = $target_schema->name;
d71512a6	168	my ( @new_tables, @diffs , @diffs_at_end);
942485ea	169	for my $t1 ( $source_schema->get_tables ) {
942485ea	170	my $t1_name = $t1->name;
d71512a6	171	my $t2 = $target_schema->get_table( $t1_name, $case_insensitive );
942485ea	172
8b3b2f0c	173	warn "TABLE '$s1_name.$t1_name'\n" if $debug;
942485ea	174	unless ( $t2 ) {
8b3b2f0c	175	warn "Couldn't find table '$s1_name.$t1_name' in '$s2_name'\n"
8b3b2f0c	176	if $debug;
769601e9	177	if ( $target_db =~ /(SQLServer\|Oracle)/ ) {
d71512a6	178	for my $constraint ( $t1->get_constraints ) {
769601e9	179	next if $constraint->type ne FOREIGN_KEY;
d71512a6	180	push @diffs_at_end, "ALTER TABLE $t1_name ADD ".
	181	constraint_to_string($constraint, $source_schema).";";
	182	$t1->drop_constraint($constraint);
	183	}
	184	}
942485ea	185	push @new_tables, $t1;
	186	next;
	187	}
d71512a6	188
	189	# Go through our options
	190	my $options_different = 0;
	191	my %checkedOptions;
	192	OPTION:
	193	for my $t1_option_ref ( $t1->options ) {
	194	my($key1, $value1) = %{$t1_option_ref};
	195	for my $t2_option_ref ( $t2->options ) {
	196	my($key2, $value2) = %{$t2_option_ref};
	197	if ( $key1 eq $key2 ) {
	198	if ( defined $value1 != defined $value2 ) {
	199	$options_different = 1;
	200	last OPTION;
	201	}
	202	if ( defined $value1 && $value1 ne $value2 ) {
	203	$options_different = 1;
	204	last OPTION;
	205	}
	206	$checkedOptions{$key1} = 1;
	207	next OPTION;
	208	}
	209	}
	210	$options_different = 1;
	211	last OPTION;
	212	}
	213	# Go through the other table's options
	214	unless ( $options_different ) {
	215	for my $t2_option_ref ( $t2->options ) {
	216	my($key, $value) = %{$t2_option_ref};
	217	next if $checkedOptions{$key};
	218	$options_different = 1;
	219	last;
	220	}
	221	}
	222	# If there's a difference, just re-set all the options
	223	my @diffs_table_options;
	224	if ( $options_different ) {
	225	my @options = ();
	226	foreach my $option_ref ( $t1->options ) {
	227	my($key, $value) = %{$option_ref};
	228	push(@options, defined $value ? "$key=$value" : $key);
	229	}
	230	my $options = join(' ', @options);
	231	@diffs_table_options = ("ALTER TABLE $t1_name $options;");
	232	}
	233
942485ea	234	my $t2_name = $t2->name;
d71512a6	235	my(@diffs_table_adds, @diffs_table_changes);
942485ea	236	for my $t1_field ( $t1->get_fields ) {
afdf6a1c	237	my $f1_type = $t1_field->data_type;
	238	my $f1_size = $t1_field->size;
	239	my $f1_name = $t1_field->name;
d71512a6	240	my $f1_nullable = $t1_field->is_nullable;
	241	my $f1_default = $t1_field->default_value;
	242	my $f1_auto_inc = $t1_field->is_auto_increment;
3a7eb46e	243	my $t2_field = $t2->get_field( $f1_name, $case_insensitive );
942485ea	244	my $f1_full_name = "$s1_name.$t1_name.$t1_name";
8b3b2f0c	245	warn "FIELD '$f1_full_name'\n" if $debug;
e12ca55a	246
afdf6a1c	247	my $f2_full_name = "$s2_name.$t2_name.$f1_name";
e12ca55a	248
942485ea	249	unless ( $t2_field ) {
8b3b2f0c	250	warn "Couldn't find field '$f2_full_name' in '$t2_name'\n"
8b3b2f0c	251	if $debug;
d71512a6	252	my $temp_default_value = 0;
	253	if ( $target_db =~ /SQLServer/ && !$f1_nullable && !defined $f1_default ) {
	254	# SQL Server doesn't allow adding non-nullable, non-default columns
	255	# so we add it with a default value, then remove the default value
	256	$temp_default_value = 1;
	257	my(@numeric_types) = qw(decimal numeric float real int bigint smallint tinyint);
	258	$f1_default = grep($_ eq $f1_type, @numeric_types) ? 0 : '';
	259	}
769601e9	260	push @diffs_table_adds, sprintf( "ALTER TABLE %s ADD %s%s %s%s%s%s%s%s;",
	261	$t1_name, $target_db =~ /Oracle/ ? '(' : '',
	262	$f1_name, $f1_type,
d71512a6	263	($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
d71512a6	264	!defined $f1_default ? ''
	265	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	266	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	267	: " DEFAULT '$f1_default'",
769601e9	268	$f1_nullable ? '' : ' NOT NULL',
d71512a6	269	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
769601e9	270	$target_db =~ /Oracle/ ? ')' : '',
afdf6a1c	271	);
d71512a6	272	if ( $temp_default_value ) {
d71512a6	273	undef $f1_default;
568bf60a	274	push @diffs_table_adds, sprintf( <<END
	275	DECLARE \@defname VARCHAR(100), \@cmd VARCHAR(1000)
	276	SET \@defname =
	277	(SELECT name
	278	FROM sysobjects so JOIN sysconstraints sc
	279	ON so.id = sc.constid
	280	WHERE object_name(so.parent_obj) = '%s'
	281	AND so.xtype = 'D'
	282	AND sc.colid =
	283	(SELECT colid FROM syscolumns
	284	WHERE id = object_id('%s') AND
	285	name = '%s'))
	286	SET \@cmd = 'ALTER TABLE %s DROP CONSTRAINT '
	287	+ \@defname
	288	EXEC(\@cmd)
	289	END
	290	, $t1_name, $t1_name, $f1_name, $t1_name,
d71512a6	291	);
d71512a6	292	}
e12ca55a	293	next;
	294	}
	295
afdf6a1c	296	my $f2_type = $t2_field->data_type;
d71512a6	297	my $f2_size = $t2_field->size \|\| '';
	298	my $f2_nullable = $t2_field->is_nullable;
	299	my $f2_default = $t2_field->default_value;
	300	my $f2_auto_inc = $t2_field->is_auto_increment;
d71512a6	301	if ( !$t1_field->equals($t2_field, $case_insensitive) ) {
568bf60a	302	# SQLServer timestamp fields can't be altered, so we drop and add instead
d71512a6	303	if ( $target_db =~ /SQLServer/ && $f2_type eq "timestamp" ) {
d71512a6	304	push @diffs_table_changes, "ALTER TABLE $t1_name DROP COLUMN $f1_name;";
769601e9	305	push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD %s%s %s%s%s%s%s%s;",
	306	$t1_name, $target_db =~ /Oracle/ ? '(' : '',
	307	$f1_name, $f1_type,
d71512a6	308	($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
d71512a6	309	!defined $f1_default ? ''
	310	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	311	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	312	: " DEFAULT '$f1_default'",
769601e9	313	$f1_nullable ? '' : ' NOT NULL',
d71512a6	314	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
769601e9	315	$target_db =~ /Oracle/ ? ')' : '',
d71512a6	316	);
	317	next;
	318	}
769601e9	319
	320	my $changeText = $target_db =~ /SQLServer/ ? 'ALTER COLUMN' :
	321	$target_db =~ /Oracle/ ? 'MODIFY (' : 'CHANGE';
	322	my $nullText = $f1_nullable ? '' : ' NOT NULL';
	323	$nullText = '' if $target_db =~ /Oracle/ && $f1_nullable == $f2_nullable;
	324	push @diffs_table_changes, sprintf( "ALTER TABLE %s %s %s%s %s%s%s%s%s%s;",
	325	$t1_name, $changeText,
d71512a6	326	$f1_name, $target_db =~ /MySQL/ ? " $f1_name" : '',
d71512a6	327	$f1_type, ($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
769601e9	328	$nullText,
d71512a6	329	!defined $f1_default \|\| $target_db =~ /SQLServer/ ? ''
	330	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
	331	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
	332	: " DEFAULT '$f1_default'",
	333	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
769601e9	334	$target_db =~ /Oracle/ ? ')' : '',
afdf6a1c	335	);
d71512a6	336	if ( defined $f1_default && $target_db =~ /SQLServer/ ) {
	337	# Adding a column with a default value for SQL Server means adding a
	338	# constraint and setting existing NULLs to the default value
	339	push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD CONSTRAINT DF_%s_%s %s FOR %s;",
	340	$t1_name, $t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'DEFAULT NULL'
	341	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'DEFAULT CURRENT_TIMESTAMP'
	342	: "DEFAULT '$f1_default'", $f1_name,
	343	);
	344	push @diffs_table_changes, sprintf( "UPDATE %s SET %s = %s WHERE %s IS NULL;",
	345	$t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'NULL'
	346	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'CURRENT_TIMESTAMP'
	347	: "'$f1_default'", $f1_name,
	348	);
e12ca55a	349	}
	350	}
	351	}
d71512a6	352
568bf60a	353	my(%checked_indices, @diffs_index_creates, @diffs_index_drops);
d71512a6	354	INDEX:
d71512a6	355	for my $i1 ( $t1->get_indices ) {
568bf60a	356	for my $i2 ( $t2->get_indices ) {
d71512a6	357	if ( $i1->equals($i2, $case_insensitive) ) {
568bf60a	358	$checked_indices{$i2} = 1;
d71512a6	359	next INDEX;
	360	}
	361	}
	362	push @diffs_index_creates, sprintf(
942485ea	363	"CREATE %sINDEX%s ON %s (%s);",
d71512a6	364	$i1->type eq NORMAL ? '' : $i1->type." ",
d71512a6	365	$i1->name ? " ".$i1->name : '',
942485ea	366	$t1_name,
d71512a6	367	join(",", $i1->fields),
942485ea	368	);
d71512a6	369	}
568bf60a	370	INDEX2:
	371	for my $i2 ( $t2->get_indices ) {
	372	next if $checked_indices{$i2};
	373	for my $i1 ( $t1->get_indices ) {
	374	next INDEX2 if $i2->equals($i1, $case_insensitive);
	375	}
d71512a6	376	$target_db =~ /SQLServer/
	377	? push @diffs_index_drops, "DROP INDEX $t1_name.".$i2->name.";"
	378	: push @diffs_index_drops, "DROP INDEX ".$i2->name." on $t1_name;";
	379	}
	380
769601e9	381	my(%checked_constraints, @diffs_constraint_drops);
d71512a6	382	CONSTRAINT:
d71512a6	383	for my $c1 ( $t1->get_constraints ) {
769601e9	384	next if $source_db =~ /Oracle/ && $c1->type eq UNIQUE && $c1->name =~ /^SYS_/i;
568bf60a	385	for my $c2 ( $t2->get_constraints ) {
d71512a6	386	if ( $c1->equals($c2, $case_insensitive) ) {
568bf60a	387	$checked_constraints{$c2} = 1;
d71512a6	388	next CONSTRAINT;
	389	}
	390	}
769601e9	391	push @diffs_at_end, "ALTER TABLE $t1_name ADD ".
d71512a6	392	constraint_to_string($c1, $source_schema).";";
d71512a6	393	}
568bf60a	394	CONSTRAINT2:
	395	for my $c2 ( $t2->get_constraints ) {
	396	next if $checked_constraints{$c2};
	397	for my $c1 ( $t1->get_constraints ) {
	398	next CONSTRAINT2 if $c2->equals($c1, $case_insensitive);
	399	}
d71512a6	400	if ( $c2->type eq UNIQUE ) {
	401	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP INDEX ".
	402	$c2->name.";";
	403	} elsif ( $target_db =~ /SQLServer/ ) {
	404	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->name.";";
	405	} else {
	406	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->type.
	407	($c2->type eq FOREIGN_KEY ? " ".$c2->name : '').";";
	408	}
	409	}
	410
	411	push @diffs, @diffs_index_drops, @diffs_constraint_drops,
769601e9	412	@diffs_table_options, @diffs_table_adds,
769601e9	413	@diffs_table_changes, @diffs_index_creates;
942485ea	414	}
	415
	416	for my $t2 ( $target_schema->get_tables ) {
	417	my $t2_name = $t2->name;
d71512a6	418	my $t1 = $source_schema->get_table( $t2_name, $target_db =~ /SQLServer/ );
942485ea	419
942485ea	420	unless ( $t1 ) {
d71512a6	421	if ( $target_db =~ /SQLServer/ ) {
	422	for my $constraint ( $t2->get_constraints ) {
	423	next if $constraint->type eq PRIMARY_KEY;
	424	push @diffs, "ALTER TABLE $t2_name DROP ".$constraint->name.";";
	425	}
	426	}
	427	push @diffs_at_end, "DROP TABLE $t2_name;";
942485ea	428	next;
	429	}
	430
	431	for my $t2_field ( $t2->get_fields ) {
	432	my $f2_name = $t2_field->name;
	433	my $t1_field = $t1->get_field( $f2_name );
	434	unless ( $t1_field ) {
d71512a6	435	my $modifier = $target_db =~ /SQLServer/ ? "COLUMN " : '';
d71512a6	436	push @diffs, "ALTER TABLE $t2_name DROP $modifier$f2_name;";
942485ea	437	}
	438	}
	439	}
	440
	441	if ( @new_tables ) {
	442	my $dummy_tr = SQL::Translator->new;
	443	$dummy_tr->schema->add_table( $_ ) for @new_tables;
	444	my $producer = $dummy_tr->producer( $target_db );
	445	unshift @diffs, $producer->( $dummy_tr );
e12ca55a	446	}
d71512a6	447	push(@diffs, @diffs_at_end);
e12ca55a	448
e12ca55a	449	if ( @diffs ) {
942485ea	450	print join( "\n",
769601e9	451	"-- Convert schema '$s2_name' to '$s1_name':\n", @diffs, "\n"
942485ea	452	);
ef45b16b	453	exit(1);
e12ca55a	454	}
	455	else {
	456	print "There were no differences.\n";
	457	}
	458
d71512a6	459	sub constraint_to_string {
	460	my $c = shift;
	461	my $schema = shift or die "No schema given";
769601e9	462	my @fields = $c->field_names or return '';
d71512a6	463
d71512a6	464	if ( $c->type eq PRIMARY_KEY ) {
769601e9	465	if ( $target_db =~ /Oracle/ ) {
	466	return (defined $c->name ? 'CONSTRAINT '.$c->name.' ' : '') .
	467	'PRIMARY KEY (' . join(', ', @fields). ')';
	468	} else {
	469	return 'PRIMARY KEY (' . join(', ', @fields). ')';
	470	}
d71512a6	471	}
d71512a6	472	elsif ( $c->type eq UNIQUE ) {
769601e9	473	if ( $target_db =~ /Oracle/ ) {
	474	return (defined $c->name ? 'CONSTRAINT '.$c->name.' ' : '') .
	475	'UNIQUE (' . join(', ', @fields). ')';
	476	} else {
	477	return 'UNIQUE '.
	478	(defined $c->name ? $c->name.' ' : '').
	479	'(' . join(', ', @fields). ')';
	480	}
d71512a6	481	}
	482	elsif ( $c->type eq FOREIGN_KEY ) {
	483	my $def = join(' ',
	484	map { $_ \|\| () } 'CONSTRAINT', $c->name, 'FOREIGN KEY'
	485	);
	486
	487	$def .= ' (' . join( ', ', @fields ) . ')';
	488
	489	$def .= ' REFERENCES ' . $c->reference_table;
	490
	491	my @rfields = map { $_ \|\| () } $c->reference_fields;
	492	unless ( @rfields ) {
	493	my $rtable_name = $c->reference_table;
	494	if ( my $ref_table = $schema->get_table( $rtable_name ) ) {
	495	push @rfields, $ref_table->primary_key;
	496	}
	497	else {
	498	warn "Can't find reference table '$rtable_name' " .
	499	"in schema\n";
	500	}
	501	}
	502
	503	if ( @rfields ) {
	504	$def .= ' (' . join( ', ', @rfields ) . ')';
	505	}
	506	else {
	507	warn "FK constraint on " . 'some table' . '.' .
	508	join('', @fields) . " has no reference fields\n";
	509	}
	510
	511	if ( $c->match_type ) {
	512	$def .= ' MATCH ' .
	513	( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
	514	}
	515
	516	if ( $c->on_delete ) {
	517	$def .= ' ON DELETE '.join( ' ', $c->on_delete );
	518	}
	519
	520	if ( $c->on_update ) {
	521	$def .= ' ON UPDATE '.join( ' ', $c->on_update );
	522	}
	523
	524	return $def;
	525	}
	526	}
	527
e12ca55a	528	# -------------------------------------------------------------------
	529	# Bring out number weight & measure in a year of dearth.
	530	# William Blake
	531	# -------------------------------------------------------------------
	532
	533	=pod
	534
	535	=head1 AUTHOR
	536
	537	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
	538
	539	=head1 SEE ALSO
	540
	541	SQL::Translator, L<http://sqlfairy.sourceforge.net>.
	542
	543	=cut