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

#!/usr/bin/env perl
# vim: set ft=perl:

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