# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Base
#   CVS Info : 087,071,086,086,085      
#   $Id: Editor.pm,v 1.79 2007/09/05 04:42:31 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Class used to make changes to tables and create tables.
#

package GT::SQL::Editor;
# ==================================================================
use strict;
use vars qw/@ISA $DEBUG $VERSION $ERRORS $error $ERROR_MESSAGE/;
use GT::SQL;
use GT::SQL::Base;
use GT::AutoLoader;

$VERSION       = sprintf "%d.%03d", q$Revision: 1.79 $ =~ /(\d+)\.(\d+)/;
$ERROR_MESSAGE = 'GT::SQL';
@ISA           = qw(GT::SQL::Base);
$DEBUG         = 0;

sub new {
    my $this = shift;
    my $class = ref $this || $this;
    my $self = bless {}, $class;

# Get the arguments
    my $opts = $self->common_param(@_) or return $self->fatal(BADARGS => "$class->new(HASH_REF or HASH)");

    ref $opts->{table} or return $self->fatal(BADARGS => "$class->new(HASH_REF or HASH). 'table' must be specified in the hash. It needs to be the an object from GT::SQL::Table.");
    $self->{_debug}   = $opts->{debug}    || $DEBUG;
    $self->{_err_pkg} = $opts->{_err_pkg} || __PACKAGE__;
    $self->{table}    = $opts->{table};
    $self->{connect}  = $opts->{connect};

# We almost always need to be connected.
    $self->{table}->connect or return;
    return $self;
}


#################################################################
#####                    Editing functions                  #####
#################################################################
##
# $obj->add_col($col_name, 
#           { 
#               size => 20, 
#               type => 'int',
#               view_size => 20, 
#               form_display => "my col", 
#               regex => 'myregex' 
#           }
#       );
# ------------------------------------
#   
##
$COMPILE{add_col} = __LINE__ . <<'END_OF_SUB';
sub add_col {
    my ($self, $name, $col) = @_;

    $name and ref $col eq 'HASH' or return $self->fatal(BADARGS => '$obj->add_col(COLUMN_NAME, HASH_REF)');
    my $c = $self->{table}->cols;

    # Check the database instead of the def file so that we don't end up with
    # an inability to add a column when the database and def files are out of
    # sync.
    my $exists = $self->{table}->{driver}->column_exists($self->{table}->name, $name);
    $exists and return $self->warn(COLEXISTS => $name);

# You are not permitted to add a not_null column without a default to a table -
# the default is required for existing columns.  You could, if you really want
# it with no default, create it with a default, then alter it to drop the
# default.
    return $self->warn(NOTNULLDEFAULT => $name)
        if $col->{not_null} and (not defined $col->{default} or $col->{default} eq '');

# count file columns
    my %fcols_initial = $self->{table}->_file_cols();

# handle the search indexes
    my $tmp_weight = {};
    $tmp_weight = $self->_get_indexer()->pre_add_column($name, $col) or return if $col->{weight};

# get the column definition
    my $col_props = $self->{table}->{driver}->column_sql($col);
    my $table = $self->{table}->name;

# Auto add a new position number.
    $col->{pos} = keys(%$c) + 1;

# Add the column into the table's column hash, for checking.
# N.B. - everything below this point _must_ reload the table information (i.e.
# via ->reset or ->reload) upon failure
    $c->{$name} = $col;

# Check for conflicts
    $self->{table}->check_schema or return $self->{table}->reset;

    require GT::SQL::Creator;
    GT::SQL::Creator::set_defaults($self, { $name => $col });

# Make the changes
    $self->{table}->{driver}->add_column($table, $name, $col_props) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;

# Check for file columns
    if (not keys %fcols_initial and uc $col->{form_type} eq 'FILE') {
        require GT::SQL::File;
        my $ftable = GT::SQL::File->new(parent_table => $self->{table}, connect => $self->{connect});
        $ftable->debug_level($self->{_debug});
        $ftable->install({ parent_tablename => $self->{table}->name() });
        $self->{table}->_file_cols(1);
    }

# finish off the search indexes
    if ($col->{weight}) {
        $self->_get_indexer()->post_add_column($name, $col, $tmp_weight) or return;
    }

    1;
}
END_OF_SUB

##
# $obj->drop_col($col_name);
# ---------------------------
#   Drops the column specified by $col_name.
#   If the column is referenced returns an error.
#   If the column is itself an fk reference, the foreign key is dropped.
#
# $obj->drop_col($col_name, "remove");
# -------------------------------------
#   Drops column and all fk references to it.
#
##
$COMPILE{drop_col} = __LINE__ . <<'END_OF_SUB';
sub drop_col {
    my $self = shift;
    my $name = shift || return $self->fatal(BADARGS => '$obj->drop_col(COLUMN_NAME,[ STRING ])');
    exists $self->{table}->cols->{$name} or return $self->warn(NOCOL => $name);
    my $kill = shift;

    my %fcols = $self->{table}->_file_cols();
    my $table = $self->{table}->name;
    if ($self->_is_referenced($table, $name)) {
        if (defined $kill) {
            $self->_remove_references($table, $name);
        }
        else {
            return $self->warn(REFCOL => $name, $table);
        }
    }

    my @fk_tables = grep exists $self->{table}->{fk}->{$_}->{$name}, keys %{$self->{table}->{fk}};
    if (@fk_tables) {
        $self->drop_fk($_, 1);
    }

    my $tmp_weight = {};
    if (($self->{table}->cols->{$name} || {})->{weight}) {
        $tmp_weight = $self->_get_indexer()->pre_delete_column($name, $self->{table}->cols->{$name}) or return
    }

# Columns
    my $old_col = delete $self->{table}->cols->{$name};

# Primary key
    $self->{table}->pk(grep $_ ne $name, $self->{table}->pk);

# Foreign keys
    while (my ($table, $fk) = each %{$self->{table}->fk}) {
        for my $col (keys %$fk) {
            if ($col eq $name) {
                delete $self->{table}->fk->{$_}->{$col}
            }
        }
    }

# Indexes and uniques
    for my $index (qw/index unique/) {
        my $ndx = $self->{table}->$index();
        for (keys %$ndx) {
            my @new = grep $_ ne $name, @{$ndx->{$_}};
            if (@new) {
                $ndx->{$_} = \@new;
            }
            else {
                delete $ndx->{$_};
            }
        }
    }

# Update the positions.
    my $cols = $self->{table}->cols;
    my $i;
    for my $col (sort { $cols->{$a}->{pos} <=> $cols->{$b}->{pos} } keys %$cols) {
        $cols->{$col}->{pos} = ++$i;
    }

# Check for conflicts
    $self->{table}->check_schema or return $self->{table}->reset;

# File Handling
    if ($fcols{$name}) {
        require GT::SQL::File;
        my $ftable = GT::SQL::File->new(parent_table => $self->{table}, connect => $self->{connect});
        $ftable->debug_level($self->{_debug});
        $ftable->drop_col($name, $fcols{$name}->{file_save_scheme}) or return $self->{table}->reset;
        $self->{table}->_file_cols(1);
    }

# Finish off the index table stuff
    if (($self->{table}->cols->{$name} || {})->{weight}) {
        $tmp_weight = $self->post_delete_column($name, $self->{table}->cols->{$name}, $tmp_weight)
            or return $self->{table}->reset;
    }

# Make the changes - actually drop the column
    $self->{table}->{driver}->drop_column($table, $name, $old_col) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;

    1;
}
END_OF_SUB

##
# $obj->alter_col($column_name, \%new_defs);
# -------------------------------------------
#   
$COMPILE{alter_col} = __LINE__ . <<'END_OF_SUB';
sub alter_col {
    my ($self, $col, $defs) = @_;

    ref $defs eq 'HASH' or return $self->fatal(BADARGS => '$obj->alter_col(COLUMN_NAME, HASH_REF)');
    exists $self->{table}->{schema}->{cols}->{$col} or return $self->warn(NOCOL => $col);

    my %fcols = $self->{table}->_file_cols();

# Can't change the position, force it to what it was before.
    my $orig = $self->{table}->{schema}->{cols}->{$col};
    my $table = $self->{table}->{name};

# Set the position, can't be changed.
    $defs->{pos} = $orig->{pos};

# Check to see if we need to update the SQL.
    my $orig_sql = $self->{table}->{driver}->column_sql($orig);
    my $new_sql  = $self->{table}->{driver}->column_sql($defs);
    my $change   = $orig_sql ne $new_sql;

# If we've changed, check the keys.
    if ($change) {
        return $self->warn(REFCOL => $col, $table) if $self->_is_referenced($table, $col);
        return $self->warn(COLREF => $col, $table) if exists $self->{table}->fk->{$col};
    }

# Check for conflicts
    my $old_col = $self->{table}->{schema}->{cols}->{$col};
    $self->{table}->{schema}->{cols}->{$col} = $defs;
    $self->{table}->check_schema or return $self->{table}->reset;

# adding a file column
    if (not keys %fcols and $defs->{form_type} and lc $defs->{form_type} eq 'file') {

        require GT::SQL::File;
        my $ftable = GT::SQL::File->new({ parent_table => $self->{table}, connect => $self->{connect} });
        $ftable->debug_level($self->{_debug});
        $ftable->install({parent_tablename => $self->{table}->name() });
    }

# removing a file column
    elsif ($fcols{$col} and not ($defs->{form_type} and lc $defs->{form_type} eq 'file')) {
        require GT::SQL::File;
        my $ftable = GT::SQL::File->new({ parent_table => $self->{table}, connect => $self->{connect} });
        $ftable->drop_col($col);
    }

# Make the changes
    if ($change) {
        $self->{table}->{driver}->alter_column($table, $col, $new_sql, $old_col) or return $self->{table}->reset;
    }
    $self->{mods}->{$table} = $self->{table};
    $self->save_state or return;

# finish off the file column setup
    if ($defs->{form_type} and lc $defs->{form_type} eq 'file') {
        $self->{table}->update({ $col => '' });
        $self->{table}->_file_cols(1);
    }

    1;
}
END_OF_SUB

##
# $obj->add_index($index_name => [ field1, field2 .. ]);
# --------------------
#   Add a index to the table specified by 
#   $index_name. The array should contain fields
#   that will be part of the index.
##
$COMPILE{add_index} = __LINE__ . <<'END_OF_SUB';
sub add_index {
    my ($self, $index_name, $columns) = @_;
    ref $columns eq 'ARRAY' or return $self->fatal(BADARGS => '$obj->add_index(INDEX_NAME => ARRAY_REF)');

# Do the columns exist?
    for (@$columns) {
        return $self->warn(NOCOL => $_) unless exists $self->{table}->cols->{$_};
    }

    exists $self->{table}->{schema}->{index}->{$index_name}
        and return $self->warn(INDXEXISTS => $index_name);

    my $table = $self->{table}->name;

# Check for conflicts
    $self->{table}->{schema}->{index}->{$index_name} = $columns;
    $self->{table}->check_schema or return $self->{table}->reset;

# Make the changes
    $self->{table}->{driver}->create_index($table, $index_name, @$columns) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;
    1;
}
END_OF_SUB

##
# $obj->drop_index($index_name);
# --------------------------------
#   Drops an index by the name $index_name.
##
$COMPILE{drop_index} = __LINE__ . <<'END_OF_SUB';
sub drop_index {
    my ($self, $index_name) = @_;
    $index_name or return $self->fatal(BADARGS => '$obj->drop_index(INDEX_NAME)');
    exists $self->{table}->index->{$index_name} or return $self->warn(NOINDEX => $index_name);

# Check for conflicts
    delete $self->{table}->index->{$index_name};
    $self->{table}->check_schema or return $self->{table}->reset;

# Make the changes
    my $table = $self->{table}->name;
    $self->{table}->{driver}->drop_index($table, $index_name) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;
    1;
}
END_OF_SUB

##
# $obj->add_unique($index_name => [ field1, field2 .. ]);
# --------------------
#   Add a unique index to the table specified by 
#   $index_name. The array should contain fields
#   that will be part of the index.
##
$COMPILE{add_unique} = __LINE__ . <<'END_OF_SUB';
sub add_unique {
    my ($self, $index_name, $indexes) = @_;

    $index_name and ref $indexes eq 'ARRAY' or return $self->fatal(BADARGS => '$obj->add_unique(INDEX_NAME => ARRAY_REF)');
# Do the columns exist?
    for (@$indexes) {
        exists $self->{table}->cols->{$_} or return $self->warn(NOCOL => $_);
    }
    exists $self->{table}->unique->{$index_name} and return $self->warn(INDXEXISTS => $index_name);

    my $table = $self->{table}->name;

# Do the new fields have unique data in them?
    my $in = join ", " => @{$indexes};
    my $query = "SELECT $in, COUNT(*) AS hits FROM $table GROUP BY $in HAVING ";
    $query .= lc $self->{table}->{connect}->{driver} eq 'mysql' ? 'hits' : 'COUNT(*)';
    $query .= ' > 1';
    $self->debug($query) if $self->{_debug};

    my $sth = $self->{table}->do($query) or return;
    $sth->fetchrow and return $self->warn(NOTUNIQUE => $index_name);

# Check for conflicts
    $self->{table}->unique->{$index_name} = $indexes;
    $self->{table}->check_schema or return $self->{table}->reset;

# Make the changes
    $self->{table}->{driver}->create_unique($table, $index_name, @$indexes) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;
    1;
}
END_OF_SUB

##
# $obj->drop_unique($index_name);
# --------------------------------
#   Drops an index by the name $index_name.
##
$COMPILE{drop_unique} = __LINE__ . <<'END_OF_SUB';
sub drop_unique {
    my ($self, $index_name) = @_;

    $index_name or return $self->fatal(BADARGS => '$obj->drop_unique(INDEX_NAME)');
    exists $self->{table}->unique->{$index_name} or return $self->warn(NOUNIQUE => $index_name);

    my $table = $self->{table}->name;

# Check for conflicts
    delete $self->{table}->unique->{$index_name};
    $self->{table}->check_schema or return $self->{table}->reset;

# Make the changes
    $self->{table}->{driver}->drop_index($table, $index_name) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;
    1;
}
END_OF_SUB

##
# $obj->add_pk($field1, $field2, ...);
# -------------------------------------
#   Addes primary keys specified by list. If there is already a primary key it
#   drops it and adds all the keys at the same time.  If there is no primary
#   keys this makes sure the data in the primary keys is unique.
##
$COMPILE{add_pk} = __LINE__ . <<'END_OF_SUB';
sub add_pk {
    my ($self, @fields) = @_;

    @fields or return $self->fatal(BADARGS => '$obj->add_pk(COLUMN1, COLUMN2, ...)');
    for (@fields) {
        exists $self->{table}->cols->{$_} or return $self->warn(NOCOL => $_);
    }

    my ($table, %add) = $self->{table}->name;
    if ($self->{table}->pk) {
        $self->{table}->{driver}->drop_pk($table) or return;
        %add = map { $_ => 1 } @{delete $self->{table}->{schema}->{pk}};
    }

# Check for conflicts
    for (@fields) { $add{$_} = 1 }
    $self->{table}->{schema}->{pk} = [keys %add];
    $self->{table}->check_schema or return $self->{table}->reset;

# Make the changes
    $self->{table}->{driver}->create_pk($table, keys %add) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;
    1;
}
END_OF_SUB

##
# $obj->drop_pk;
# --------------
#   Drops the current primary key.
##
$COMPILE{drop_pk} = __LINE__ . <<'END_OF_SUB';
sub drop_pk {
    my $self = shift;
    $self->{table}->pk or return $self->warn('NOPK');

# Check for conflicts
    $self->{table}->{schema}->{pk} = [];
    $self->{table}->check_schema or return $self->{table}->reset;

# Make the changes
    my $table = $self->{table}->name;
    $self->{table}->{driver}->drop_pk($table) or return $self->{table}->reset;
    $self->{mods}->{$table} = $self->{table};
    $self->save_state;
    1;
}
END_OF_SUB

##
# $obj->add_fk( RELATION_NAME, { SOURCE_FIELD_1 => TARGET_FIELD });
# ------------------------------------------------------------------
#   Sets the foreign key relations for one relation.
#
#   this structure introduces a limitations: a table cannot
#   refer two schemas in the same target table, which should
#   really not be a problem.
##
$COMPILE{add_fk} = __LINE__ . <<'END_OF_SUB';
sub add_fk {
    my $self = shift;
    $self->{table}->fk(@_) or return;
    1;
}
END_OF_SUB

##
# $obj->drop_fk(RELATION_NAME [, SKIPSAVE]);
# ---------------------------------------------
#   Drops the foreign key relation for a given relation.  If a second parameter
#   is passed, and true, the state of the current table will not be saved (any
#   other changed tables are, however).
##
$COMPILE{drop_fk} = __LINE__ . <<'END_OF_SUB';
sub drop_fk {
    my ($self, $tbl, $nosave) = @_;
    my $table = $self->{connect}->{PREFIX} . $tbl;
    delete $self->{table}->{schema}->{fk}->{$table}
        or return $self->warn(FKNOEXISTS => $tbl, $self->{table}->{name});
    my $remote = $self->new_table($table);
    my $rfk = $remote->fk_tables || [];
    $remote->fk_tables([grep $_ ne $self->{table}->{name}, @$rfk]);
    $remote->save_state;
    $self->{table}->save_state unless $nosave;
}
END_OF_SUB

##
# $obj->add_tree(ARGS);
# ---------------------
#   Create a tree table for the current table.
#   'ARGS' is a hash or hash reference consisting of the following:
#       father => 'father_id_column',
#       root => 'root_id_column',
#       depth => 'depth_column'
#   where 'father_id_column', 'root_id_column', and 'depth_column' are the names
#   of the columns you will use for keeping track of the father record, root
#   record, and the depth from the root record, respectively. All of these
#   columns should already exist - an error will occur if they do not.
#
#   Any other arguments passed in will be passed straight through to
#   GT::SQL::Tree->create
##
$COMPILE{add_tree} = __LINE__ . <<'END_OF_SUB';
sub add_tree {
    my $self = shift;

    my $input = $self->common_param(@_) or return $self->fatal(BADARGS => 'GT::SQL::Editor->add_tree(HASH or HASH REF)');

    return $self->warn(TREEEXISTS => $self->{table}->{name}) if $self->{table}->{schema}->{tree} and ($input->{force} || 'force') eq 'check';

    $input->{father} or return $self->fatal(BADARGS => 'GT::SQL::Editor->add_tree(..., father => \'father_col\', ...)');
    $input->{root}   or return $self->fatal(BADARGS => 'GT::SQL::Editor->add_tree(..., root => \'root_col\', ...)');
    $input->{depth}  or return $self->fatal(BADARGS => 'GT::SQL::Editor->add_tree(..., depth => \'depth_col\', ...)');

    require GT::SQL::Tree;
    GT::SQL::Tree->create(debug => $self->{_debug}, %$input, table => $self->{table});
}
END_OF_SUB

$COMPILE{drop_tree} = __LINE__ . <<'END_OF_SUB';
sub drop_tree {
    my $self = shift;
    my $tree = $self->{table}->tree or return;
    $tree->destroy;
}
END_OF_SUB

$COMPILE{load_data} = __LINE__ . <<'END_OF_SUB';
sub load_data {
# ---------------------------------------------------------------
# imports the contents of a file with validation.
#
    my ($self, $file, $options) = @_;
    -f $file and -r _ or return $self->fatal(FILENOEXISTS => $file);
    $self->{table}->connect or return;

    my $delim = $options->{delim} || '|';
    my @cols  = ref $options->{cols} ? @{$options->{cols}} : @{$self->{table}->ordered_columns};

    local *FILE;
    open FILE, $file or return $self->warn(CANTOPEN => $file, "$!");
    while (<FILE>) {
        chomp;
        my $i = 0;
        my %fields = map { $cols[$i++] => $_ } split /(?<!\\)\Q$delim\E/;
        $self->{table}->insert(\%fields, 1) or print "Line $. skipped - validation failed:\n$GT::SQL::error\n\n";
   }
   close FILE;
   1;
}
END_OF_SUB

$COMPILE{export_data} = __LINE__ . <<'END_OF_SUB';
sub export_data {
# ---------------------------------------------------------------
# Dumps the contents of a table to a file.
#
    my $self = shift;
    my $opt  = shift;
    ref $opt eq 'HASH' or return $self->fatal(BADARGS => '$obj->export_data(HASHREF)');

    my $order  = $opt->{order};
    my $delim  = $opt->{delim}  || '|';
    my $file   = $opt->{file}   || undef;
    my $header = $opt->{header} || undef;
    my $table  = $self->{table}->name;

    my @order = $order
        ? ref $order eq 'ARRAY' ? @$order : $order
        : $self->{table}->ordered_columns;

    my ($offset, $limit) = (0, 1000);

    local *FILE;
    if ($file) {
        open FILE, "> $file" or return $self->warn(CANTOPEN => $file, "$!");
    }
    while () {
        $self->{table}->select_options("LIMIT $limit OFFSET " . ($offset++ * $limit));
        my $sth = $self->{table}->select(\@order);

        if ($header) {
            print FILE join($delim, @order), "\n";
            $header = undef;
        }
        my $count = 0;
        while (my $arr = $sth->fetchrow_arrayref) {
            ++$count;
            for (@$arr) {
                y/\r//d;
                s/\Q$delim\E/``/g;
                s/\n/~~/g;
            }
            my $joined = join $delim, @$arr;
            $file
                ? print FILE $joined, "\n"
                : print $joined, "\n";
        }
        last unless $count;
    }
    1;
}
END_OF_SUB

##
# $obj->drop_search_driver
# -----------------
#   Drops current search driver
##
$COMPILE{drop_search_driver} = __LINE__ . <<'END_OF_SUB';
sub drop_search_driver {
    my $self    = shift;

    require GT::SQL::Search;
    if ($self->{table}->search_driver) {
        my $indexer = GT::SQL::Search->load_indexer(table => $self->{table}, _debug => $self->{_debug}) or return;
        $indexer->drop_search_driver or return;
    }
    $self->{table}->search_driver('NONINDEXED');
    $self->{table}->save_state;
    1;
}
END_OF_SUB

##
# $obj->add_search_driver
# -----------------
#   Adds new search driver
##
$COMPILE{add_search_driver} = __LINE__ . <<'END_OF_SUB';
sub add_search_driver {
    my $self      = shift;
    my $olddriver = $self->{table}->search_driver();
    my $newdriver = shift or return;

    require GT::SQL::Search;

# check and see if driver is ok
    GT::SQL::Search->driver_ok($newdriver, { table => $self->{table} }) or return;

# load the driver
    my $indexer = GT::SQL::Search->load_indexer(table => $self->{table}, _debug => $self->{_debug}, driver => $newdriver) or return;
    $indexer->add_search_driver or return;

    $self->{table}->search_driver($newdriver);
    $self->{table}->save_state or return;
    1;
}
END_OF_SUB

##
# $obj->change_search_driver
# -----------------
#   Adds new search driver
##
$COMPILE{change_search_driver} = __LINE__ . <<'END_OF_SUB';
sub change_search_driver {
    my $self      = shift;
    my $newdriver = uc shift or return;
    my $driver    = $self->{table}->search_driver;
    $driver eq $newdriver and return $self->warn(SAMEDRIVER => $driver);

    $self->drop_search_driver() or return;
    $self->add_search_driver($newdriver) or return;

    1;
}
END_OF_SUB

##
# $obj->drop_table;
# -----------------
#   Drops the current table.
##
$COMPILE{drop_table} = __LINE__ . <<'END_OF_SUB';
sub drop_table {
    my $self  = shift;
    my $rm_fk = lc(shift or '') eq 'remove';
    my $table = $self->{table}->name;
    my $tmp   = $self->{table}->fk_tables() || [];
    @$tmp and !$rm_fk and return $self->warn(TABLEREFD => $table);

    my $tmp_weights = {};
    if ($self->_uses_weights) {
        $tmp_weights = $self->_get_indexer->pre_drop_table() or return
    }

    $self->{table}->{driver}->drop_table($table) or return;

    delete $GT::SQL::OBJ_CACHE{"TABLE\0$table\0$self->{connect}->{def_path}"};

# If this table has a tree, drop it:
    $self->drop_tree if $self->{table}->{schema}->{tree};

    unlink "$self->{connect}->{def_path}/$table.def";

    for (keys %{$self->{table}->{schema}->{fk}}) {
        next if $_ eq $table;
        my $t = $self->new_table($_);
        $t->{schema}->{fk_tables} = [grep $_ ne $table, @{$t->{schema}->{fk_tables}}];
        $t->save_state();
    }

    $self->_file_drop_tables();
    $self->_uses_weights and ($self->_get_indexer->post_drop_table($tmp_weights) or return);
    $rm_fk and $self->_drop_related_fk_entries($table);

    1;
}
END_OF_SUB

$COMPILE{_file_drop_tables} = __LINE__ . <<'END_OF_SUB';
sub _file_drop_tables {
    my $self    = shift;
    if ( $self->{table}->_file_cols() ) {
        require GT::SQL::File;
        GT::SQL::File->new({ parent_table => $self->{table}, connect => $self->{connect} })->drop_table();
    }
}
END_OF_SUB

$COMPILE{_drop_related_fk_entries} = __LINE__ . <<'END_OF_SUB';
sub _drop_related_fk_entries {
    my $self        = shift;
    my $table_name  = shift or return;

    my $fk          = $self->{table}->fk() or return;
    my $prefix      = $self->{connect}->{PREFIX};
    for my $related_name ( keys %{$fk} ) {
        my $table     = $self->{table}->new_table($related_name);
        my $fk_tables = $table->fk_tables() or next;
        $fk_tables    = [ grep { $_ ne $table_name  } @{$fk_tables} ];
        $table->fk_tables( $fk_tables );
        $table->save_state();
    }

    1;
}
END_OF_SUB

###########################################################################
#####                       Private Functions                         #####
###########################################################################

$COMPILE{_is_referenced} = __LINE__ . <<'END_OF_SUB';
sub _is_referenced {
    my ($self, $mytable, $mycol) = @_;
    for my $table (@{$self->{table}->fk_tables}) {
        my $fk = $self->new_table($table)->fk;
        if (exists $fk->{$mytable}) {
            for my $key (keys %{$fk->{$mytable}}) {
                if ($mycol eq $fk->{$mytable}->{$key}) {
                    return 1;
                }
            }
        }
    }
    0;
}
END_OF_SUB

$COMPILE{_remove_referenced} = __LINE__ . <<'END_OF_SUB';
sub _remove_referenced {
    my ($self, $mytable, $mycol) = @_;
    for my $table (@{$self->{table}->fk_tables}) {
        my $new_table = $self->{mods}->{$table} || $self->new_table($table);
        my $fk = $new_table->fk;
        if (exists $fk->{$mytable}) {
            for my $key (keys %{$fk->{$mytable}}) {
                if ($mycol eq $fk->{$mytable}->{$key}) {
                    delete $fk->{$mytable}->{$key};
                    $self->{mods}->{$table} ||= $new_table;
                }
                if (not keys %{$fk->{$mytable}}) {
                    delete $fk->{$mytable};
                    $self->{mods}->{$table} ||= $new_table;
                }
            }
        }
    }
    1;
}
END_OF_SUB

$COMPILE{_remove_references} = __LINE__ . <<'END_OF_SUB';
sub _remove_references {
    my ($self, $mytable, $mycol) = @_;
    for my $table (keys %{$self->{table}->fk}) {
        if ($self->{table}->fk->{$table}->{$mycol}) {
            delete $self->{table}->fk->{$table}->{$mycol};
        }
        next if keys %{$self->{table}->fk->{$table}};
        my $t = $self->{mods}->{$table} || $self->new_table($table);
        $t->{schema}->{fk_table} = [grep $_ ne $mytable, @{$t->fk_tables}];
        $self->{mods}->{$table} = $t;
    }
    1;
}
END_OF_SUB

sub save_state {
    my $self = shift;
    for my $table (keys %{$self->{mods}}) {
        my $new_table = $self->{mods}->{$table};
        $new_table->save_state or return;
        delete $self->{mods}->{$new_table};
    }
    1;
}

sub _uses_weights {
#-------------------------------------------------------------------------------
    return keys %{$_[0]->{table}->weight()}
}

$COMPILE{_get_indexer} = __LINE__ . <<'END_OF_SUB';
sub _get_indexer {
#-------------------------------------------------------------------------------
    my $self = shift;
    require GT::SQL::Search;
    my $indexer = GT::SQL::Search->load_indexer(
        table  => $self->{table},
        debug  => $self->{_debug}
    );
    return $indexer;
}
END_OF_SUB

1;

__END__

=head1 NAME

GT::SQL::Editor - an interface to modify an SQL table.

=head1 SYNOPSIS

    my $editor = $DB->editor('Table');
    $editor->add_col(Foo => { size => 20, type => 'int' });
    $editor->export_data('/tmp/foo.txt');

=head1 DESCRIPTION

GT::SQL::Editor is an easy way to do a lot of table maintenance
functions like:

* Adding columns
* Dropping columns
* Changing columns
* Altering keys
* Importing data
* Dropping data

To get an editor object, you simply call C<editor> from a
GT::SQL object, and specify the tablename you want to edit:

    $editor = $db->editor('TableName');

Note: You can not use Editor with relations, only tables.

=head2 add_col

This method allows you to add a column to the current table.
All attributes for the column are passed in a single hash. 

    $editor->add_col($col_name, 
                        { 
                            size => 20, 
                            type => 'int',
                            view_size => 20, 
                            form_display => "my col", 
                            regex => 'myregex' 
                        }
                    );

The same rules apply to this method that apply when you
define a column for creating a table. You must specify the
type.

=head2 drop_col

This method drops a column from the current table. Checks
are made to ensure the column is not linked to by a foreign
key relation. 

    $editor->drop_col($col_name);

-or-

    $editor->drop_col($col_name, "remove");

If you just specify the column name C<drop_col> will check if
the column is referenced in a foreign key relation. If it
is C<drop_col> will return undef and set the error message in
$GT::SQL::error. If it is not the column will be dropped.

If you specify "remove" C<drop_col> will remove all foreign
key relations that point to the specified column.

If the specified column is itself a foreign key relation, the relation will be
dropped.

=head2 alter_col

This allows you to make changes to a columns type, null status,
etc..

    $editor->alter_col($column_name,
                                { 
                                    size => 20, 
                                    type => 'int' 
                                });

The first argument is the column name the second is the definitions.
The column definitions are exactly the same as the column
definitions from the create. The type must be specified.

You can not add attributes to the column in this way.
You must specify the original definitions along with the
changes you need to make.

=head2 add_unique

This allows you to add a unique index to the current table.
If the name of the unique index is the same as another
index you C<add_unique> will return undef and set the error
in $GT::SQL::error.

    $editor->add_unique($index_name => [ $field1, $field2 .. ]);

The name of the new index is the first argument. The second argument
is an array reference containing the columns that will be indexed.
The order of the columns are maintained for the unique index.
If you specify an index that has data in it that is not unique
(yes we do a select on the database) C<add_unique> will return
an error and set the error in $GT::SQL::error.

=head2 drop_unique

This method allows you to drop a unique index for the current
table. If the unique index does not exist C<drop_unique> will
return undef and set the error in $GT::SQL::error. C<drop_unique>
will also check to make sure dropping the unique index will not
cause problems for the database structure. If dropping the unique
index will cause a problem C<drop_unique> will return undef and set
the error in $GT::SQL::error.

    $editor->drop_unique($index_name);

$index_name should be the name of the unique index to drop.

=head2 add_index

This takes the same arguments as C<add_unique> and return the same thing.
The only difference is C<add_index> has no reason to check the content of
the current table because indexes are not unique. unique indexes are  :)

    $editor->add_index($index_name => [ $field1, $field2 .. ]);

=head2 drop_index

This method drops the specified index from the current table.
C<drop_index> will check to make sure no problems are caused from
dropping the index. If there are C<drop_index> will return undef
and set the error in $GT::SQL::error.

    $editor->drop_index($index_name);

$index_name should be the name of the index to drop.

=head2 add_pk

This method allows you to add a primary key to the current 
database. 

    $editor->add_pk($field1, $field2, ...);

If there is already a primary key in the database C<add_pk>
will drop the key and add the this new one. The table
will be check to make sure this change does not create problems
for the table. I problem is auto increment not being the primary
key anymore. If there is a problem this function returns undef 
and stores the error in $GT::SQL::error.

=head2 drop_pk

This method drops the current primary key. If there is no primary
key to drop it returns undef and sets the error in $GT::SQL::error.

    $editor->drop_pk;

If dropping the primary key will cause problems for the database
this method will return undef and set the error in $GT::SQL::error.

=head2 add_fk

This method allows you to add foreign key relations to the current 
table.

    $editor->add_fk($RELATION_NAME, { $SOURCE_FIELD_1 => $TARGET_FIELD });

You can not link your foreign key to tables that do not exist. Also the
columns types and lengths for the two columns must be the same.
Circularity is not allowed either. That is a set of foreign keys can not
end up pointing back at the same table they started at. All of these things
are checked when this is added. If anything does not match this method returns
undef and sets the error in $GT::SQL::error.

=head2 drop_fk

This method drops the specified foreign key relation. 

    $editor->drop_fk($table);

$table should be the name of the foreign table the foreign
key points to.

=head2 drop_table

This method drops the current table. If there are any foreign keys
pointing to this table this method will fail and return undef. The error
will be set in $GT::SQL::error.

    $editor->drop_table;

-or-

    $editor->drop_table("remove");

If the first argument to this method is remove it will remove all
the foreign key relations that point to this table.

=head1 COPYRIGHT

Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: Editor.pm,v 1.79 2007/09/05 04:42:31 brewt Exp $

=cut