[dbsrgits/SQL-Translator.git] / script / 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., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 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.62';

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;
pod2usage('No input') if !@input;

if ( my $interactive = -t STDIN && -t STDOUT ) {
    print STDERR join("\n",
        "sqlt-diff-old is deprecated. Please sqlt-diff, and tell us ",
        "about any problems or patch SQL::Translator::Diff",
        '',
    );
}

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!!!");
    }
}

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