# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::SQL::Table
#   Author  : Scott Beck
#   $Id: Base.pm,v 1.46 2002/03/12 22:25:20 aki Exp $
#
# Copyright (c) 2000 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Base class for GT::SQL::Table and GT::SQL::Relation
#

package GT::SQL::Base;
# ===============================================================
    use GT::Base;
    use strict;
    use vars qw/ $ERRORS   $DEBUG         $ERROR_PACKAGE 
                 @ISA      $AUTOLOAD      @COL_ATTRIBS
                 $DEBUG    $ERROR_MESSAGE $VERSION
            /;
    @ISA           = qw/GT::Base/;
    $DEBUG         = 0;
    @COL_ATTRIBS   = qw/size type values default not_null pos regex weight form_display form_size form_type form_names form_values time_check/;
    $VERSION       = sprintf "%d.%03d", q$Revision: 1.46 $ =~ /(\d+)\.(\d+)/;   
    $ERROR_PACKAGE = 'GT::SQL::Table';
    $ERROR_MESSAGE = 'GT::SQL';


# ============================================================================ #
#  TABLE ACCESSSOR                                                             #
# ============================================================================ #

sub table {
# -------------------------------------------------------------------
# Returns a table or relation argument. Called with array of table names:
#       my $relation = $db->table('Links', 'CatLinks', 'Category');
#       my $table    = $db->table('Links');
#
    my ($self, @tables) = @_;

# Make sure we have a driver, and a list of tables were specified.
    $self->{connect} or return $self->error ("NODATABASE", "FATAL", "table()");
    @tables          or return $self->error ("BADARGS", 'FATAL', 'Usage: $obj->table(@TABLES)');

    for (@tables) { # Tables aren't passed to table() prefixed, so prefix them all.
        $_ = $self->{connect}->{PREFIX} . $_;
    }
    my $cache_key = join ("\0", @tables, $self->{connect}->{def_path});
    $cache_key = (@tables > 1 ? "RELATION\0" : "TABLE\0") . $cache_key;
    $self->{cache} and exists $GT::SQL::OBJ_CACHE{$cache_key} and return $GT::SQL::OBJ_CACHE{$cache_key};
    
    my $obj;
    if (@tables > 1) {
        $obj = $self->new_relation(@tables);
    }
    else {
        my $name = $self->{connect}->{def_path} . '/' . $tables[0] . '.def';
        (-e $name) or return $self->error ("FILENOEXISTS", "FATAL", $name);
        $obj = $self->new_table($tables[0]);
    }
    # We don't need to worry about caching here - new_relation or new_table will add it to the cache.
    return $obj;
}

# ============================================================================ #
#  EDITOR ACCESSSOR                                                            #
# ============================================================================ #

sub editor {
# -------------------------------------------------------------------
# Returns an editor object. Takes a table name as argument.
#   my $editor = $db->editor('Links')
#
    my $self       = shift;
    my $table_name = shift or return $self->error ('BADARGS', 'FATAL', 'Usage: $db->editor("tablename")');

    $self->{connect}->{driver} or return $self->error ("NODATABASE", "FATAL", "editor()");

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

# Set the error package to reflect the editor
    $table->{_err_pkg}   = 'GT::SQL::Editor';
    $table->{_err_pkg}   = 'GT::SQL::Editor';

# Get an editor object
    require GT::SQL::Editor;
    $self->debug ("CREATING GT::SQL::Editor OBJECT") if ($self->{_debug} > 2);
    return GT::SQL::Editor->new (
                                debug   => $self->{_debug},
                                table   => $table,
                                connect => $self->{connect}
                            );
}

sub new_table {
# -------------------------------------------------------------------
# Creates the table object if the user is just using one table.
#
    my ($self, $table) = @_;
    
    my $cache_key = "TABLE\0$table\0$self->{connect}->{def_path}";
    if ($self->{connect}->{obj_cache} and my $cached = $GT::SQL::OBJ_CACHE{$cache_key}) {
        $self->debug("Returning table object for $table from cache") if $self->{_debug} and $self->{_debug} >= 2;
        return $cached;
    }

    $self->debug("Creating new table object for $table") if $self->{_debug} and $self->{_debug} >= 2;
# Create a blank table object.
    my $table_obj = GT::SQL::Table->new (
        name     => $table,             # Already prefixed in schema
        connect  => $self->{connect},
        debug    => $self->{_debug},
        _err_pkg => 'GT::SQL::Table'
    );

# Create a new object if we are subclassed.
    my $subclass = $table_obj->subclass;
    my $name     = $table_obj->name;
    my $class    = $subclass->{table}->{$name} || 'GT::SQL::Table';
    if ($subclass and $subclass->{table}->{$name}) {
        no strict 'refs';
        $self->_load_module ($class) or return;
        my $errors = defined ${$class . "::ERRORS"} ? ${$class . "::ERRORS"} : {};
        foreach (keys %$errors) {
            $ERRORS->{$_} = $errors->{$_};
        }
        use strict 'refs';
        $table_obj = $class->new (
            name     => $name,              # Already prefixed in schema
            connect  => $self->{connect},
            debug    => $self->{_debug},
            _err_pkg => 'GT::SQL::Table'
        );
    }
    $self->debug ("CREATING $class OBJECT") if $self->{_debug} and $self->{_debug} > 2;

    $GT::SQL::OBJ_CACHE{$cache_key} = $table_obj if $self->{connect}->{obj_cache};
    return $table_obj;
}

sub new_relation {
# -------------------------------------------------------------------
# Creates the table objects and relation object for multi-table tasks.
# Internal use. Call table instead.
#
    my ($self, @tables) = @_;
    my $href       = {};
    my $tables_ord = [];
    my $tables     = {};

    require GT::SQL::Relation;

    my $cache_key = join "\0", "RELATION", @tables, $self->{connect}->{def_path};
    if ($self->{connect}->{obj_cache} and my $cached = $GT::SQL::OBJ_CACHE{$cache_key}) {
        $self->debug("Returning relation object for @tables from cache") if $self->{_debug} and $self->{debug} >= 2;
        return $cached;
    }

# Build our hash of prefixed table name to table object.
    foreach my $table (@tables) {
        $self->debug ("CREATING GT::SQL::Table OBJECT") if $self->{_debug} and $self->{_debug} > 2;
        my $tmp  = $self->new_table ($table);
        my $name = $tmp->name;
        push @$tables_ord, $name;
        $tables->{$name} = $tmp;
    }

# Get our driver, class name and key to look up subclasses (without prefixes).
    my $class        = 'GT::SQL::Relation';
    my $prefix       = $self->{connect}->{PREFIX};
    my $subclass_key = join "\0", map { s/^$prefix//; $_ } sort keys %{$tables};

# Look for any subclass to use, and load any error messages.
    no strict 'refs';

    foreach my $table (values %{$tables}) {
        my $subclass = $table->subclass;
        if ((!exists $self->{subclass} or $self->{subclass}) and exists $subclass->{relation}->{$prefix . $subclass_key}) {
            $class = $subclass->{relation}->{$prefix . $subclass_key};
            my $errors = defined ${$class . "::ERRORS"} ? ${$class . "::ERRORS"} : next;
            foreach (keys %$errors) {
                $ERRORS->{$_} = $errors->{$_};
            }
        }
    }
    use strict 'refs';

# Load our relation object.
    $self->debug ("CREATING $class OBJECT") if $self->{_debug} and $self->{_debug} > 2;
    $self->_load_module ($class) or return;

    my $rel = $class->new (
          tables     => $tables,
          debug      => $self->{_debug},
          connect    => $self->{connect},
          _err_pkg   => 'GT::SQL::Relation',
          tables_ord => $tables_ord
     );
    $GT::SQL::OBJ_CACHE{$cache_key} = $rel if ($self->{connect}->{obj_cache});

    return $rel;

}

# ============================================================================ #
#  CREATOR ACCESSSOR                                                           #
# ============================================================================ #

sub creator {
# -------------------------------------------------------------------
# Returns a creator object. Takes a table name as argument.
#   my $creator = $db->creator('Links')
#
    my $self       = shift;
    my $table_name = shift or return $self->error ('BADARGS', 'FATAL', 'Usage: $db->creator("tablename")');
    $self->{connect}->{driver} or return $self->error ("NODATABASE", "FATAL", "creator()");
    my $name = $self->{connect}->{PREFIX} . $table_name;

# Create either an empty schema or use an old one.
    $self->debug ("Creating new GT::SQL::Table object '$table_name' to be used in Creator.") if ($self->{_debug} > 2);
    my $table = GT::SQL::Table->new(
                                    name     => $table_name,
                                    connect  => $self->{connect},
                                    debug    => $self->{_debug},
                                    _err_pkg => 'GT::SQL::Creator'
                                );

# Return a creator object.
    require GT::SQL::Creator;
    $self->debug ("CREATING GT::SQL::Creator OBJECT") if ($self->{_debug} > 2);
    return GT::SQL::Creator->new(
                                table   => $table,
                                debug   => $self->{_debug},
                                connect => $self->{connect}
                            );
}

sub AUTOLOAD {
# -------------------------------------------------------------
# This method provides get methods for all the cols attributes.
# It returns a hash reference of the column names to the value
# of the attribute for that attribute.
#
    my $self = $_[0];
    my ($pkg, $what) = $AUTOLOAD =~ /^(.*)::([^:]+)$/;

# Otherwise we have auto generated functions for each of the 
# column names.
    if (grep { $what eq $_ } @COL_ATTRIBS) {
        no strict 'refs';
        *{$AUTOLOAD} = sub {
            my $self = shift;
            my $h = {};
            foreach my $col (keys %{$self->{schema}->{cols}}) {
                if (exists $self->{schema}->{cols}->{$col}->{$what}) {
                    $h->{$col} = $self->{schema}->{cols}->{$col}->{$what};
                }
            }
            return wantarray ? %$h : $h;
        };
        return &{$AUTOLOAD}(@_);
    }

# Pass back to the GT::Base AUTOLOAD.
    $GT::Base::AUTOLOAD = $AUTOLOAD;
    goto &GT::Base::AUTOLOAD;
}

sub count {
# -------------------------------------------------------------------
# $obj->count;
# ------------
#   Returns the number of tuples handled
#   by this relation.
#
# $obj->count ($condition);
# -------------------------
#   Returns the number of tuples that matches
#   that $condition.
#
    my $self = shift;
    my $cond;
    if (ref $_[0] eq 'GT::SQL::Condition' or ref $_[0] eq 'HASH') { $cond = shift }
    elsif (not @_ % 2 and not ref $_[0] and defined ($_[0])) { $cond = {@_} }
    elsif (@_) {
        return $self->error('BADARGS', 'FATAL', 'Arguments to count() must either be a hash or a hash ref or GT::SQL::Condition object');
    }
    my $sth;
    my $sel_opts = $self->{sel_opts};
    $self->{sel_opts} = [];
    if ($cond) {
        $sth  = $self->select ($cond, ['COUNT(*)']) or return;
    }
    else {
        $sth  = $self->select (['COUNT(*)']) or return;
    }
    $self->{sel_opts} = $sel_opts;
    return $sth->fetchrow_arrayref->[0];
}

sub total { 
# -------------------------------------------------------------------
#       total()
#           IN : none
#           OUT: total number of records in table
#
    shift->count 
}

sub quote { 
# -------------------------------------------------------------------
# $obj->quote ($value);
# ---------------------
#   Returns the quoted representation of $value.
#
    return GT::SQL::Driver::quote (pop) 
}

sub hits {
# -----------------------------------------------------------
#       hits()
#           IN : none
#           OUT: number of results in last search. (calls count(*) on
#                demand from hits() or toolbar())
#
    my $self = shift;
    if (! defined $self->{last_hits}) {
        $self->{last_hits} = (defined ($self->{last_where}) ? $self->count($self->{last_where}) : $self->count()) || 0;
    }
    return $self->{last_hits};
}

sub _cgi_to_hash {
# -------------------------------------------------------------------
# Internal Use
# $self->_cgi_to_hash ($in);
# --------------------------
#   Creates a hash ref from a cgi object.
#
    my ($self, $cgi) = @_;
    (defined $cgi and ((ref $cgi) =~ /CGI/)) or return $self->error ('BADARGS', "FATAL", "$cgi is not a CGI object");

    my @keys = $cgi->param;
    my $result = {};
    foreach my $key (@keys) {
        my @values = $cgi->param ($key);
        if (@values == 1) { $result->{$key} = $values[0]; }
        else              { $result->{$key} = \@values;   }
    }
    return $result;
}

sub _get_search_opts {
# -------------------------------------------------------------------
# Internal Use
# _get_search_opts ($hash_ref);
# ----------------------------
#   Gets the search options based on the hash ref
#   passed in.
#
#   sb            => field_list     # Return results sorted by field list.
#   so            => [ASC|DESC]     # Sort order of results.
#   mh            => n              # Return n results maximum, default to 25.
#   nh            => n              # Return the n'th set of results, default to 1.
#
    my $self = shift;
    my $opt_r = shift;
    my $ret = {};
    $ret->{nh} = (defined $opt_r->{nh} and $opt_r->{nh} =~ /^(\d+)$/) ? $1 : 1;
    $ret->{mh} = (defined $opt_r->{mh} and $opt_r->{mh} =~ /^(-?\d+)$/) ? $1 : 25;
    $ret->{so} = (defined $opt_r->{so} and $opt_r->{so} =~ /^(ASC|DESC)$/i) ? $1 : '';
    $ret->{sb} = (defined $opt_r->{sb} and $opt_r->{sb} =~ /^([\w\s,]+)$/)  ? $1 : '';
    if (defined $ret->{rs} and ref $ret->{rs} eq 'ARRAY') {
        my @valid;
        foreach my $col (@{$ret->{rs}}) {
            $col =~ /^([\w\s,]+)$/ and push @valid, $1;
        }
        $ret->{rs} = \@valid;
    }
    else {
        $ret->{rs} = (defined $opt_r->{rs} and $opt_r->{rs} =~ /^([\w\s,]+)$/) ? $1 : '';
    }
    return $ret;
}

sub _build_query_cond {
# -------------------------------------------------------------------
# Builds a condition object based on form input.
#   field_name    => value      # Find all rows with field_name = value
#   field_name    => ">value"   # Find all rows with field_name > value.
#   field_name    => "<value"   # Find all rows with field_name < value.
#   field_name-gt => value      # Find all rows with field_name > value.
#   field_name-lt => value      # Find all rows with field_name < value.
#   field_name-ge => value      # Find all rows with field_name >= value.
#   field_name-le => value      # Find all rows with field_name <= value.
#   keyword       => value      # Find all rows where any field_name = value
#   query         => value      # Find all rows using GT::SQL::Search module
#   ww            => 1      # 1 => use = comparision, 0/unspecified => use LIKE '%value%' comparision
#   ma            => 1      # 1 => OR match 0/unspecified => AND match
#
    my ($self, $opts, $c) = @_;

    my $cond = new GT::SQL::Condition;
    my ($cmp, $l);
    ($cmp, $l) = $opts->{ww} ? ('=', '') : ('LIKE', '%');
    $opts->{ma} ? $cond->boolean ('OR')      : $cond->boolean ('AND');
    my $ins = 0;

# First find the fields and find what we 
# want to do with them.
    if (defined $opts->{query} and $opts->{query} =~ /\S/) {
        require GT::SQL::Search;
        my $search = GT::SQL::Search->load_search ({
                        %{$opts}, 
                        db      => $self->{driver},
                        table   => $self,
                        debug   => $self->{debug},
                        _debug  => $self->{_debug}
                        });
        my $sth = $search->query();
        $self->{last_hits}  = $search->rows();
        $self->{rejected_keywords} = $search->{rejected_keywords};
        return $sth;

    }
    elsif (defined $opts->{keyword} and ($opts->{keyword} ne "") and ($opts->{keyword} ne '*')) {
        my $val    = $opts->{keyword};
        my $is_dig = $val =~ /^[+-]*\d+\.?\d*$/;

        foreach my $field (keys %$c) {
            next unless (index($c->{$field}->{type}, 'DATE') == -1);        # No DATE fields.
            next unless (index($c->{$field}->{type}, 'TIME') == -1);        # No TIME fields.
            next unless (index($c->{$field}->{type}, 'ENUM') == -1);        # No ENUM fields.
            next if (!$is_dig and (index($c->{$field}->{type}, 'INT') != -1));     # No ints if not an int.
            next if (!$is_dig and (index($c->{$field}->{type}, 'DECIMAL') != -1)); # No ints if not an int.
            next if (!$is_dig and (index($c->{$field}->{type}, 'FLOAT') != -1));   # No ints if not an int.

            $cond->add ($field, $cmp, "$l$opts->{keyword}$l");
            $ins = 1;
        }
        $cond->bool('OR');
    }
    else {

# Go through each column and build condition.
        foreach my $field (keys %$c) {
            my $comp = $cmp;
            my $s    = $l;
            my @ins;
            if ($opts->{"$field-opt"}) {
                $comp = uc $opts->{"$field-opt"};
                $s    = (uc ($opts->{"$field-opt"}) eq 'LIKE') ? '%' : '';
            }
            else {
                if ($c->{$field}->{type} =~ /ENUM/i) {
                    $comp = '=';
                    $s = '';
                }
            }

# Comp can only be: =, <, >, <=, >=, <>, LIKE 
            $comp = $comp =~ /^(=|<=?|>=?|<>|LIKE)$/i ? $1 : '=';

            if (exists $opts->{"$field-gt"} and ($opts->{"$field-gt"} ne "")) {
                push @ins, [$field, '>', $opts->{$field . "-gt"}];
            }
            if (exists $opts->{"$field-lt"} and ($opts->{"$field-lt"} ne "")) {
                push @ins, [$field, '<', $opts->{$field . "-lt"}];
            }
            if (exists $opts->{"$field-ge"} and ($opts->{"$field-ge"} ne "")) {
                push @ins, [$field, '>=', $opts->{$field . "-ge"}];
            }
            if (exists $opts->{"$field-le"} and ($opts->{"$field-le"} ne "")) {
                push @ins, [$field, '<=', $opts->{$field . "-le"}];
            }

            if (exists $opts->{"$field-ne"} and ($opts->{"$field-ne"} ne "")) {
                if (ref $opts->{"$field-ne"} eq 'ARRAY') {
                    my $c = new GT::SQL::Condition;
                    $c->not;
                    $c->add($field => IN => $opts->{"$field-ne"});
                    push @ins, $c;
                }
                else {
                    push @ins, [$field, '<>', $opts->{$field . "-ne"}];
                }
            }
            if (exists $opts->{$field} and ($opts->{$field} ne "")) {
                if (ref($opts->{$field}) eq 'ARRAY' ) {
                    my $add = [];
                    for ( @{$opts->{$field}} ) {
                        next if !defined( $_ ) or !length( $_ ) or !/\S/;
                        push @$add, $_;
                    }
                    if ( @$add ) {
                        push @ins, [$field, 'IN', $add];
                    }
                }
                elsif ($opts->{$field} =~ /^(>|<|!)(.*)/) {
                    push @ins, [$field, ($1 eq '!') ? '<>' : $1, $2];
                }
                elsif ($opts->{$field} eq '+') {
                    push @ins, [$field, "<>", ''];
                }
                elsif ($opts->{$field} eq '-') {
                    push @ins, [$field, "=", ''];
                }
                elsif ($opts->{$field} eq '*') {
                    if ($opts->{"$field-opt"} and ($opts->{"$field-opt"} eq '<>')) {
                        push @ins, [$field, '=', ''];
                    }
                    else {
                        next;
                    }
                }
                else {
                    (index ($opts->{$field}, "\\") == 0) and (substr ($opts->{$field}, 0, 1) = "");
                    push @ins, [$field, $comp, "$s$opts->{$field}$s"];
                }
            }
            if (@ins) {
                for (@ins) {
                    $cond->add($_);
                }
                $ins = 1;
            }
        }
    }

    return $ins ? $cond : '';
}

sub _load_module {
# -------------------------------------------------------------------
# Loads a subclassed module.
#
    my ($self, $class) = @_;

    no strict 'refs';
    return 1 if (UNIVERSAL::can($class, 'new'));

    (my $pkg = $class) =~ s,::,/,g;
    my $ok  = 0;
    my @err = ();
    until ($ok) {
        local ($@, $SIG{__DIE__});
        eval { require "$pkg.pm" };
        if ($@) {
            push @err, $@;
            # In case the module had compile errors, %class:: will be defined, but not complete.
            undef %{$class . '::'} if defined %{$class . '::'};
        }
        else {
            $ok = 1;
            last;
        }
        my $pos = rindex($pkg, '/');
        $pos == -1 ? last : (substr($pkg, $pos) = "");
    }
    if (! $ok or ! UNIVERSAL::can($class, 'new')) {
        return $self->error ('BADSUBCLASS', 'FATAL', $class, join(", ", @err));
    }
    return 1;
}

1;