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

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

# -------------------------------------------------------------------
# $Id: sqlt-diff-old 1440 2009-01-17 16:31:57Z jawnsy $
# -------------------------------------------------------------------
# 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;

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