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

#!/usr/bin/env perl
# 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 warnings;
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 Youens-Clark E<lt>kclark@cpan.orgE<gt>.

=head1 SEE ALSO

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

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