#!/usr/bin/perl

#
# This script compares two RPS databases, and produces a report describing how
# they differ.
#
# The report can be in two different formats:
#  -r : produces a 'regular', english report
#  -a : produces a set of SQL statements that, if executed, would transform the second
#       database's schema to match the first database.
#
# It can also optionally modify regular keys to UNIQUE keys when specified by the updated
# schema. Note that this may fail for pre-existing fields that have duplicate values
# for the key. Should be a pretty one-off thing.
#  -u : upgrade KEYs to UNIQUE KEYs
#

use strict;
use Data::Dumper;
use Getopt::Std;

use lib '/app/tools/common/lib';
use Common::RSDB;

my @alters;
my $gReport            = 0;
my $gAlter             = 1;
my $gUpgradeUniqueKeys = 0;
my $gDebug             = 0;
my $gDropTables        = 0;

my %opt;
getopts( 'r:a:u:d', \%opt );

if ( defined $opt{r} ) {
    $gReport = $opt{r};
}

if ( defined $opt{a} ) {
    $gAlter = $opt{a};
}

if ( defined $opt{u} ) {
    $gUpgradeUniqueKeys = $opt{u};
}

if ( defined $opt{d} ) {
    $gDebug = 1;
}

if ( defined $opt{t} ) {
    $gDropTables = $opt{t};
}

my $db1Name = $ARGV[0];
my $db2Name = $ARGV[1];
if ( !$db1Name || !$db2Name ) {
    _usage();
}

my $schema1 = _getSchema($db1Name);
my $schema2 = _getSchema($db2Name);

_diffSchemas( $schema1, $schema2 );

if ($gAlter) {
    print "--\n";
    print "-- ALTERS to bring $db2Name in sync with $db1Name\n";
    print "--\n\n";
    print "USE $db2Name ;\n\n";
    foreach my $alter (@alters) {
        print $alter . "\n";
    }
}

# ----------------------------------------

sub _usage {
    print "This program compares the schemas of two databases.\n";
    print "USAGE:\n";
    print "$0 [-r] [-a] [-u] [-d] DATABASE1 DATABASE2\n";
    print " (note - the '-' switches are boolean flags. Pass '1' to enable, '0' to disable)\n";
    print " -a : output SQL statements necessary to make DATABASE2 look like DATABASE1 (default)\n";
    print " -r : print a report detailing the differences\n";
    print " -u : upgrade regular KEYs to UNIQUE KEYs as specified in DATABASE1\n";
    print " -d : produce debugging output: verbose and messy\n";

    exit(1);
}

sub _getSchema {
    my ($name) = @_;

    # See if this is a filename (rather than a database name)
    #
    my $lines;
    if ( $name =~ m/FILE:\/\/(.*)/ ) {
        $lines = _getLinesFromFile($1);
    } else {
        $lines = _getLinesFromDB($name);
    }

    my %schema;
    $schema{_dbName} = $name;

    # This parser uses a little 'state machine'.
    # We start out in the 'looking for table' state.
    # Once we find the start of a table definition, we transition into
    # the 'reading table' state.  Then back to 'looking for table' once
    # we hit the end of the table definition block.
    #
    my $kLookingForTable = 0;
    my $kReadingTable    = 1;

    my $colIndex = 0;
    my $i        = 0;
    my $state    = $kLookingForTable;
    my $currentTable;
    for ( my $i = 0 ; $i < scalar @$lines ; $i++ ) {
        my $line = $lines->[$i];
        chomp $line;

        if ( ',' eq substr( $line, -1 ) ) {
            substr( $line, -1 ) = '';
        }

        if ( $kLookingForTable == $state ) {
            next unless $line =~ m/CREATE TABLE/;

            $line =~ m/\`(.*)\`/;
            $currentTable = _trimSpaces($1);
            $state        = $kReadingTable;
            $colIndex     = 0;
            next;
        }

        if ( $kReadingTable eq $state ) {
            if ( $line =~ m/\)(.*)\;/ ) {
                $schema{$currentTable}{_settings} = _trimSpaces($1);
                $state = $kLookingForTable;
                next;
            }

            if ( $line =~ m/PRIMARY\s+KEY/ ) {
                $line =~ m/\((.*)\)/;
                $schema{$currentTable}{_keys}{_primaryKey} = _trimSpaces($1);
                next;
            }

            if ( $line =~ m/FULLTEXT\s+KEY/ ) {
                $line =~ m/\`(.*)\` \((.*)\)/;
                $schema{$currentTable}{_fullTextKeys}{ _trimSpaces($1) } = _trimSpaces($2);
                $schema{$currentTable}{_keys}{ _trimSpaces($1) }         = _trimSpaces($2);
                next;
            }

            if ( $line =~ m/UNIQUE\s+KEY/ ) {
                $line =~ m/\`(.*)\` \((.*)\)/;
                $schema{$currentTable}{_uniqueKeys}{ _trimSpaces($1) } = _trimSpaces($2);
                $schema{$currentTable}{_keys}{ _trimSpaces($1) }       = _trimSpaces($2);
                next;
            }

            if ( $line =~ m/KEY/ ) {
                $line =~ m/\`(.*)\` \((.*)\)/;
                $schema{$currentTable}{_keys}{ _trimSpaces($1) } = _trimSpaces($2);
                next;
            }

            # Strip off any trailing comments
            $line =~ s/\s*--.*//g if ($line);

            # Column definition
            if ( $line =~ m/\`(.*)\`(.*)/ ) {
                $schema{$currentTable}{ _trimSpaces($1) } = _trimSpaces($2);
                $schema{$currentTable}{_order}{$colIndex} = _trimSpaces($1);
                $colIndex++;
            }

            # Ignore all other lines

            next;
        }
    }

    return \%schema;
}

sub _getLinesFromFile {
    my ($path) = @_;
    die "ERROR : $path does not exist\n"                   unless -e $path;
    die "ERROR : $path does not point to a regular file\n" unless -f $path;

    my @lines;
    open SCHEMA, $path or die "ERROR : could not open file $path for reading: $!\n";
    while ( my $line = <SCHEMA> ) {
        chomp $line;
        push @lines, _cleanLine($line);
    }

    return \@lines;
}

sub _getLinesFromDB {
    my ($name) = @_;

    my $clientID = Common::RSDB::DBNameToClientID($name);
    die "ERROR - cannot find database to match $name" unless $clientID;

    my $dbData = $Common::RSDB::CLIENT_DB{$clientID};
    die "ERROR - could not look up record with id $clientID" unless $dbData;

    my $user     = $dbData->{username};
    my $password = $dbData->{password};
    my $server   = $dbData->{server};

    #    my $dump = `mysqldump -uroot -d $name`;
    my $dump = `mysqldump -u$user -p$password -h$server -d $name`;

    if ($gDebug) {
        print "$dump\n";
    }

    my @nonCleanLines = split( "\n", $dump );
    my @lines;
    foreach my $line (@nonCleanLines) {
        push @lines, _cleanLine($line);
    }

    return \@lines;
}

sub _cleanLine {
    my ($inLine) = @_;

    my $kReadingChar         = 0;
    my $kReadingQuotedPhrase = 1;
    my $kReadingWhiteSpace   = 2;

    # I want to get rid of extraneous spaces, so that trivial differences in
    # white space won't make a difference.
    #
    my @chars = split( //, $inLine );
    my @newChars;
    my $state = $kReadingChar;
    for ( my $i = 0 ; $i < scalar @chars ; $i++ ) {
        if ( $kReadingWhiteSpace == $state ) {

            # skip over extra white space
            #
            if ( _isWhiteSpace( $chars[$i] ) ) {
                next;
            }
            $state = $kReadingChar;
        }

        if ( $kReadingChar == $state ) {
            push @newChars, $chars[$i];
            if ( _isQuote( $chars[$i] ) ) {
                $state = $kReadingQuotedPhrase;
            } elsif ( _isWhiteSpace( $chars[$i] ) ) {
                $state = $kReadingWhiteSpace;
            } elsif ( ',' eq $chars[$i] ) {
                $state = $kReadingWhiteSpace;
            }
        } elsif ( $kReadingQuotedPhrase == $state ) {
            push @newChars, $chars[$i];

            # assuming no nested quotes...
            #
            if ( _isQuote( $chars[$i] ) ) {
                $state = $kReadingChar;
            }
        }
    }

    my $outLine = join( "", @newChars );
    return $outLine;
}

sub _isWhiteSpace {
    my ($c) = @_;
    return 1 if ( $c eq ' ' );
    return 0;
}

sub _isQuote {
    my ($c) = @_;
    return 1 if $c eq '\`';
    return 1 if $c eq '\'';
    return 1 if $c eq '\"';
    return 0;
}

sub _diffSchemas {
    my ( $schema1, $schema2 ) = @_;

    # First, see if either schema contains a table the other does not.
    #
    my @commonTables = _findCommonTables( $schema1, $schema2 );

    # Now compare the columns and keys in each common table.
    #
    foreach my $tableName (@commonTables) {
        _compareTable( $tableName, $schema1, $schema2 );
    }
}

sub _findCommonTables {
    my ( $schema1, $schema2 ) = @_;

    my %inBoth;
    foreach my $tableName ( sort keys %$schema1 ) {
        next if ( '_' eq substr( $tableName, 0, 1 ) );

        if ( exists $schema2->{$tableName} ) {
            $inBoth{$tableName} = 1;
        } else {
            _report( $schema2->{_dbName} . " missing table $tableName\n" );
            _addTable( $schema1, $tableName );
        }
    }
    foreach my $tableName ( sort keys %$schema2 ) {
        next if ( '_' eq substr( $tableName, 0, 1 ) );

        if ( exists $schema1->{$tableName} ) {
            $inBoth{$tableName} = 1;
        } else {
            _report( $schema1->{_dbName} . " missing table $tableName\n" );

            if ($gDropTables) {
                _alter("DROP TABLE $tableName ;");
            }
        }
    }

    return sort keys %inBoth;
}

sub _compareTable {
    my ( $tableName, $schema1, $schema2 ) = @_;

    _report("\n-------- $tableName --------\n");

    my $padding = _max( length( $schema1->{_dbName} ), length( $schema2->{_dbName} ) ) + 1;

    my $table1 = $schema1->{$tableName};
    my $table2 = $schema2->{$tableName};

    # Iterate over the fields in the first table, and compare with the second.
    # We are looking for:
    # - fields that have been added
    # - fields that have been deleted
    # - fields that have been moved
    # - fields that have been renamed
    # So, the basic strategy is to first detect when there is a difference.
    # If there is a difference, is it simply a rename?
    #  If not, then is it a moved field?
    #    If not, then is this a new field?
    #      If not, then should we delete the old field?
    #
    # What if a field is renamed _and_ moved?  That seems rather hard to unambiguously detect.
    # - but, it may be possible.  If a field is missing, and there is a field with the same
    #   definition in the second table that does not exist in the first, we can perhaps assume this
    #   has been renamed and moved.
    #
    # If a field in a particular position has a diferrent name and a different definition, and none of
    # the other conditions are satisfied, then we can just alter 1 into the other, and let the database
    # do its best to convert the data.
    #

    # I am going to want to keep track of columns that I have already dealt with.
    # (by index).
    #
    my %touchedColumns;

    my $orderHash1 = $table1->{_order};
    my $orderHash2 = $table2->{_order};

    my $numColsTable1 = scalar keys %$orderHash1;

    my $i;
    for ( $i = 0 ; $i < $numColsTable1 ; $i++ ) {
        _debugPrintHash( "orderHash1: ", $orderHash1 );
        _debugPrintHash( "orderHash2: ", $orderHash2 );

        my $col1 = $orderHash1->{$i};
        my $col2 = $orderHash2->{$i};

        _report("!!! i = $i  col1 = $col1  col2 = $col2\n");

        # If table2 does not even have a column in this slot (we've run off the end),
        # then just add it.
        #
        if ( !defined $col2 ) {
            _report( $schema2->{_dbName} . " missing column $col1\n" );
            _alter( "ALTER TABLE $tableName ADD COLUMN $col1 " . $table1->{$col1} . " ;" );

            # !!! I don't really need to modify my schema structure anymore - from this point
            # !!! forward, any columns in table 1 will be brand new to table 2.
            #
            next;
        }

        # Do they have different names?
        #
        if ( $col1 ne $col2 ) {

            #  Does this column exist elsewhere in table2?
            #
            if ( exists $table2->{$col1} ) {
                _moveColumn( $i, $tableName, $schema1, $schema2, $table1, $table2, $orderHash1, $orderHash2, $col1, $col2 );
                next;
            }

            # Does the column in table2 exist elsewhere in table1?
            #
            if ( exists $table1->{$col2} ) {
                _insertColumn( $i, $tableName, $schema1, $schema2, $table1, $table2, $orderHash1, $orderHash2, $col1, $col2 );
                next;
            }

            # This is a rename/redefine.
            #
            _redefineColumn( $i, $tableName, $schema1, $schema2, $table1, $table2, $orderHash1, $orderHash2, $col1, $col2 );
            next;
        }

        # Do they have different definitions?
        #
        if ( lc( $table1->{$col1} ) ne lc( $table2->{$col1} ) ) {
            _redefineColumn( $i, $tableName, $schema1, $schema2, $table1, $table2, $orderHash1, $orderHash2, $col1, $col2 );
            next;
        }

        # They are identical. Nothing to do.
        #
    }

    # Any remaining columns in table2 should be deleted.
    #

    my $numColsTable2 = scalar keys %$orderHash2;

    for ( my $j = $i ; $j < $numColsTable2 ; $j++ ) {
        my $col2 = $orderHash2->{$j};
        _deleteColumn( $i, $tableName, $schema2, $table2, $orderHash2, $col2 );
    }

    # Now compare the keys.
    #
    my %sharedKeys;
    foreach my $key ( sort keys %{ $table1->{_keys} } ) {
        if ( exists $table2->{_keys}{$key} ) {
            $sharedKeys{$key} = 1;
        } else {
            _report( $schema2->{_dbName} . " missing key $key\n" );

            if ( '_primaryKey' eq $key ) {
                _alter( "ALTER TABLE $tableName ADD PRIMARY KEY (" . $table1->{_keys}{$key} . ") ;" );
            } else {
                my $keyType = 'KEY';
                if ( $table1->{_fullTextKeys}{$key} ) {
                    $keyType = 'FULLTEXT KEY';
                } elsif ( $table1->{_uniqueKeys}{$key} ) {
                    $keyType = 'UNIQUE KEY';
                }
                _alter( "ALTER TABLE $tableName ADD $keyType \`$key\` (" . $table1->{_keys}{$key} . ") ;" );
            }
        }
    }

    foreach my $key ( sort keys %{ $table2->{_keys} } ) {
        if ( exists $table1->{_keys}{$key} ) {
            $sharedKeys{$key} = 1;
        } else {
            _report( $schema1->{_dbName} . " missing key $key\n" );
            if ( '_primaryKey' eq $key ) {
                _alter("ALTER TABLE $tableName DROP PRIMARY KEY ;");
            } else {
                _alter("ALTER TABLE $tableName DROP KEY \`$key\` ;");
            }
        }
    }

    foreach my $key ( sort keys %sharedKeys ) {
        my $keyType = $table1->{_fullTextKeys}{$key} ? 'FULLTEXT KEY' : $table1->{_uniqueKeys}{$key} ? 'UNIQUE KEY' : 'KEY';
        if ( $table1->{_keys}{$key} ne $table2->{_keys}{$key} ) {
            if ( '_primaryKey' eq $key ) {
                _report("PRIMARY KEY:\n");
                _alter("ALTER TABLE $tableName DROP PRIMARY KEY ;");
                _alter( "ALTER TABLE $tableName ADD PRIMARY KEY (" . $table1->{_keys}{$key} . ") ;" );
            } else {
                _report("$keyType $key\n");
                _alter("ALTER TABLE $tableName DROP KEY \`$key\` ;");
                _alter( "ALTER TABLE $tableName ADD $keyType \`$key\` (" . $table1->{_keys}{$key} . ") ;" );
            }
            _report("\t"
                  . _paddedString( $schema1->{_dbName}, $padding ) . ":"
                  . $table1->{_keys}{$key} . "\n\t"
                  . _paddedString( $schema2->{_dbName}, $padding ) . ":"
                  . $table2->{_keys}{$key}
                  . "\n" );
        } else {
            my $oldType = $table2->{_fullTextKeys}{$key} ? 'FULLTEXT KEY' : $table2->{_uniqueKeys}{$key} ? 'UNIQUE KEY' : 'KEY';
            if ( $oldType ne $keyType ) {
                if ( $keyType ne 'UNIQUE KEY' || $gUpgradeUniqueKeys ) {
                    _report("Old: $oldType New: $keyType $key");
                    _alter("ALTER TABLE $tableName DROP KEY \`$key\` ;");
                    _alter( "ALTER TABLE $tableName ADD $keyType \`$key\` (" . $table1->{_keys}{$key} . ") ;" );
                    _report( "\t" . _paddedString( $schema1->{_dbName}, $padding ) . ":" . $table1->{_keys}{$key} . "\n" );
                }
            }
        }
    }

    # Now see if the table settings (i.e. the last line in the table definition) match.
    # !!! Since we can't actually modify this with an alter in a consistant way, let's not bother.
    #
    #    if ($table1->{_settings} ne $table2->{_settings})
    #    {
    #        _report("TABLE SETTINGS: " . $table1->{_settings} . " : " . $table2->{_settings});
    #        _alter("ALTER TABLE $tableName " . $table1->{_settings} . " ;");
    #    }
}

sub _paddedString {
    my ( $string, $size ) = @_;

    my $outString = $string . ( ' ' x ( $size - length($string) ) );
    return $outString;
}

sub _max {
    my ( $val1, $val2 ) = @_;

    return ( $val1 > $val2 ? $val1 : $val2 );
}

sub _report {
    my ($string) = @_;

    if ($gReport) {
        print $string;
    }
}

sub _alter {
    my ($alter) = @_;

    if ($gAlter) {
        push @alters, $alter;
    }
}

sub _addTable {
    my ( $schema, $tableName ) = @_;

    _alter("CREATE TABLE \`$tableName\` (");

    my $table = $schema->{$tableName};

    # columns first
    #
    my @columns;

    # need to coerce these to a numerical sort order
    foreach my $order ( sort { $a <=> $b } keys %{ $table->{_order} } ) {
        my $column = $table->{_order}{$order};
        my $colDef = $table->{$column};
        my $alter  = "\`$column\` $colDef";
        push @columns, $alter;

        #
        # By including the ',' here, we screw up the syntax if there are no keys...
        # We'll use the same logic we used below for the keys.

        #        _alter($alter);
    }

    # Let's go ahead and do the keys now, so that we'll know whether or not
    # we need a comma after the last column definition.
    my @keys;
    foreach my $key ( keys %{ $table->{_keys} } ) {
        my $def = $table->{_keys}{$key};
        if ( '_primaryKey' eq $key ) {
            push @keys, "PRIMARY KEY ($def)";
        } else {
            my $keyType = 'KEY';
            if ( $table->{_fullTextKeys}{$key} ) {
                $keyType = 'FULLTEXT KEY';
            } elsif ( $table->{_uniqueKeys}{$key} ) {
                $keyType = 'UNIQUE KEY';
            }
            push @keys, "$keyType \`$key\` ($def)";
        }
    }

    for ( my $i = 0 ; $i < scalar @columns ; $i++ ) {
        my $alter = $columns[$i];

        if ( ( scalar @keys ) > 0 || $i < ( ( scalar @columns ) - 1 ) ) {
            $alter .= ',';
        }
        _alter($alter);
    }

    for ( my $i = 0 ; $i < scalar @keys ; $i++ ) {
        my $alter = $keys[$i];

        if ( $i < ( ( scalar @keys ) - 1 ) ) {
            $alter .= ',';
        }
        _alter($alter);
    }

    _alter(") ENGINE=MyISAM DEFAULT CHARSET=utf8;\n");
}

sub _moveColumn {
    my ( $i, $tableName, $schema1, $schema2, $table1, $table2, $orderHash1, $orderHash2, $col1, $col2 ) = @_;

    # We want to _move_ this column, possibly re-defining it as well.
    #
    my $moveTo;
    if ( 0 == $i ) {
        $moveTo = 'FIRST';
    } else {
        my $lastIndex = $i - 1;
        $moveTo = 'AFTER ' . $orderHash1->{$lastIndex};
    }
    _report( $schema2->{_dbName} . " moving column $col1 to $moveTo\n" );
    _alter( "ALTER TABLE $tableName MODIFY COLUMN $col1 " . $table1->{$col1} . " $moveTo ;" );

    # Update our internal data structure to reflect this change.
    #
    $table2->{$col1} = $table1->{$col1};

    # Need to adjust table 2's order hash as well.
    # I need to shift everything above the column's old position down 1 slot.
    #
    # So, first find the old position.
    my $oldIndex;
    my $t2Size = scalar keys %$orderHash2;
    for ( my $i2 = $i + 1 ; $i2 < $t2Size ; $i2++ ) {
        if ( $orderHash2->{$i2} eq $col1 ) {
            $oldIndex = $i2;
            last;
        }
    }

    # Now shift
    #
    for ( my $j = $oldIndex ; $j >= $i ; $j-- ) {
        my $prev = $j - 1;
        $orderHash2->{$j} = $orderHash2->{$prev};
    }

    $orderHash2->{$i} = $col1;
}

sub _insertColumn {
    my ( $i, $tableName, $schema1, $schema2, $table1, $table2, $orderHash1, $orderHash2, $col1, $col2 ) = @_;

    # Figure out where this column is getting inserted.
    #
    my $insertAt;
    if ( 0 == $i ) {
        $insertAt = 'FIRST';
    } else {
        my $lastIndex = $i - 1;
        $insertAt = 'AFTER ' . $orderHash1->{$lastIndex};
    }
    _report( $schema2->{_dbName} . " inserting column $col1 at $insertAt\n" );
    _alter( "ALTER TABLE $tableName ADD COLUMN $col1 " . $table1->{$col1} . " $insertAt ;" );

    # Now we need to adjust our internal representation.
    #
    # Shift everything from $i down 1
    #
    my $t2Size = scalar keys %$orderHash2;
    for ( my $j = $t2Size ; $j >= $i ; $j-- ) {
        my $prev = $j - 1;
        $orderHash2->{$j} = $orderHash2->{$prev};
    }

    # Now insert in the order hash, and update the table2 model.
    #
    $orderHash2->{$i} = $col1;
    $table2->{$col1}  = $table1->{$col1};
}

sub _redefineColumn {
    my ( $i, $tableName, $schema1, $schema2, $table1, $table2, $orderHash1, $orderHash2, $col1, $col2 ) = @_;

    my $newDef = "$col1 " . $table1->{$col1};
    _report( $schema2->{_dbName} . " modifying column $col2 to $newDef\n" );
    _alter("ALTER TABLE $tableName CHANGE COLUMN $col2 $newDef ;");

    # Update the internal representation.
    #
    delete $table2->{$col2};
    $table2->{$col1}  = $table1->{$col1};
    $orderHash2->{$i} = $col1;
}

sub _deleteColumn {
    my ( $i, $tableName, $schema2, $table2, $orderHash2, $col2 ) = @_;

    _report( $schema2->{_dbName} . " deleting column $col2\n" );
    _alter("ALTER TABLE $tableName DROP COLUMN $col2 ;");
}

sub _debugPrintHash {
    my ( $string, $hash ) = @_;
    _report( $string . "\n" );

    foreach my $key ( sort { $a <=> $b } keys %$hash ) {
        _report( "$key => " . $hash->{$key} . "\n" );
    }
}

sub _trimSpaces {
    my ($string) = @_;

    $string =~ s/^\s+//;
    $string =~ s/\s+$//;

    return $string;
}