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

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

# -------------------------------------------------------------------
# $Id$
# -------------------------------------------------------------------
# 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.99';

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	# -------------------------------------------------------------------
782b5a43	5	# $Id$
da5a1bae	6	# -------------------------------------------------------------------
478f608d	7	# Copyright (C) 2002-2009 The SQLFairy Authors
da5a1bae	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
	40	sqlt-diff [options] file_name1=parser file_name2=parser
	41
	42	Options:
	43
	44	-d\|--debug Show debugging info
	45
	46	=head1 DESCRIPTION
	47
	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.
88
89	=cut
90
91	# -------------------------------------------------------------------
92
93	use strict;
94	use Pod::Usage;
95	use Data::Dumper;
96	use SQL::Translator;
97	use SQL::Translator::Schema::Constants;
98
da06ac74	99	use vars qw( $VERSION );
	100	$VERSION = '1.99';
	101
da5a1bae	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;
	122	pod2usage('Please specify only two schemas to diff') if scalar @input > 2;
	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
	136	my ( $source_schema, $source_db, $target_schema, $target_db );
	137
	138	my $i = 2;
	139	for my $in ( @input ) {
	140	my $file = $in->{'file'};
	141	my $parser = $in->{'parser'};
	142
	143	die "Unable to read file '$file'\n" unless -r $file;
	144	die "'$parser' is an invalid parser\n" unless $valid_parsers{ $parser };
	145
	146	my $t = SQL::Translator->new;
	147	$t->debug( $debug );
	148	$t->parser( $parser ) 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 ) {
	156	$source_schema = $schema;
	157	$source_db = $parser;
	158	}
	159	else {
	160	$target_schema = $schema;
	161	$target_db = $parser;
	162	}
	163	$i--;
	164	}
	165	my $case_insensitive = $target_db =~ /SQLServer/;
166
167	my $s1_name = $source_schema->name;
168	my $s2_name = $target_schema->name;
169	my ( @new_tables, @diffs , @diffs_at_end);
170	for my $t1 ( $source_schema->get_tables ) {
171	my $t1_name = $t1->name;
172	my $t2 = $target_schema->get_table( $t1_name, $case_insensitive );
173
174	warn "TABLE '$s1_name.$t1_name'\n" if $debug;
175	unless ( $t2 ) {
176	warn "Couldn't find table '$s1_name.$t1_name' in '$s2_name'\n"
177	if $debug;
178	if ( $target_db =~ /(SQLServer\|Oracle)/ ) {
179	for my $constraint ( $t1->get_constraints ) {
180	next if $constraint->type ne FOREIGN_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	}
186	push @new_tables, $t1;
187	next;
188	}
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
235	my $t2_name = $t2->name;
236	my(@diffs_table_adds, @diffs_table_changes);
237	for my $t1_field ( $t1->get_fields ) {
238	my $f1_type = $t1_field->data_type;
239	my $f1_size = $t1_field->size;
240	my $f1_name = $t1_field->name;
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;
244	my $t2_field = $t2->get_field( $f1_name, $case_insensitive );
245	my $f1_full_name = "$s1_name.$t1_name.$t1_name";
246	warn "FIELD '$f1_full_name'\n" if $debug;
247
248	my $f2_full_name = "$s2_name.$t2_name.$f1_name";
249
250	unless ( $t2_field ) {
251	warn "Couldn't find field '$f2_full_name' in '$t2_name'\n"
252	if $debug;
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%s%s;",
262	$t1_name, $target_db =~ /Oracle/ ? '(' : '',
263	$f1_name, $f1_type,
264	($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
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_nullable ? '' : ' NOT NULL',
270	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
271	$target_db =~ /Oracle/ ? ')' : '',
272	);
273	if ( $temp_default_value ) {
274	undef $f1_default;
275	push @diffs_table_adds, sprintf( <<END
276	DECLARE \@defname VARCHAR(100), \@cmd VARCHAR(1000)
277	SET \@defname =
278	(SELECT name
279	FROM sysobjects so JOIN sysconstraints sc
280	ON so.id = sc.constid
281	WHERE object_name(so.parent_obj) = '%s'
282	AND so.xtype = 'D'
283	AND sc.colid =
284	(SELECT colid FROM syscolumns
285	WHERE id = object_id('%s') AND
286	name = '%s'))
287	SET \@cmd = 'ALTER TABLE %s DROP CONSTRAINT '
288	+ \@defname
289	EXEC(\@cmd)
290	END
291	, $t1_name, $t1_name, $f1_name, $t1_name,
292	);
293	}
294	next;
295	}
296
297	my $f2_type = $t2_field->data_type;
298	my $f2_size = $t2_field->size \|\| '';
299	my $f2_nullable = $t2_field->is_nullable;
300	my $f2_default = $t2_field->default_value;
301	my $f2_auto_inc = $t2_field->is_auto_increment;
302	if ( !$t1_field->equals($t2_field, $case_insensitive) ) {
303	# SQLServer timestamp fields can't be altered, so we drop and add instead
304	if ( $target_db =~ /SQLServer/ && $f2_type eq "timestamp" ) {
305	push @diffs_table_changes, "ALTER TABLE $t1_name DROP COLUMN $f1_name;";
306	push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD %s%s %s%s%s%s%s%s;",
307	$t1_name, $target_db =~ /Oracle/ ? '(' : '',
308	$f1_name, $f1_type,
309	($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
310	!defined $f1_default ? ''
311	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
312	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
313	: " DEFAULT '$f1_default'",
314	$f1_nullable ? '' : ' NOT NULL',
315	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
316	$target_db =~ /Oracle/ ? ')' : '',
317	);
318	next;
319	}
320
321	my $changeText = $target_db =~ /SQLServer/ ? 'ALTER COLUMN' :
322	$target_db =~ /Oracle/ ? 'MODIFY (' : 'CHANGE';
323	my $nullText = $f1_nullable ? '' : ' NOT NULL';
324	$nullText = '' if $target_db =~ /Oracle/ && $f1_nullable == $f2_nullable;
325	push @diffs_table_changes, sprintf( "ALTER TABLE %s %s %s%s %s%s%s%s%s%s;",
326	$t1_name, $changeText,
327	$f1_name, $target_db =~ /MySQL/ ? " $f1_name" : '',
328	$f1_type, ($f1_size && $f1_type !~ /(blob\|text)$/) ? "($f1_size)" : '',
329	$nullText,
330	!defined $f1_default \|\| $target_db =~ /SQLServer/ ? ''
331	: uc $f1_default eq 'NULL' ? ' DEFAULT NULL'
332	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? ' DEFAULT CURRENT_TIMESTAMP'
333	: " DEFAULT '$f1_default'",
334	$f1_auto_inc ? ' AUTO_INCREMENT' : '',
335	$target_db =~ /Oracle/ ? ')' : '',
336	);
337	if ( defined $f1_default && $target_db =~ /SQLServer/ ) {
338	# Adding a column with a default value for SQL Server means adding a
339	# constraint and setting existing NULLs to the default value
340	push @diffs_table_changes, sprintf( "ALTER TABLE %s ADD CONSTRAINT DF_%s_%s %s FOR %s;",
341	$t1_name, $t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'DEFAULT NULL'
342	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'DEFAULT CURRENT_TIMESTAMP'
343	: "DEFAULT '$f1_default'", $f1_name,
344	);
345	push @diffs_table_changes, sprintf( "UPDATE %s SET %s = %s WHERE %s IS NULL;",
346	$t1_name, $f1_name, uc $f1_default eq 'NULL' ? 'NULL'
347	: uc $f1_default eq 'CURRENT_TIMESTAMP' ? 'CURRENT_TIMESTAMP'
348	: "'$f1_default'", $f1_name,
349	);
350	}
351	}
352	}
353
354	my(%checked_indices, @diffs_index_creates, @diffs_index_drops);
355	INDEX:
356	for my $i1 ( $t1->get_indices ) {
357	for my $i2 ( $t2->get_indices ) {
358	if ( $i1->equals($i2, $case_insensitive) ) {
359	$checked_indices{$i2} = 1;
360	next INDEX;
361	}
362	}
363	push @diffs_index_creates, sprintf(
364	"CREATE %sINDEX%s ON %s (%s);",
365	$i1->type eq NORMAL ? '' : $i1->type." ",
366	$i1->name ? " ".$i1->name : '',
367	$t1_name,
368	join(",", $i1->fields),
369	);
370	}
371	INDEX2:
372	for my $i2 ( $t2->get_indices ) {
373	next if $checked_indices{$i2};
374	for my $i1 ( $t1->get_indices ) {
375	next INDEX2 if $i2->equals($i1, $case_insensitive);
376	}
377	$target_db =~ /SQLServer/
378	? push @diffs_index_drops, "DROP INDEX $t1_name.".$i2->name.";"
379	: push @diffs_index_drops, "DROP INDEX ".$i2->name." on $t1_name;";
380	}
381
382	my(%checked_constraints, @diffs_constraint_drops);
383	CONSTRAINT:
384	for my $c1 ( $t1->get_constraints ) {
385	next if $source_db =~ /Oracle/ && $c1->type eq UNIQUE && $c1->name =~ /^SYS_/i;
386	for my $c2 ( $t2->get_constraints ) {
387	if ( $c1->equals($c2, $case_insensitive) ) {
388	$checked_constraints{$c2} = 1;
389	next CONSTRAINT;
390	}
391	}
392	push @diffs_at_end, "ALTER TABLE $t1_name ADD ".
393	constraint_to_string($c1, $source_schema).";";
394	}
395	CONSTRAINT2:
396	for my $c2 ( $t2->get_constraints ) {
397	next if $checked_constraints{$c2};
398	for my $c1 ( $t1->get_constraints ) {
399	next CONSTRAINT2 if $c2->equals($c1, $case_insensitive);
400	}
401	if ( $c2->type eq UNIQUE ) {
402	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP INDEX ".
403	$c2->name.";";
404	} elsif ( $target_db =~ /SQLServer/ ) {
405	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->name.";";
406	} else {
407	push @diffs_constraint_drops, "ALTER TABLE $t1_name DROP ".$c2->type.
408	($c2->type eq FOREIGN_KEY ? " ".$c2->name : '').";";
409	}
410	}
411
412	push @diffs, @diffs_index_drops, @diffs_constraint_drops,
413	@diffs_table_options, @diffs_table_adds,
414	@diffs_table_changes, @diffs_index_creates;
415	}
416
417	for my $t2 ( $target_schema->get_tables ) {
418	my $t2_name = $t2->name;
419	my $t1 = $source_schema->get_table( $t2_name, $target_db =~ /SQLServer/ );
420
421	unless ( $t1 ) {
422	if ( $target_db =~ /SQLServer/ ) {
423	for my $constraint ( $t2->get_constraints ) {
424	next if $constraint->type eq PRIMARY_KEY;
425	push @diffs, "ALTER TABLE $t2_name DROP ".$constraint->name.";";
426	}
427	}
428	push @diffs_at_end, "DROP TABLE $t2_name;";
429	next;
430	}
431
432	for my $t2_field ( $t2->get_fields ) {
433	my $f2_name = $t2_field->name;
434	my $t1_field = $t1->get_field( $f2_name );
435	unless ( $t1_field ) {
436	my $modifier = $target_db =~ /SQLServer/ ? "COLUMN " : '';
437	push @diffs, "ALTER TABLE $t2_name DROP $modifier$f2_name;";
438	}
439	}
440	}
441
442	if ( @new_tables ) {
443	my $dummy_tr = SQL::Translator->new;
444	$dummy_tr->schema->add_table( $_ ) for @new_tables;
445	my $producer = $dummy_tr->producer( $target_db );
446	unshift @diffs, $producer->( $dummy_tr );
447	}
448	push(@diffs, @diffs_at_end);
449
450	if ( @diffs ) {
451	if ( $source_db !~ /^(MySQL\|SQLServer\|Oracle)$/ ) {
452	unshift(@diffs, "-- Target database $target_db is untested/unsupported!!!");
453	}
454	}
455
456	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";
457
458	if ( @diffs ) {
459	print join( "\n",
460	"-- Convert schema '$s2_name' to '$s1_name':\n", @diffs, "\n"
461	);
462	exit(1);
463	}
464	else {
465	print "There were no differences.\n";
466	}
467
468	sub constraint_to_string {
469	my $c = shift;
470	my $schema = shift or die "No schema given";
471	my @fields = $c->field_names or return '';
472
473	if ( $c->type eq PRIMARY_KEY ) {
474	if ( $target_db =~ /Oracle/ ) {
475	return (defined $c->name ? 'CONSTRAINT '.$c->name.' ' : '') .
476	'PRIMARY KEY (' . join(', ', @fields). ')';
477	} else {
478	return 'PRIMARY KEY (' . join(', ', @fields). ')';
479	}
480	}
481	elsif ( $c->type eq UNIQUE ) {
482	if ( $target_db =~ /Oracle/ ) {
483	return (defined $c->name ? 'CONSTRAINT '.$c->name.' ' : '') .
484	'UNIQUE (' . join(', ', @fields). ')';
485	} else {
486	return 'UNIQUE '.
487	(defined $c->name ? $c->name.' ' : '').
488	'(' . join(', ', @fields). ')';
489	}
490	}
491	elsif ( $c->type eq FOREIGN_KEY ) {
492	my $def = join(' ',
493	map { $_ \|\| () } 'CONSTRAINT', $c->name, 'FOREIGN KEY'
494	);
495
496	$def .= ' (' . join( ', ', @fields ) . ')';
497
498	$def .= ' REFERENCES ' . $c->reference_table;
499
500	my @rfields = map { $_ \|\| () } $c->reference_fields;
501	unless ( @rfields ) {
502	my $rtable_name = $c->reference_table;
503	if ( my $ref_table = $schema->get_table( $rtable_name ) ) {
504	push @rfields, $ref_table->primary_key;
505	}
506	else {
507	warn "Can't find reference table '$rtable_name' " .
508	"in schema\n";
509	}
510	}
511
512	if ( @rfields ) {
513	$def .= ' (' . join( ', ', @rfields ) . ')';
514	}
515	else {
516	warn "FK constraint on " . 'some table' . '.' .
517	join('', @fields) . " has no reference fields\n";
518	}
519
520	if ( $c->match_type ) {
521	$def .= ' MATCH ' .
522	( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
523	}
524
525	if ( $c->on_delete ) {
526	$def .= ' ON DELETE '.join( ' ', $c->on_delete );
527	}
528
529	if ( $c->on_update ) {
530	$def .= ' ON UPDATE '.join( ' ', $c->on_update );
531	}
532
533	return $def;
534	}
535	}
536
537	# -------------------------------------------------------------------
538	# Bring out number weight & measure in a year of dearth.
539	# William Blake
540	# -------------------------------------------------------------------
541
542	=pod
543
544	=head1 AUTHOR
545
546	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
547
548	=head1 SEE ALSO
549
550	SQL::Translator, L<http://sqlfairy.sourceforge.net>.
551
552	=cut