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

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

# -------------------------------------------------------------------
# Copyright (C) 2002-2009 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 = '1.59';

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 ) {
    if ( $source_db !~ /^(MySQL|SQLServer|Oracle)$/ ) {
        unshift(@diffs, "-- Target database $target_db is untested/unsupported!!!");
    }
}

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