# ====================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::SQL::Upgrade
#   Author: Jason Rhinelander
#   CVS Info :                          
#   $Id: Upgrade.pm,v 1.3 2005/04/14 00:59:12 brewt Exp $
#
# Copyright (c) 2005 Gossamer Threads Inc.  All Rights Reserved.
# ====================================================================
#
# Description:
#   Various commonly used SQL upgrade functions used by GT product upgrades.
#

package GT::SQL::Upgrade;
use strict;
use vars qw/@ISA @EXPORT $VERSION/;
require Exporter;

# You *must* bump this each time you change or fix any of the code this file or
# it is guaranteed to cause problems:
$VERSION = 1.00;

@ISA = 'Exporter';
@EXPORT = qw/add_column alter_column drop_column add_index drop_index add_table recreate_table/;

# Adds a column. Takes 5 args:
# Output coderef, database object, table name, column name, column definition
# Returns the return of $editor->add_col
sub add_column {
    my ($out, $db, $table, $col, $def) = @_;
    $out->("Adding column $col to $table table...\n");
    my $ret = $db->editor($table)->add_col($col => $def);
    $out->($ret ? "\tOkay!\n" : "\tCould not add column $col: $GT::SQL::error\n");
    $ret;
}

# Changes a column.  Takes 5 args:
# Output coderef, database obj, table name, column name, new column definition
sub alter_column {
    my ($out, $db, $table, $col, $def) = @_;
    $out->("Updating column definition for $col in $table table...\n");
    my $ret = $db->editor($table)->alter_col($col, $def);
    $out->($ret ? "\tOkay!\n" : "\tCould not alter column $col: $GT::SQL::error\n");
    $ret;
}

# Drops a column.  Takes 4 args:
# Output coderef, database object, table name, column name
# Returns the return of $editor->drop_col
sub drop_column {
    my ($out, $db, $table, $col) = @_;
    $out->("Dropping column '$col' from table '$table'...\n");
    my $ret = $db->editor($table)->drop_col($col);
    $out->($ret ? "\tOkay!\n" : "\tCould not drop column $col: $GT::SQL::error\n");
    $ret;
}

# Adds indexes. Takes 4-5 args
# Output coderef, database object, table name, indexes hash reference, and an
# optional boolean value to make the added indexes unique indexes.
# Returns the return of $editor->add_index
sub add_index {
    my ($out, $db, $table, $indexes, $unique) = @_;
    my $editor = $db->editor($table);
    my $cret = 1;
    while (my ($idx, $defn) = each %$indexes) {
        my ($meth, $index_display) = $unique ? (add_unique => 'unique index') : (add_index => 'index');
        $out->("Adding $index_display '$idx' to '$table' table...\n");
        my $ret = $editor->$meth($idx => $indexes->{$idx});
        $out->($ret ? "\tOkay!\n" : "\tCould not add $index_display '$idx': $GT::SQL::error\n");
        $cret = $ret unless $ret;
    }
    $cret;
}

# Drops an index.  Takes 4-5 args:
# Output coderef, GT::SQL obj, table name, index name, plus an optional boolean
# value to indicate that the index to drop is a unique index.
sub drop_index {
    my ($out, $db, $table, $index, $unique) = @_;
    $out->("Dropping index '$index' from '$table' table...\n");
    my $editor = $db->editor($table);
    my $meth = $unique ? 'drop_unique' : 'drop_index';
    my $ret = $editor->$meth($index);
    $out->($ret ? "\tOkay!\n" : "\tCould not drop index '$index': $GT::SQL::error\n");
    $ret;
}

# Adds a table.  Takes 3 base, plus unlimited extra arguments:
# Output coderef, GT::SQL obj, table name
# Other arguments are read in pairs - the first is a ::Creator method name, the
# second is the value to pass to the method.
sub add_table {
    my ($out, $db, $table) = splice @_, 0, 3;

    $out->("Adding table '$table'...\n");
    my $c = $db->creator($table);

    while (@_) {
        my ($meth, $arg) = splice @_, 0, 2;
        $c->$meth($arg);
    }

    my $ret = $c->create;
    if ($ret) {
        $out->("\tOkay!\n");
    }
    else {
        $out->("\tAn error occured: $GT::SQL::error\n");
        $c->set_defaults;
        $c->save_schema;
    }
    $ret;
}

# Used when recreating a table is necessary (used in at least the Links SQL
# 2.1.2 -> 2.2.0 upgrade) It creates a temporary table, copies all the data
# into it, then drops the original table, recreates it, and copies all the data
# back.
# Usage:
# recreate_table($out, $db, $table_name, $condition, ...ARGS...);
# - $out is the code reference to call with output
# - $db is the GT::SQL object for the database
# - $table_name is the name of the table to recreated
# - $condition is a code reference - it will be called with the table as an
#   argument.  If it returns true, the table is recreated, otherwise (if it
#   returns false) recreating the table is skipped.
# - Remaining arguments are specified in pairs - the first of each pair of
#   arguments is the function to call, the second is the argument to pass to
#   that function.  At least a "cols => [ ... ]" pair must be specified.
# Known problems:
# - The code that copies any custom columns breaks if any columns have been
#   removed from the new table has fewer columns from the old one - those
#   columns will be copied to the new table.
# - A change adding not_null to a column will only work for INT's/FLOAT's,
#   for which any previous null values are given a value of 0.
sub recreate_table {
    my ($out, $db, $table_name, $condition) = splice @_, 0, 4;
    @_ % 2 == 0 or die "Invalid arguments.  Usage: recreate_table(INSTALLER_OBJ, GTSQL_OBJ, 'Table', method => val, method => val, ...)";
    my @args = @_;
    my %args = @args;
    my @cols = $args{cols};
    my %cols = @cols;

    my $table = $db->table($table_name);

    my $success;
    if ($condition->($table)) {
        RECREATE: {
            $out->("Performing required $table_name table recreation...\n");

            $out->("\t- Creating temporary storage table...\n");
            my @create;
            my %old_cols = $table->cols;
            my %new_cols = @{$args{cols}};

            my ($count, @denull) = 0;
            for (keys %old_cols) {
                if (
                    !$old_cols{$_}->{not_null} and # Didn't have not_null before
                    $new_cols{$_} and # Still exists in the new version of the table
                    $new_cols{$_}->{not_null} and # not_null present in the new version
                    $new_cols{$_}->{type} =~ /^(?:FLOAT|DOUBLE|DECIMAL|\w*INT)$/ # is a numeric type
                ) {
                    push @denull, $count;
                }
                $count++;
            }

            # Retain any custom columns:
            for (keys %old_cols) {
                unless ($cols{$_}) {
                    push @create, $_ => $old_cols{$_};
                    push @cols, $_ => $old_cols{$_};
                    $cols{$_} = $old_cols{$_};
                }
            }

            my $c = $db->creator($table_name . '_tmp');
            $c->cols(@create);

            # We should probably 'force' the following create, but that is
            # potentially dangerous if the main table isn't recreated properly.
            my $ret = $c->create;
            if ($ret) {
                $out->("\t\tOkay!\n");
            }
            else {
                $out->("\t\tAn error occured: $GT::SQL::error\n");
                last RECREATE;
            }

            my $tmp_table = $db->table($table_name . '_tmp');

            $out->("\t- Copying existing data to temporary table...\n");
            my $sth = $table->select(keys %old_cols);
            my @recs;
            while () {
                my $row = $sth->fetchrow_arrayref;
                if ($row) {
                    my @row = @$row;
                    for (@denull) {
                        $row[$_] = 0 if not defined $row[$_];
                    }
                    push @recs, \@row;
                }
                if (!$row or @recs >= 1000) {
                    $ret = $tmp_table->insert_multiple([keys %old_cols], @recs) if @recs;
                    $out->("\t\tAn error occured: $GT::SQL::error\n") unless $ret;
                    @recs = ();
                    last if !$row;
                }
            }
            $out->("\t\tOkay!\n");

            $out->("\t- Dropping $table_name table...\n");
            $ret = $db->editor($table_name)->drop_table;
            if ($ret) {
                $out->("\t\tOkay!\n");
            }
            else {
                $out->("\t\tAn error occured: $GT::SQL::error\n");
            }

            $out->("\t- Creating new $table_name table...\n");
            $c = $db->creator($table_name);
            while (@args) {
                my ($method, $value) = (shift @args, shift @args);
                $c->$method($value);
            }

            $ret = $c->create('force');
            if ($ret) {
                $out->("\t\tOkay!\n");
            }
            else {
                $out->("\t\tAn error occured: $GT::SQL::error\n");
                last RECREATE;
            }

            $out->("\t- Copying temporary data back into new table...\n");
            $sth = $tmp_table->select(keys %old_cols);
            @recs = ();
            while () {
                my $row = $sth->fetchrow_arrayref;
                push @recs, [@$row] if $row;
                if (!$row or @recs >= 1000) {
                    $ret = $table->insert_multiple([keys %old_cols], @recs) if @recs;
                    $out->("\t\tAn error occured: $GT::SQL::error\n") unless $ret;
                    @recs = ();
                    last if !$row;
                }
            }
            $out->("\t\tOkay!\n");

            $out->("\t- Dropping ${table_name}_tmp table...\n");
            $ret = $db->editor("${table_name}_tmp")->drop_table;
            if ($ret) {
                $out->("\t\tOkay!\n");
            }
            else {
                $out->("\t\tAn error occured: $GT::SQL::error\n");
            }

            $success = 1;
        }

        if (!$success) {
            $out->("\tAn error occured while attempting to recreate $table_name.  Procedure aborted.\n");
        }
    }
}

1;