# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#       GT::SQL::Relation
#       Author  : Jean-Michel Hiver
#       $Id: Relation.pm,v 1.102 2004/08/28 03:53:43 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Utility modules that makes it possible to treat joins between
#   multiple tables almost as if it was a single table.
#

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

$ERROR_MESSAGE = 'GT::SQL';

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

sub DESTROY {}

sub new {
# -----------------------------------------------------------
# new GT::SQL::Relation (
#                        tables   => { table name => object }
#                        debug    => debug level,
#                        _err_pkg => package name,
#                       );
# -------------------------------------------------
#   Constructs (or returns if it already exists) a
#   new GT::SQL::Relation object with the parameters specified
#   above.
#
#
# new GT::SQL::Relation ( $hashref );
# ----------------------------------
#   Same thing, $hashref being a reference to a
#   hash which would be similar to what's above.
#
#
# $obj->new(LIST);
# -----------------
#   Internal use only. Creates a new Relation object from $obj
#   with list being a subset of the tables which are being
#   contained in $obj.
#
    my $class = shift;

    if (ref $class) {
        # if the first argument is a reference, then we assume that we
        # are constructing from a Relation object that handles all the
        # data that has to be passed in.
        my $this = $class;
        my $class = ref $class;

        my @tables = map { (ref $_) ? $_->{name} : $_ } @_;

        my $opts = {};
        $opts->{_debug}     = $this->{_debug} || $DEBUG;
        $opts->{_err_pkg}   = $this->{_err_pkg};
        $opts->{connect}    = $this->{connect};
        $opts->{tables}     = { map { $_ => $this->{tables}->{$_} } @tables };
        $opts->{tables_ord} = \@tables;

        return $class->new($opts);
    }
    else {
        my $self = bless {}, $class;
        my $opts = {};

        if (@_ == 1 and ref $_[0] eq 'HASH') { $opts = shift }
        elsif (@_ % 2 == 0) { $opts = { @_ } }
        else {
            $self->error("BADARGS", "FATAL", "new GT::SQL::Relation (HASH or HASHREF)");
        }

        # same thing for name - must be an array ref
        ref $opts->{tables} eq 'HASH' or
            return $self->error("BADARGS", "FATAL", "$class new(HASH_REF or HASH). name must be a ref to a list of table names.");

        $self->{_debug}     = $opts->{debug}    || $DEBUG;
        $self->{_err_pkg}   = $opts->{_err_pkg} if exists $opts->{_err_pkg};
        $self->{tables}     = $opts->{tables};
        $self->{connect}    = $opts->{connect};
        $self->{fk}         = {};

        # if an order was specified for the tables, use it, otherwise
        # sort the tables in lexicographical order.
        my @tables_ord = sort keys %{$self->{tables}};
        if ($opts->{tables_ord}) { @tables_ord = @{$opts->{tables_ord}} }

        $self->{tables_ord} = \@tables_ord;

        # this is a hash that has { $table names => $schema object }
        $self->{last_where} = undef;
        $self->{last_hits}  = undef;
        $self->debug("OBJECT CREATED") if ($self->{_debug} > 2);
        return $self;
    }
}

# ------------------------------------------------------------------------------------- #
# INSERT                                                                                #
# ------------------------------------------------------------------------------------- #

$COMPILE{insert} = __LINE__ . <<'END_OF_SUB';
sub insert {
# -----------------------------------------------------------
# $obj->insert($col1 => $val1,
#               ...,
#               $coln => $valn,
#             );
# -----------------------------
#   Will fill
#   the tables whenever it can according to the
#   insert parameters.
#
#   returns TRUE if insert succeeded,
#           FALSE otherwise.
#
# $obj->insert($hashref);
# ------------------------------
#   Same as above.
#
    my $self = shift;
    my $opts = (ref $_[0] eq 'HASH') ? shift : {@_};
    my $input = {};
    foreach my $key (keys %$opts) {
        $input->{$key} = $opts->{$key};
    }
    my $split = $self->_split_schema($input);
    my $added = $self->_insert($split);
    if (! $added) {
        $self->{_error} ||= [];
        for (values %{$self->{tables}}) {
            if (ref $_->{_error} eq 'ARRAY' and @{$_->{_error}}) {
                push(@{$self->{_error}}, @{$_->{_error}});
            }
        }
        return;
    }
    return $added;
}
END_OF_SUB

$COMPILE{add} = __LINE__ . <<'END_OF_SUB';
sub add {
# -----------------------------------------------------------
#   add() : Adds a record into the current relation object, and
#           returns a hash of primary key => value.
#
    my $self = shift;
    my $opts = (ref $_[0] eq 'HASH') ? shift : {@_};

    my $input = {};
    foreach my $key (keys %$opts) {
        $input->{$key} = $opts->{$key};
    }
    my $split = $self->_split_schema($input);
    my $added = $self->_add($split);
    if (!$added) {
        $self->{_error} ||= [];
        for (values %{$self->{tables}}) {
            if (ref $_->{_error} eq 'ARRAY' and @{$_->{_error}}) {
                push(@{$self->{_error}}, @{$_->{_error}});
            }
        }
        return;
    }
    return $added;
}
END_OF_SUB

# ------------------------------------------------------------------------------------- #
# SELECT                                                                                #
# ------------------------------------------------------------------------------------- #

sub select {
# -----------------------------------------------------------
# $obj->select;
# -------------
#   returns all rows from that relation (no where
#   condition).
#
# $obj->select($condition, \@select_returns);
# --------------------------------------------
#   $condition is a Condition or a
#   hash reference.
#
# $obj->select(\%columns, \@select_returns);
# -------------------------------------------
#   $col1 = $val1, $col2 = $val2
#
#   @select_returns is a list of the fields that
#   you wish returned. If none are specified all
#   fields will be returned.
#
    my $self = shift;
    $self->connect or return;

# Get a list of fields to select.
    my (@fields, @cond, $left_join);
    for (@_) {
        if (ref $_ eq 'ARRAY') { push @fields, @{$_};                   }
        elsif (not ref $_)     { ($_ eq 'left_join') ? ($left_join = 1) : push @fields, $_; }
        else                   { push @cond, $self->_build_cond($_);   }
    }
    @fields = map { $self->_complete_name($_) } grep { defined and length } @fields;
    @fields or (@fields = ('*'));

    my $fields      = join ',' => @fields;
    my $condition   = @cond > 1 ? GT::SQL::Condition->new(@cond) : $cond[0];

# building the join condition for this query
    my @relations = values %{$self->{tables}};
    my $join = $self->_join_query(\@relations);

# building the select options, if any
    my $sel_opts = '';
    if (defined $self->select_options) { $sel_opts = " " . join " ", $self->select_options }
    $self->{sel_opts} = undef;

# Any fk specifics
    $self->{fk} ||= {};
    my $orig_fk = {};
    for my $table (keys %{$self->{fk}}) {
        if (defined $self->{fk}->{$table}) {
            $orig_fk->{$table} = $self->{fk}->{$table};
            $self->{tables}->{$table}->{schema}->{fk}->{$table} = $self->{fk}->{$table};
        }
    }

    my $sql;
    if ($left_join) {
        my $tables = $self->{tables_ord}->[0] . ' LEFT OUTER JOIN ' . $self->{tables_ord}->[1] . ' ON ' . $join;
        my $cond_sql = '';
        if (defined $condition) {
            my $string = $condition->sql; # may be empty, never be paranoid enough
            $cond_sql = "WHERE ($string)" if $string;
        }

        $sql = qq!SELECT $fields FROM $tables $cond_sql!;
        $sql .= $sel_opts if $sel_opts;
    }
    else {
        my $tables = join ',' => sort keys %{$self->{tables}};
        my $cond_sql = '';
        if (defined $condition) {
            my $string = $condition->sql; # may be empty, never be paranoid enough
            $cond_sql = "($string)" if $string;
        }

        my $where = ($cond_sql or $join) ? "WHERE " : "";
        $where .= "$join " if $join;
        $where .= 'AND ' if $join and $cond_sql;
        $where .= "$cond_sql" if $cond_sql;
        $sql = qq!SELECT $fields FROM $tables $where!;
        $sql .= $sel_opts if $sel_opts;
    }

    my $sth = $self->{driver}->prepare($sql) or return;
    $sth->execute or return;

    $self->{last_hits} = undef;
    my $rows = $sth->rows;

# Attempt to optimize a possible later call to hits().  If there was no limit,
# it's the number of rows.  If there was a limit, and the rows returned was
# less than the limit (but still greater than 0), we can calculate it now
# without an additional query.
    if ($sel_opts =~ /\bLIMIT\s+(\d+)(?:\s+OFFSET\s+(\d+)|\s*,\s*(\d+))?|\bOFFSET\s+(\d+)\s+LIMIT\s+(\d+)/i) {
        my ($limit, $offset);
        if (defined($3)) { # MySQL-style, with an offset
            ($offset, $limit) = ($1, $3);
        }
        elsif ($1) {
            ($limit, $offset) = ($1, $2 || 0);
        }
        else {
            ($offset, $limit) = ($4, $5);
        }
        if ($rows > 0 and $rows < $limit) {
            $self->{last_hits} = $offset + $rows;
        }
    }
    else {
        $self->{last_hits} = $rows;
    }

    $self->{sel_opts} = [];

# Save the last query for future use.
    $self->{last_where} = $condition ? $condition->clone : undef;

    for ( keys %$orig_fk ) {
        $self->{tables}->{$_}->{schema}->{fk}->{$_} = $orig_fk->{$_};
    }
    $self->{fk} = {};
    return $sth;
}

$COMPILE{join_on} = __LINE__ . <<'END_OF_SUB';
sub join_on {
# -------------------------------------------------------------------
# Change how tables join
    my ( $self, $tb, %change ) = @_;
    my $p = $self->prefix;
    $tb = $p . $tb;
    return unless exists $self->{tables}{$tb};
    for my $table ( keys %change ) {
        my $cp = $p . $table;
        next unless exists $self->{tables}{$cp};
        $self->{tables}->{$tb}->{schema}->{fk}->{$cp} = $change{$table};
    }
}
END_OF_SUB

sub _join_query {
# -------------------------------------------------------------------
# Figures out the join clause between tables.
#
    my $self = shift;
    my $relations = shift;
    my %join;
    foreach my $relation (@$relations) {
        my $relation_name = $relation->{name};
        my @join_tables = keys %{$relation->{schema}->{fk}};
        foreach my $join_table (@join_tables) {
            if ($self->{tables}->{$join_table}) {
                my $fk = $relation->{schema}->{fk}->{$join_table};
                for my $key (keys %$fk) {
                    $join{"$relation_name.$key"} = "$join_table.$fk->{$key}" unless $relation_name eq $join_table; # Ignore foreign keys to the same table
                }
            }
        }
    }
    return join " AND ", map "$_ = $join{$_}", keys %join;
}

sub select_options {
# -----------------------------------------------------------
# $obj->select_options(@options);
# --------------------------------
#   @options should be a list of options you want
#   prepended to your search.
#
    my $self = shift;
    push @{$self->{sel_opts}}, @_ if @_ > 0;
    if (wantarray) { ($self->{sel_opts}) ? @{$self->{sel_opts}} : () }
    else           { ($self->{sel_opts}) ? $self->{sel_opts}    : [] }
}

$COMPILE{query} = __LINE__ . <<'END_OF_SUB';
sub query {
# -----------------------------------------------------------
# $obj->query($HASH or $CGI);
# ----------------------------
#   Performs a query based on the options in the hash.
#   $HASH can be a hash ref, hash or CGI object.
#
#   Returns the result of a query as fetchall_arrayref.
#
    my $self = shift;
    my $sth = $self->_query(@_) or return;
    return $sth->fetchall_arrayref;
}
END_OF_SUB

$COMPILE{query_sth} = __LINE__ . <<'END_OF_SUB';
sub query_sth {
# -----------------------------------------------------------
# $obj->query_sth($HASH or $CGI);
# --------------------------------
# Same as query but returns the sth object.
#
    shift->_query(@_)
}
END_OF_SUB

# ------------------------------------------------------------------------------------- #
# DELETE                                                                                #
# ------------------------------------------------------------------------------------- #

$COMPILE{delete} = __LINE__ . <<'END_OF_SUB';
sub delete {
# -----------------------------------------------------------
# $obj->delete($condition, $opt);
# --------------------------------
#   $condition is a condition on the current
#   join relation,
#
#   $opt is a string which can be either 'abort',
#   'ignore', or 'cascade'.
#
    my $self = shift;
    my $cond = shift;
    my $opt  = shift || 'cascade';

    $cond = $self->_build_cond($cond);

    $self->{last_where} = $cond ? $cond->clone : undef;

    my $rows;
    if ($opt eq 'ignore') {
        my $split = $self->_split_fields($cond);
        for (keys %{$split}) {
            $rows += $self->{$_}->delete($split->{$_}, 'ignore') or return;
        }
    }
    elsif ($opt eq 'abort') {
        my @ordered_columns = $self->col_names;
        my $q = $self->select(\@ordered_columns, $cond) or return;
        if (!$q->rows) {
            $rows = "0E0" unless ($q->rows);
        }
        else {
            while (my $array = $q->fetchrow_arrayref) {
                my $h = {};
                for (my $i = 0; $i < @ordered_columns; $i++) {
                    $h->{$ordered_columns[$i]} = $array->[$i];
                }
                foreach my $referencing ($self->_referencing_relations) {
                    unless ($self->_can_delete($h, $referencing)) {
                        return $self->error("DEPENDENCY", "WARN", $referencing);
                    }
                }
            }
            $rows = $self->_delete_cascade($cond->new_clean);
        }
    }
    elsif ($opt eq 'cascade') {
        $rows = $self->_delete_cascade($cond) or return;
    }
    return ($rows == 0) ? '0E0' : $rows;
}
END_OF_SUB

$COMPILE{delete_all} = __LINE__ . <<'END_OF_SUB';
sub delete_all {
# -----------------------------------------------------------
# deletes all the records in this relation
#
    my $self = shift;
    my $opt  = shift || 'abort';
    foreach my $rel ($self->_referencing_relations) { ($rel->delete_all($opt)) ? next : return }
    foreach my $rel ($self->_referenced_relations)  { ($rel->delete_all($opt)) ? next : return }
    return 1;
}
END_OF_SUB

# ------------------------------------------------------------------------------------- #
# UPDATE                                                                                #
# ------------------------------------------------------------------------------------- #

$COMPILE{update} = __LINE__ . <<'END_OF_SUB';
sub update {
# -----------------------------------------------------------
# $obj->update($hashref, $hashref);
# $obj->update($hashref, $condition);
# ------------------------------------
#   $hashref are the fields to update
#
#   $condition is a condition on the current
#   join relation.
#
#   A limitation exists: in a relation one to many,
#   it is not possible to perform an update on the
#   attributes that are in the "one" entity.
#
    my ($self, $hash, $cond) = @_;
    (ref $self and ref $hash and ref $cond) or $self->error("BADARGS", "FATAL", '$obj->update(HASH, GT::SQL::Condition or HASH)');
    $hash = $self->_split_schema($hash);

# removes noise values from _split_schema
    foreach my $rel_name (keys %{$hash}) {
        my $h = $hash->{$rel_name};
        if (defined $h) {
            foreach my $rel_col (keys %{$h}) { delete $h->{$rel_col} unless (defined $h->{$rel_col}) }
            delete $hash->{$rel_name} unless (keys %{$h});
        }
        else {
            delete $hash->{$rel_name};
        }
    }

    my @ordered_columns = $self->col_names;
    $cond = $self->_build_cond($cond);
    $self->{last_where} = $cond ? $cond->clone : undef;

    my $q = $self->select(@ordered_columns, $cond) or return;
    my @err = ();
    while (my $array = $q->fetchrow_arrayref) {
        my $h = {};
        for (my $i = 0; $i < @ordered_columns; $i++) {
            $h->{$ordered_columns[$i]} = $array->[$i]
        }

        for my $rel (values %{$self->{tables}}) {
            next unless defined $hash->{$rel->{name}};
            my ($upd, $rec) = ($hash->{$rel->{name}}, $h);
            my $allrec = $self->_split_schema($rec);
            my $rel_rec = $allrec->{$rel->{name}};

# from $rel_rec, a hashref needs to be built that isn't prefixed
# by the table name because GT::SQL::Table doesn't understand that
            my $rel_rec2 = {};
            my $prefix   = $rel->{name} . ".";
            foreach my $col (keys %{$rel_rec}) {
                my $col2 = $col;
                $col2 =~ s/^\Q$prefix\E//;
                $rel_rec2->{$col2} = $rel_rec->{$col};
            }

            $self->debug("Calling $rel->update") if ($self->{_debug} > 2);

            unless (defined $rel->update($upd, $rel_rec2)) {
                if ($GT::SQL::errcode eq 'UNIQUE') {
                    next;
                }
                push @err, $GT::SQL::error;
            }
        }
    }
    if (@err) {
        $GT::SQL::error = join "\n", @err;
        return;
    }
    else { return 1 }
}
END_OF_SUB

$COMPILE{modify} = __LINE__ . <<'END_OF_SUB';
sub modify {
# -----------------------------------------------------------
#   modify()
#       IN : hash/hash_ref/cgi/GT::CGI of col => val pairs to change.
#       OUT: 1 on success, undef on failure.
#
    my $self = shift;

    my $in = $self->common_param(@_);

    # first of all complete $in attributes
    my ($hash, $cond);
    for my $col (keys %$in) {
        if (my $completed = $self->_complete_name($col, 1)) {
            $hash->{$completed} = $in->{$col};
        }
    }

    # let's build the $condition
    my $condition = { map {
        $_ => $hash->{$_}
    } $self->pk };

    $hash = $self->_split_schema($hash);

# removes noise values from _split_schema
    foreach my $rel_name (keys %{$hash}) {
        my $h = $hash->{$rel_name};
        if (defined $h) {
            foreach my $rel_col (keys %{$h}) { delete $h->{$rel_col} unless (defined $h->{$rel_col}) }
            delete $hash->{$rel_name} unless (keys %{$h});
        }
        else {
            delete $hash->{$rel_name};
        }
    }

    my @ordered_columns = $self->col_names;

    $cond = $self->_build_cond($condition);
    $self->{last_where} = $cond ? $cond->clone : undef;

    my $q = $self->select(\@ordered_columns, $cond) or return;
    my @err = ();
    while (my $array = $q->fetchrow_arrayref) {
        my $h = {};
        for (my $i = 0; $i < @ordered_columns; $i++) {
            $h->{$ordered_columns[$i]} = $array->[$i]
        }


        for my $rel (values %{$self->{tables}}) {
            next unless defined $hash->{$rel->{name}};

# from $rel_rec, a hashref needs to be built that isn't prefixed
# by the table name because GT::SQL::Table doesn't understand that
            my $rel_rec = {};
            foreach my $col (keys %{$h}) {
                next unless $col =~ /^\Q$rel->{name}\E\./;
                my $col2 = $col;
                $col2 =~ s/^[^.]+\.//;
                $rel_rec->{$col2} = defined($hash->{$rel->{name}}->{$col2}) ? $hash->{$rel->{name}}->{$col2} : defined($hash->{$rel->{name}}->{$col}) ? $hash->{$rel->{name}}->{$col} : $h->{$col};
            }

            $self->debug("Calling $rel->update") if ($self->{_debug} > 2);
            unless (defined $rel->modify($rel_rec)) {
                if ($GT::SQL::errcode eq 'UNIQUE') {
                    next;
                }
                push @err, $GT::SQL::error;
            }
        }
    }
    if (@err) {
        $GT::SQL::error = join "\n", @err;
        return;
    }
    else { return 1 }
}
END_OF_SUB

# ------------------------------------------------------------------------------------- #
# COUNT/GET                                                                             #
# ------------------------------------------------------------------------------------- #

$COMPILE{get} = __LINE__ . <<'END_OF_SUB';
sub get {
# -----------------------------------------------------------
# $obj->get($condition, $opt);
# -----------------------------
#   $condition is the condition for the row that has to be
#   retrieved. $opt can be 'ARRAY' or 'HASH'. The first row
#   of the query is returned, which makes the get method
#   mostly useful to retrieve rows from the primary key
#   values.
#
    my $self = shift;
    my $cond = shift;
    if (ref $cond eq 'ARRAY') { $cond = { @{$cond} } }
    my $method  = shift || 'HASH';
    $method = (uc $method eq 'ARRAY') ? 'fetchrow_arrayref' : 'fetchrow_hashref';
    my $sth = $self->select($cond) or return;
    return $sth->$method();
}
END_OF_SUB

# ------------------------------------------------------------------------------------- #
# ACCESSSORS                                                                            #
# ------------------------------------------------------------------------------------- #

$COMPILE{cols} = __LINE__ . <<'END_OF_SUB';
sub cols {
# -----------------------------------------------------------
# $obj->cols;
# -----------
#   Returns the relation columns as a hash which has
#   the columns names as a key and their type as a
#   value.
#
    my $self = shift;
    my @res;
    if (@_) { $self->error('BADARGS', 'FATAL', '$obj->cols;') }

# if the number of table objects that handles the current
# relation object equals zero, then returns an empty hash.
    my @names = $self->name;
    if (@names == 0) { return {} }
    else {
        my $res = {};
        my @referencing = $self->_referencing_relations;
        my @referenced  = $self->_referenced_relations;
        if (@referenced) {

# if in the current Relation object there exists some
# tables which are referenced by other tables within
# the current relation object, then
            my %referenced_cols = $self->new(@referenced)->cols;
            my @referenced_cols = keys %referenced_cols;

# remove columns which are referenced by referencing
# tables because we don't wanna have these duplicates.
            my @rem_cols;
            foreach my $referencing (@referencing) {
                foreach my $target (keys %{$referencing->{schema}->{fk}}) {
                    if (defined $self->{tables}->{$target}) {
                        push @rem_cols, map { $target .'.'. $_ } keys %{$referencing->{schema}->{fk}->{$target}};
                    }
                }
            }
            my @cols_left = _minus(\@referenced_cols, \@rem_cols);
            map { $res->{$_} = $referenced_cols{$_} } @cols_left;
        }

# add then all low level columns, and return.
        foreach my $referencing (@referencing) {
            my %referencing_cols = %{$referencing->{schema}->{cols}};
            map { $res->{$referencing->{name} .'.'. $_} = $referencing_cols{$_} } keys %referencing_cols;
        }

        return $res unless wantarray;

# Wantarray has been set so create a copy of the res whose
# first and second level references can be clobbered.
# This assumes that the values side of the res will
# always been hashrefs
        my %res_copy = %$res;
        foreach my $res_name ( keys %res_copy ) {

            my %res_data = %{$res_copy{$res_name}};
            $res_copy{$res_name} = \%res_data;

            foreach ( keys %res_data ) {
                if ( ref $res_data{$_} eq 'HASH' ) {
                    $res_data{$_} = {%{$res_data{$_}}};
                }
                elsif ( ref $res_data{$_} eq 'ARRAY' ) {
                    $res_data{$_} = [@{$res_data{$_}}];
                }
            }
        }

        return %res_copy;
    }
}
END_OF_SUB

$COMPILE{col_names} = __LINE__ . <<'END_OF_SUB';
sub col_names {
# -----------------------------------------------------------
# Returns the columns names sorted the right order.
#
    my $self = shift;
    my %cols = $self->cols;
    return sort { my $ret = $self->_col_cmp($a, $b); $ret } keys %cols;
}
END_OF_SUB

# self explainatory
$COMPILE{ordered_columns} = __LINE__ . <<'END_OF_SUB';
sub ordered_columns { return shift->col_names(@_) }
END_OF_SUB

sub name {
# -----------------------------------------------------------
# $obj->name;
# -----------
#   Returns a list of current relation names
#
# $obj->name(@names);
# --------------------
#   Returns a list of objects maching specified name.
#
    my $self = shift;
    if (@_) {
        return map $self->{tables}->{$_}, @_
    }
    else    {
        my @names = keys %{$self->{tables}};
        return wantarray ? @names : \@names;
    }
}

$COMPILE{unique} = __LINE__ . <<'END_OF_SUB';
sub unique {
# -----------------------------------------------------------
# $obj->unique;
# -------------
#   Returns an array containing all the array refs
#   for all the uniques.
#
# $obj->unique($field_name);
# ---------------------------
#    Returns true if the field is unique. False otherwise.
#
    my $self = shift;
    my @res = ();
    foreach my $table_name (sort keys %{$self->{tables}}) {
        my $table = $self->{tables}->{$table_name};
        my %unq = %{$table->{schema}->{unique}};
        foreach my $unq (values %unq) { push @res, [ map { $table_name . "." . $_ } @{$unq} ] }
    }
    if (@_ == 1) {
        my $s = shift;
        return scalar grep { $s eq $_ } map { @{$_} } @res;
    }
    return wantarray ? @res : \@res;
}
END_OF_SUB

$COMPILE{index} = __LINE__ . <<'END_OF_SUB';
sub index {
# -----------------------------------------------------------
# $obj->index;
# ------------
#   Returns an array containing all the array refs
#   for all the indexes.
#
    my $self = shift;
    if (@_ == 0) {
        my @res = ();
        foreach my $table_name (sort keys %{$self->{tables}}) {
            my $table = $self->{tables}->{$table_name};
            my @idx = values %{$table->{schema}->{index}};
            foreach my $idx (@idx) { push @res, [ map { $table_name . "." . $_ } @{$idx} ] }
        }
        return wantarray ? @res : \@res;
    }
    else { return $self->error('BADARGS', 'FATAL', '$obj->index;') }
}
END_OF_SUB

$COMPILE{pk} = __LINE__ . <<'END_OF_SUB';
sub pk {
# -----------------------------------------------------------
# $obj->pk;
# ---------
#   This method returns the columns reprensenting what
#   would be the primary key of our JoinRelation if it
#   ever existed.
#
#   Tables which are referenced by other tables primary
#   key shall not be exported, because they are the 'one'
#   entities in a one-to-many relation.
#
# $obj->pk($field_name);
# -----------------------
#   Returns true if the field is in the primary
#   key list. Returns false otherwise.
#
    my $self = shift;
    if (@_ == 0) {
        my @result = ();
        my @referencing = $self->_referenced_relations;
        foreach my $referencing (@referencing) { push @result, map { $referencing->{name} .'.'. $_ } @{$referencing->{schema}->{pk}}; }
        return sort { my $ret = $self->_col_cmp($a, $b); $ret; } @result;
    }
    elsif (@_ == 1) {
        my $name = $self->_complete_name(shift);
        return scalar grep { $name eq $_ } @{$self->{schema}->{pk}};
    }
    else { $self->error('BADARGS', 'FATAL', '$obj->pk;') }
}
END_OF_SUB

$COMPILE{fk} = __LINE__ . <<'END_OF_SUB';
sub fk {
# -----------------------------------------------------------
# $obj->fk;
# ---------
#   returns a list of relation names which are referenced
#   by the current relation.
#
# $obj->fk(RELATION_NAME);
# -------------------------
#   returns a hashref for relation RELATION_NAME which
#   keys are the current relation "source" schema and which
#   values are the "target" schema.
#
    my $self = shift;
    if (@_ > 1) { $self->error('BADARGS', 'FATAL', '$obj->fk; or $obj->fk($table_name)') }
    if (@_ == 1) {
        my $res = {};
        my $target = shift;
        foreach my $rel (values %{$self->{tables}}) {
            foreach my $rel_target (keys %{$rel->{schema}->{fk}}) {
                if ($target eq $rel_target) {
                    my $h = $rel->{schema}->{fk}->{$rel_target};
                    foreach my $k (keys %{$h}) { $res->{$rel->{name} .'.'. $k} = $h->{$k} }
                }
            }
        }
        return wantarray ? %{$res} : $res;
    }
    else {
        my @res;
        foreach my $rel (values %{$self->{tables}}) {
            foreach my $fk (keys %{$rel->{schema}->{fk}}) {
                push @res, $fk unless ($self->{tables}->{$fk});
            }
        }
        return wantarray ? @res : \@res;
    }
}
END_OF_SUB

$COMPILE{fk_tables} = __LINE__ . <<'END_OF_SUB';
sub fk_tables {
# -----------------------------------------------------------
# $obj->fk_tables;
# ----------------
#   Returns a list of table that reference any
#   of the table that's in the current joinrelation.
#
# $obj->fk_tables($table_name);
# ------------------------------
#   Returns true if $table_name is the name of a
#   table that's referencing any of the tables that's
#   in the current joinrelation.
#
    my $self = shift;
    my @result = $self->_minus( [ map { @{$_->{schema}->{fk_tables}} } values %{$self->{tables}} ], [ $self->name ] ); # very evil (c)
    if (@_ == 1) {
        my $check = shift;
        return scalar grep { $check eq $_ } @result;
    }
    return wantarray ? @result : \@result;
}
END_OF_SUB

$COMPILE{all_indexes} = __LINE__ . <<'END_OF_SUB';
sub all_indexes {
# -----------------------------------------------------------
# $obj->all_indexes;
# ------------------
#   Returns an array reference with all the array refs
#   from the indexes and the uniques.
#
    my $self = shift;
    return wantarray ? [@{$self->unique}, @{$self->index}] : @{$self->unique}, @{$self->index};
}
END_OF_SUB

$COMPILE{ai} = __LINE__ . <<'END_OF_SUB';
sub ai {
# -----------------------------------------------------------
# ai makes no sense in a Relation therefore I return nothing
#
    my $self = shift;
    my @res;
    foreach my $rel (values %{$self->{tables}}) {
        my $ai = $rel->{schema}->{ai} or next;
        $ai = $rel->{name} . '.' . $ai;
        push @res, $ai;
    }
    return unless @res;
    return wantarray ? @res : \@res;

}
END_OF_SUB

# ------------------------------------------------------------------------------------- #
# INTERNAL METHODS                                                                      #
# ------------------------------------------------------------------------------------- #

$COMPILE{_build_cond} = __LINE__ . <<'END_OF_SUB';
sub _build_cond {
# -----------------------------------------------------------
# this subroutine is made to build conditions which may not
# be a Condition object for selects and deletes.
#
    my ($self, $condition) = @_;
    my $prefix = $self->{connect}->{PREFIX};
    if (! defined $condition) {
        return;
    }
    elsif (ref $condition eq 'HASH') {
        my $tmp = new GT::SQL::Condition;
        while (my ($col, $val) = each %$condition) {
            $col = $self->_complete_name($col);
            $tmp->add($col => '=' => $val);
        }
        return $tmp;
    }
    elsif (ref $condition eq 'ARRAY') {
        my $tmp = new GT::SQL::Condition (@{$condition});
        return $tmp;
    }
    elsif (length $prefix and (ref $condition eq 'GT::SQL::Condition')) {
        $self->_build_prefixed_cond($prefix, $condition);
        return $condition;
    }
    else {
        return $condition;
    }
}
END_OF_SUB

$COMPILE{_build_prefixed_cond} = __LINE__ . <<'END_OF_SUB';
sub _build_prefixed_cond {
# -----------------------------------------------------------
# $obj->_build_prefixed_cond($prefix, $cond)
# ---------------------------------
#
    my ($self, $prefix, $condition) = @_;
    foreach (@{$condition->{cond}}) {
        if (ref $_ eq 'ARRAY') {
            if ($_->[0] =~ /^[\w\.]+$/) {
                $_->[0] = $self->_complete_name($_->[0]);
            }
        }
        elsif (ref $_ eq 'GT::SQL::Condition') {
            $self->_build_prefixed_cond($prefix, $_);
        }
    }
    return $condition;
}
END_OF_SUB

$COMPILE{_complete_name} = __LINE__ . <<'END_OF_SUB';
sub _complete_name {
# -----------------------------------------------------------
# Returns a Table.Attribute name of a column given Attribute, if possible.
# Takes an optional second argument - if passed and true, seeing 'abc.xyz' will
# return undef if 'abc' isn't a valid table.  Without the true second argument,
# such a situation causes a fatal error.
#
    my $self = shift;
    my $col  = shift or return $self->error('BADARGS', 'FATAL', "No column name specified.");
    my $ignore_unknown = shift;

# if column name is a scalar reference, just throw in the raw colname
    ref $col eq 'SCALAR' and return $$col;

# try to handle fully qualified column names
    my ($relname, $colname) = split /\./, $col;
    if ($relname and $colname) {
        if (exists $self->{tables}->{$relname}) {
            return $col;
        }
        else {
            my $prefix = $self->{connect}->{PREFIX};
            if (exists $self->{tables}->{$prefix.$relname}) {
                return $prefix.$relname.".".$colname;
            }
            elsif ($ignore_unknown) {
                return undef;
            }
            else {
                return $self->error('BADCOLS', 'FATAL', $col);
            }
        }
    }

# Otherwise, no . in column name.
    my $found  = 0;
    my $return = $col;
    foreach my $rel (values %{$self->{tables}}) {
        my %h = %{$rel->{schema}->{cols}};
        if (exists $h{$col}) {
            $found++;
            $return = $rel->{name} . '.' . $col;
        }
    }
    if ($found > 1) {
        return $self->error('BADCOLS', 'FATAL', $col);
    }
    return $return;
}
END_OF_SUB

$COMPILE{_col_cmp} = __LINE__ . <<'END_OF_SUB';
sub _col_cmp {
# -----------------------------------------------------------
# $a is something like TABLE.COL
# this method is used to sort the columns in the right order.
#
    my ($self, $a, $b) = @_;

    $a and !$b  and return -1;
    $b and !$a  and return 1;
    !$a and !$b and return 0;

    my $one  = $self->_complete_name($a);
    my $two  = $self->_complete_name($b);
    my ($one_tab, $one_col) = split /\./, $one;
    my ($two_tab, $two_col) = split /\./, $two;

    if ($one_tab eq $two_tab) {
        return 0 if (!$one_tab or !$two_tab);
        return ($self->{tables}->{$one_tab}->{schema}->{cols}->{$one_col}->{pos} <=> $self->{tables}->{$one_tab}->{schema}->{cols}->{$two_col}->{pos});
    }
    else {
        my @tables_ord = @{$self->{tables_ord}};
        while (my $table = shift(@tables_ord)) {
            if ($table eq $one_tab) { return -1 }
            if ($table eq $two_tab) { return 1 }
        }
        return 0;
    }
}
END_OF_SUB

$COMPILE{_insert} = __LINE__ . <<'END_OF_SUB';
sub _insert {
# -----------------------------------------------------------
# $obj->_insert($split);
# --------------------------------
#   Inserts a record in the current Relation
#   inserting where it's possible to.
#
    my $self = shift;
    my $split = shift;

    my @referenced  = $self->_referenced_relations;
    my @referencing = $self->_referencing_relations;

    my (%added, $err);
    foreach my $rel (@referenced) {
        $self->{tables}->{$rel->{name}}->_check_insert($split->{$rel->{name}}) or return;
        my $sth = $rel->insert($split->{$rel->{name}}) or return;
        unless ($sth) {
            my $errcode = $GT::SQL::errcode;
            if ($errcode ne 'UNIQUE') { $err = 1; last }
            else { next }
        }
        if ($rel->{schema}->{ai}) {
            $added{$rel->{name}} = { $rel->{schema}->{ai} => $sth->insert_id };
        }
        else {
            $added{$rel->{name}} = $split->{$rel->{name}};
        }
    }
    if ($err) {
        for my $rel_name (keys %added) {
            my $rel = $self->{tables}->{$rel_name};
            my $id  = $added{$rel_name};
            $rel->delete($id);
        }
        return;
    }
    foreach my $rel (@referencing) {
        my %fk   = %{$rel->{schema}->{fk}};
        my $name = $rel->{name};

        for my $ft (keys %fk) {
            if (exists $added{$ft} and $self->{tables}->{$ft}->{schema}->{ai}) {
                my $h   = $fk{$ft};
                my $rec = $self->{tables}->{$ft};
                for (keys %{$h}) {
                    unless ($split->{$name}->{$_}) {
                        if ($h->{$_} eq $rec->{schema}->{ai}) {
                            $split->{$name}->{$_} = $added{$ft}->{$h->{$_}};
                        }
                    }
                }
            }
        }
        my $sth = $rel->insert(%{$split->{$name}});
        unless ($sth) { $err = 1; last; }
        if ($rel->{schema}->{ai}) {
            $added{$rel->{name}} = { $rel->{schema}->{ai} => $sth->insert_id };
        }
        else {
            $added{$rel->{name}} = $split->{$name};
        }
    }
    if ($err) {
        for my $rel_name (keys %added) {
            my $rel = $self->{tables}->{$rel_name};
            my $id  = $added{$rel_name};
            $rel->delete($id);
        }
        return;
    }

# Return a hash ref of primary key => value.
    my %ids;
    foreach my $column_hash (values %added) {
        foreach my $col (keys %{$column_hash}) {
            $ids{$col} = $column_hash->{$col};
        }
    }
    return \%ids;
}
END_OF_SUB

$COMPILE{_add} = __LINE__ . <<'END_OF_SUB';
sub _add {
# -----------------------------------------------------------
# $obj->_insert($split);
# --------------------------------
#   Inserts a record in the current Relation
#   inserting where it's possible to.
#
    my $self = shift;
    my $split = shift;
    my @referenced  = $self->_referenced_relations;
    my @referencing = $self->_referencing_relations;

    my (%added, $err);
    foreach my $rel (@referenced) {
        $self->{tables}->{$rel->{name}}->_check_insert($split->{$rel->{name}}) or return;
        my $id = $rel->add($split->{$rel->{name}}) or return;
        unless ($id) {
            my $errcode = $GT::SQL::errcode;
            if ($errcode ne 'UNIQUE') { $err = 1; last }
            else { next }
        }
        if ($rel->{schema}->{ai}) {
            $added{$rel->{name}} = { $rel->{schema}->{ai} => $id };
        }
        else {
            $added{$rel->{name}} = $split->{$rel->{name}};
        }
    }
    if ($err) {

        for my $rel_name (keys %added) {
            my $rel = $self->{tables}->{$rel_name};
            my $id  = $added{$rel_name};
            $rel->delete($id);
        }
        return;
    }
    foreach my $rel (@referencing) {
        my %fk   = %{$rel->{schema}->{fk}};
        my $name = $rel->{name};

        for my $ft (keys %fk) {
            if (exists $added{$ft} and $self->{tables}->{$ft}->{schema}->{ai}) {
                my $h   = $fk{$ft};
                my $rec = $self->{tables}->{$ft};
                for (keys %{$h}) {
                    unless ($split->{$name}->{$_}) {
                        if ($h->{$_} eq $rec->{schema}->{ai}) {
                            $split->{$name}->{$_} = $added{$ft}->{$h->{$_}};
                        }
                    }
                }
            }
        }
        my $id = $rel->add($split->{$name});
        unless ($id) { $err = 1; last; }
        if ($rel->{schema}->{ai}) {
            $added{$rel->{name}} = { $rel->{schema}->{ai} => $id };
        }
        else {
            $added{$rel->{name}} = $split->{$name};
        }
    }
    if ($err) {
        for my $rel_name (keys %added) {
            my $rel = $self->{tables}->{$rel_name};
            my $id  = $added{$rel_name};
            $rel->delete($id);
        }
        return;
    }

# Return a hash ref of primary key => value.
    my %ids;
    foreach my $table_name ( keys %added ) {
        foreach my $col (keys %{$added{$table_name}}) {
            $ids{"$table_name.".$col} = $added{$table_name}->{$col};
        }
    }

    return \%ids;
}
END_OF_SUB

$COMPILE{_minus} = __LINE__ . <<'END_OF_SUB';
sub _minus {
# -----------------------------------------------------------
# _minus($ary1, $ary2);
# ----------------------
#  $ary1 and $ary2 being two array refs,
#  returns a list of all elements in $ary1
#  which are not in $ary2.
#
    my ($self, $ary1, $ary2);
    if (@_ == 0 || @_ == 1) { return }
    elsif (@_ == 2) { ($ary1, $ary2) = @_ }
    else { ($self, $ary1, $ary2) = @_ }
    my @a1 = @{$ary1};
    my @a2 = @{$ary2};
    my @result;
    foreach my $elt1 (@a1) {
        my $push = 1;
        foreach my $elt2 (@a2) {
            $push = 0 if ($elt1 eq $elt2);
        }
        push @result, $elt1 if ($push == 1);
    }
    return @result;
}
END_OF_SUB

$COMPILE{_query} = __LINE__ . <<'END_OF_SUB';
sub _query {
# -----------------------------------------------------------
# $self->_query;
# --------------
#   This function takes in special query arguments and turns them
#   into a $opts array before doing the actual select on the
#   database.
#
    my $self = shift;
    scalar $self->name() or return $self->error("NOTABLE", "FATAL");
    my $opts = $self->common_param(@_) or return $self->error('BADARGS', 'FATAL', '$obj->_query( HASH or HASH_REF or CGI ) only.');


# Strip out values that are empty or blank (as query is generally
# derived from cgi input).
    my %input = map { $_ => $opts->{$_} } grep { defined $opts->{$_} and $opts->{$_} =~ /\S/ } keys %$opts;
    $opts = \%input;

# Prefix column names.
    foreach my $field (keys %$opts) {
        if ($field =~ /^(.*)-(gt|lt|le|ge|opt)$/) {
            my $opt  = $2;
            if (my $full = $self->_complete_name("$1", 1)) {
                $opts->{"$full-$opt"} = $opts->{$field};
            }
        }
        else {
            if (my $full = $self->_complete_name($field, 1)) {
                $opts->{$full} = $opts->{$field};
            }
        }
    }

# Set search options and get query condition.
    my $in       = $self->_get_search_opts($opts);
    my $cond     = $self->build_query_cond($opts, scalar $self->cols);

    my $offset   = ($in->{nh} - 1) * $in->{mh};
    $self->select_options("ORDER BY $in->{sb} $in->{so}") if ($in->{sb});
    $self->select_options("LIMIT $in->{mh} OFFSET $offset")     unless ($in->{mh} == -1);
    my @sel = ();
    if ($cond)               { push @sel, $cond }
    if ($in->{rs} and $cond) { push @sel, $in->{rs} }
    if ($opts->{left_join} and $cond) { push @sel,'left_join' }
    my $sth = $self->select(@sel) or return;
    return $sth;
}
END_OF_SUB

$COMPILE{_split_schema} = __LINE__ . <<'END_OF_SUB';
sub _split_schema {
# -----------------------------------------------------------
# $obj->_split_schema($hashref);
# -------------------------------
#   Turns { Table1.Attribute1 => value1,
#         Table1.Attribute2 => value2,
#         Table2.Attribute1 => value3 }
#
#   into  { Table1 => { Attribute1 => value1,
#                       Attribute2 => value2 }
#           Table2 => { Attribute1 => value1 } }
#
# $obj->_split_schema($col1 => $val1,
#                      ...,
#                      $coln => $valn);
#
# it also looks if a field is referencing
# another, and if so duplicates the field
# key and value in the target table provided
# that this target table is in the current
# relation object.
#
    my $self = shift;
    my $arg;
    if (ref $_[0] eq 'HASH') { $arg = shift }
    elsif (not @_ % 2 and defined $_[0]) { $arg = {@_} }
    else { return $self->error('BADARGS', 'FATAL', '$self->_split_schema(%hash)') }
    my $result = {};

# first of all, some of the fields may not be specifying
# the table they belong to.
    foreach my $col (keys %{$arg}) {
        if (my $relname = $self->_complete_name($col, 1)) {
            $arg->{$relname} = delete $arg->{$col};
        }
    }

# then, we separate fields in function of
# the table name that they have.
    foreach my $complete_field (keys %{$arg}) {
        next if (CORE::index($complete_field, '.') == -1);
        my ($tablename, $fieldname) = split /\./, $complete_field;
        $result->{$tablename} = {} unless (defined $result->{$tablename});
        $result->{$tablename}->{$fieldname} = $arg->{$complete_field};
    }

# then, for each relation in our join object, complete
# names in $result
    foreach my $relation (values %{$self->{tables}}) {
        my $relation_name = $relation->{name};

    # for all $relation foreign keys which are in $self
        my %target_relation_names = %{$relation->{schema}->{fk}};

        foreach my $target_relation_name (keys %target_relation_names) {

    # if the target relation exists in our join relation
    # object and in our $hash
            if (defined $self->{tables}->{$target_relation_name} and defined $result->{$target_relation_name}) {

    # then in $hash we set the values of the fields
    # for the target relation depending on the values
    # of the source relation.
                my $fk = $relation->{schema}->{fk}->{$target_relation_name};
                foreach my $key (keys %{$fk}) {
                    my $value = $fk->{$key};
                    $result->{$target_relation_name} = {} unless defined $result->{$target_relation_name};

                    my $fk_key = $relation->{schema}->{fk}->{$target_relation_name}->{$key};
                    $result->{$relation_name}->{$key} = $result->{$target_relation_name}->{$fk_key}
                        if defined $result->{$target_relation_name}->{$fk_key};
                }
            }
        }
    }
    return $result;
}
END_OF_SUB

$COMPILE{_referenced_relations} = __LINE__ . <<'END_OF_SUB';
sub _referenced_relations {
# -----------------------------------------------------------
# $obj->_top_level_relations;
# ---------------------------
#   This method returns the relations in the current
#   which are referenced by other tables in the current join
#   relation.
#
    my $self = shift;
    my %names = map { $_ => 1 } keys %{$self->{tables}};
    foreach my $rel (values %{$self->{tables}}) {
        foreach my $fk (keys %{$rel->{schema}->{fk}}) {
            delete $names{$fk} unless ($fk eq $rel->{name})
        }
    }
    my @referenced  = _minus([ values %{$self->{tables}} ], [ map {$self->{tables}->{$_}} keys %names ]);
    return @referenced;
}
END_OF_SUB

$COMPILE{_referencing_relations} = __LINE__ . <<'END_OF_SUB';
sub _referencing_relations {
# -----------------------------------------------------------
# $obj->_referencing_relations;
# -----------------------------
#   This method returns the tables in the current
#   relation which are not referenced by any other
#   tables in this relation.
#
    my $self = shift;
    my %names = map { $_ => 1 } keys %{$self->{tables}};
    foreach my $rel (values %{$self->{tables}}) {
        foreach my $fk (keys %{$rel->{schema}->{fk}}) {
            delete $names{$fk} unless ($fk eq $rel->{name})
        }
    }
    return map {$self->{tables}->{$_}} keys %names;
}
END_OF_SUB

$COMPILE{_delete_cascade} = __LINE__ . <<'END_OF_SUB';
sub _delete_cascade {
# -----------------------------------------------------------
# $obj->_delete_cascade($cond);
# ------------------------------
#   This method is used internaly to delete all the rows
#   that match $cond for that joinrelation object.
#
    my $self = shift;
    my $count = 0;

    my @ordered_columns = $self->col_names;
    my $q = $self->select(\@ordered_columns, @_) or return;
    while (my $array = $q->fetchrow_arrayref) {
        $count++;

# for each row that matches the condition
        my $h = {};
        for (my $i = 0; $i < @ordered_columns; $i++) {
            $h->{$ordered_columns[$i]} = $array->[$i];
        }

# delete each low-level table rows (i.e. referencing tables)
        foreach my $referencing ($self->_referencing_relations) {
            $self->_delete_row($h, $referencing);
        }

# then delete each top-level table rows, if possible
# this may be broken when using tables with hierarchy
# level > 2.
        foreach my $referenced ($self->_referenced_relations) {
            if ($self->_can_delete($h, $referenced)) { $self->_delete_row($h, $referenced) }
        }
    }
    return $count == 0 ? "0E0" : $count;
}
END_OF_SUB

$COMPILE{_can_delete} = __LINE__ . <<'END_OF_SUB';
sub _can_delete {
# -----------------------------------------------------------
# $obj->_can_delete($record, $relation);
# ---------------------------------------
#   Returns true if the record can be deleted
#   from this relation without breaking dependancies
#   or false otherwise.
#
    my ($self, $rec, $rel) = (@_);
    ref $rel or $rel = $self->{tables}->{$rel};

    my $allrec = $self->_split_schema($rec);
    my $rel_rec = $allrec->{$rel->{name}};

# for all the schemas that exist in the database
    foreach my $schema (keys %GT::SQL::Table::DATABASE) {
        $self->debug("CREATING A NEW TABLE OBJECT") if ($self->{_debug} > 2);

        my $relation = $self->new_table($schema);
        foreach my $relation_targetname ($relation->{schema}->{fk}) {
            if ($relation_targetname eq $rel->{name}) {
                my $schem = $relation->{schema}->{fk}->{$relation_targetname};

# I must make a copy of this because it's a reference from Schema
# and can potentially be used later, therefore it should not be
# modified.
                my $schema = { map { $_ => $schem->{$_} } keys %{$schem} };
                foreach my $key (keys %{$schema}) { $schema->{$key} = $rel_rec->{$schema->{$key}} }
                $relation->count($schema) and return 0;
            }
        }
    }
    return 1;
}
END_OF_SUB

$COMPILE{_delete_row} = __LINE__ . <<'END_OF_SUB';
sub _delete_row {
# -----------------------------------------------------------
# $obj->_delete_row($record, $relation);
# ---------------------------------------
#
    my ($self, $rec, $rel) = (@_);
    my $allrec = $self->_split_schema($rec);
    my $rel_rec = $allrec->{$rel->{name}};
    foreach my $col (keys %{$rel_rec}) { delete $rel_rec->{$col} unless (defined $rel_rec->{$col}) }
    $rel->delete($rel_rec, 'cascade');
}
END_OF_SUB

$COMPILE{_file_cols} = __LINE__ . <<'END_OF_SUB';
sub _file_cols {
#-------------------------------------------------------------------------------
    my $self    = shift;
    $_[0] and $self->{_file_cols} = undef;
    $self->{_file_cols} and return %{$self->{_file_cols}};
    my %rec     = ();
    for my $table_name ( keys %{$self->{tables} } ) {
        my %trec = $self->{tables}->{$table_name}->_file_cols() or next;
        $rec{$table_name} = \%trec;
    }
    return %rec;
}
END_OF_SUB

1;

__END__

=head1 NAME

GT::SQL::Relation - manage multiple table joins

=head1 SYNOPSIS

    my $relation = $DB->table('Company', 'Employees');
    my $sth = $relation->select( {
                    Company.Name => 'Gossamer Threads',
                    Employees.Name => 'Alex Krohn'
                }, ['Employees.Salary', 'Company.City'] );
    my ($salary, $city) = $sth->fetchrow_array;
    print "Alex works in $city and earns $salary!\n";

=head1 DESCRIPTION

This module aims at emulating a set of tables that are related to each other
via the use of foreign keys just as if it was one big table.

The module interface should be as compatible as possible with GT::SQL::Table,
thus you should be familiar with GT::SQL::Table before even reading this.

This documentation explains the differences between GT::SQL::Relation and
GT::SQL::Table and how the module internally works as well.

=head2 How it works

GT::SQL supports the concept of foreign keys (also known as external
references). Basically, two tables that are linked together using external
references can look like that:

    .-------------.      .---------.
    | EMPLOYEE    |      | COMPANY |
    `-------------'      `---------'
    |  ID         |   .--->ID      |
    |  COMPANY_ID ----'  | NAME    |
    |  NAME       |      `---------'
    |  SALARY     |
    `-------------'

In this example, the COMPANY_ID attribute relates the fact that a an EMPLOYEE
belongs to such or such COMPANY.

Utilizing a Relation object can make these tables look like that:

    .----------------------.
    | EMPLOYEE-COMPANY     |
    `----------------------'
    |  EMPLOYEE.ID         |
    |  EMPLOYEE.COMPANY_ID |
    |  EMPLOYEE.NAME       |
    |  EMPLOYEE.SALARY     |
    |  COMPANY.NAME        |
    `----------------------'

The first thing that can be seen from there is that COMPANY.ID has disappeared
from this "Virtual" table.

Indeed, as for a given "joined" record this value must be the same in both
tables, representing the values twice would have been a useless source of
confusion.

=head2 SELECT statements

Selecting from a Relation object is pretty simple using the GT::SQL module. As
the interface is (almost) the same as L<GT::SQL::Table>, the GT::SQL wrapper
returns Table or Relation objects depending on the arguments that are passed to
table.

    # This gives me a GT::SQL::Table object for
    # the EMPLOYEE table.
    my $emp = $sql->table('EMPLOYEE');

    # This gives me a GT::SQL::Relation object for
    # the relation EMPLOYEE-COMPANY tables
    my $emp_cmp = $sql->table('EMPLOYEE','COMPANY');

From there, performing a select is pretty simple:

    # select all the people from a real cool company
    my $sth = $emp_cmp->select( { COMPANY.NAME => "Gossamer Threads" } )

Internally, the generated SQL query would look like:

    SELECT EMPLOYEE.ID, EMPLOYEE.COMPANY_ID, EMPLOYEE.NAME
       EMPLOYEE.SALARY, COMPANY.NAME
    FROM   EMPLOYEE, COMPANY
    WHERE  COMPANY.NAME = 'Gossamer Threads' AND
           EMPLOYEE.COMPANY_ID = COMPANY.ID

Note that the join condition is computed and automatically appended at the end
of the query, so you do not have to worry about this.

=head2 SELECT options

The select options for relation are similar to that of table, you have
select_options() which will be set for the next query done. Example:

    $relation->select_options("LIMIT 10");

This would append 'LIMIT 10' to your next select query.  Another useful thing
is join_on(). join_on() allows you to specify the FK relation for the nextr
select. This overrides what is in the def files. It is useful for allowing you
to have one table which will be join differently depending on what you are
doing. The argument to this are the same as to fk().
Example:

    $relation->join_on( remote_table => { local_column => remote_column } );

The FK relation will be changed to this the next time you call select() but
then it will be cleared.

=head2 Listing the relation columns

* As previously said, the cols() method when invoked on a GT::SQL::Relation
object does not return all the columns, removing the duplicate external
references. So, how does it decides which column to keep and which one to
return?

In the EMPLOYEE-COMPANY example we have the constraint
EMPLOYEE.COMPANY_ID => COMPANY.ID and it keeps COMPANY_ID, i.e. the foreign key
instead of the key itself.

=head2 Relation primary key

* The pk() method has to return the table primary key. The property of a primary
key is that it is a non-null unique record identifier.  When pk() is invoked on
a Relation object, this base definition is applied to construct the object
primary key.

To find a unique set of fields that makes a good primary key for a Relation
object, the following, simple algorithm is used:

    .                                                        .
    . for each table                                         .
    .   if the table is not referenced by another table that .
    .   is in the current relation                           .
    .     do                                                 .
    .       append the current table's primary key fields to .
    .       the Relation primary key fields                  .
    .     end-do                                             .
    .   end-if                                               .
    . end-for                                                .
    .                                                        .

This algorithm selects all the tables that represent the "many" in one-to-many
relations, and for all these tables add a list of fields which ensure a record
uniqueness.

=head2 Foreign keys management

* When invoked on a GT::SQL::Table object, the fk() method returns a hash which
has the following general structure:

    {
      target_table_1 => {
                          source_col_1 => target_col_1,
                          source_col_2 => target_col_2
                        },
      target_table_2 => {
                          source_col_1 => target_col_1
            }
    }

The GT::SQL::Relation module returns a hash which has the same structure. The
only difference is that it does not returns the external references which are
managed internally.

This is done for two reasons: As one field is removed from a Relation table, it
would not have been very logical to return a structure that point to
non-existent fields.

Moreover, these internal references from the "Relation" point of view have
nothing to do with the external world and thus should not be shown.

(i.e. EMPLOYEE.COMPANY_ID |===> COMPANY.ID would not count in our example)

=head2 Inserting data

The interface for inserting data in a Relation is the same as the one that is
being used for Table. However, because rows are being inserted in a relation
one-to-many, things internally work a bit differently.

The Relation insert() method takes an optional argument, which can be
'complete' or 'abort' (default being complete).

insert() splits the relation columns into separate records that can be inserted
in a single table. However, some of the records may exist already!

for example, if we perform:

    $sql = shift; # our GT::SQL object
    $rel = $sql->table(qw/EMPLOYEE COMPANY/);
    $rel->insert({
        'EMPLOYEE.NAME'   => $your_name,
        'EMPLOYEE.SALARY' => $big_buck,
        'COMPANY.NAME'    => "Gossamer Threads"
    });

Obviously the company "Gossamer Threads" already exists, but you were not in
the "EMPLOYEE" table. Thus, when 'complete' is specified (it is the default
option), the program will not complain if a record to insert already exists but
just warns and continue the insertion work.

In other words, Gossamer Threads exists already and it will not be inserted
twice, but the employee will still be inserted and will belong to this company.

On the other hand, if you specify "abort", then no data is inserted if a 
record that has to be inserted would trigger an error in GT::SQL::Table.

This feature can be useful if you want to insert a relation record assuming
that none of the entities that you specify should exist.

=head2 Deleting data

Deleting data from a Relation object works using the following pattern:

    .                                                        .
    . for each row that matches the delete condition         .
    . do                                                     .
    .   split the row in table-based records                 .
    .   for each table that contains foreing keys from the   .
    .       current relation object                          .
    .   do                                                   .
    .     delete the record                                  .
    .   end-do                                               .
    .                                                        .
    .   for each table that is being referenced by another   .
    .       table in the current relation object             .
    .   do                                                   .
    .     delete the record unless there exists              .
    .     some "referencing" data.                           .
    .   end-do                                               .
    .                                                        .

As I feel that this explanation is probably very confusing, let us see how it
works using our classical example (The salary column has been removed).

  .-------------------------------------------------------------.
  | EMPLOYEE.ID | COMPANY_ID | EMPLOYEE.NAME | COMPANY.NAME     |
  `-------------------------------------------------------------'
  | 1           | 1          | Alex          | Gossamer Threads |
  |-------------|------------|---------------|------------------|
  | 2           | 1          | Scott         | Gossamer Threads |
  |-------------|------------|---------------|------------------|
  | 3           | 1          | Aki           | Gossamer Threads |
  `-------------------------------------------------------------'

Now let us say that we do the following:

  # remove all the crazy geeks
  $relation->delete({ 'EMPLOYEE.NAME' => 'Scott' });

This will remove "Scott" from the EMPLOYEE table, but of course
Gossamer Threads will not be deleted because there still exists Alex and Aki
that would reference it.

Now if we do:

  $relation->delete({ 'COMPANY.NAME' => 'Gossamer Threads' });

or even

  my $condition = new GT::SQL::Condition;
  $condition->add(qw/EMPLOYEE.NAME LIKE %/);
  $relation->delete($condition);

Then we have generated a condition that matches all the employees, this means
that when the last record will be deleted, then the company Gossamer Threads
will have no more employees and therefore will be deleted.

(Yeah, well, this is for the purpose of this example, of course this will never
happen in real life :) )

=head2 Updating records

Currently, there exists a limitation on updating records in a Relation, which
is that only the records that represent the "many" part of the Relation are
updated.

The way it proceeds to perform the update is pretty simple:

    .                                                        .
    . for each row that matches the update condition         .
    . do                                                     .
    .   split the row in table-based records                 .
    .   for each table that contains foreing keys from the   .
    .       current relation object                          .
    .   do                                                   .
    .     update the record                                  .
    .   end-do                                               .
    .                                                        .

That means that this will work:

  # SALARY being a property of EMPLOYEE, it will be updated
  # because EMPLOYEE references COMPANY and therefore is a
  # "many"
  $relation->update({ SALARY => $big_bill },
                    { 'COMPANY.NAME' => 'Gossamer Threads' });

  # nope, you cannot use Relation to update the COMPANY table that
  # way, this will not do anything.
  $relation->update({ 'COMPANY.NAME' => 'New_Name' },
                    { 'COMPANY.NAME' => 'Gossamer Threads' });

Who would like to change such a great name anyway ?

=head2 Selecting Records

Select behaves exactly like L<GT::SQL::Table> select. The only difference is
the ability to specify LEFT JOINs. For instance, if you want to see a list of
Employees who don't belong to a company, you can do:

    my $relation = $DB->table('Employees', 'Company');
    my $cond = GT::SQL::Condition->new('Company.ID', 'IS', \'NULL');
    my $sth = $relation->select('left_join', $cond);

The order of tables specified in the relation constructor is important!

In selecting columns, calling functions utilizing fully qualified column names
will cause GT::SQL::Relation to fail. Simply turn the values into references
like below.

    my $sth = $relation->select("MIN(Company.ID)"); # will fail

    my $sth = $relation->select(\"MIN(Company.ID)"); # will work

=head1 COPYRIGHT

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

=head1 VERSION

Revision: $Id: Relation.pm,v 1.102 2004/08/28 03:53:43 jagerman Exp $

=cut
