# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Base
#   Author: Scott Beck
#   CVS Info : 087,071,086,086,085      
#   $Id: Condition.pm,v 1.45 2006/02/16 20:26:14 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Implements an SQL condition.
#

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

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

sub new {
# -----------------------------------------------------------------------------
# CLASS->new;
# $obj->new;
# ----------
#   This class method is the base constructor for the GT::SQL::Condition
#   object. It can be passed the boolean operator that has to be used for that
#   object ("AND" is the default), the conditions for this object.
#
    my $class = shift;
    $class = ref $class || $class;
    my $self = {
        cond => [],
        not  => 0,
        bool => 'AND'
    };
    bless $self, $class;

    if (@_ and defined $_[-1] and (uc $_[-1] eq 'AND' or uc $_[-1] eq 'OR' or $_[-1] eq ',') ) {
        $self->boolean(uc pop);
    }
    $self->add(@_) if @_;
    return $self;
}

$COMPILE{clone} = __LINE__ . <<'END_OF_SUB';
sub clone {
# -----------------------------------------------------------------------------
# Clones the current object - that is, gives you an identical object that
# doesn't reference the original at all.
#
    my $self = shift;
    my $newself = { not => $self->{not}, bool => $self->{bool} };
    bless $newself, ref $self;
    my @cond;

    for (@{$self->{cond}}) {
        # {cond} can contain two things - three-value array references
        # ('COL', '=', 'VAL'), or full-fledged condition objects.
        if (ref eq 'ARRAY') {
            push @cond, [@$_];
        }
        elsif (UNIVERSAL::isa($_, __PACKAGE__)) {
            push @cond, $_->clone;
        }
    }
    $newself->{cond} = \@cond;
    $newself;
}
END_OF_SUB

$COMPILE{not} = __LINE__ . <<'END_OF_SUB';
sub not {
# -----------------------------------------------------------------------------
# $obj->not;
# ----------------
#   Negates the current condition.
#
    $_[0]->{not} = 1;
    return $_[0];
}
END_OF_SUB


$COMPILE{new_clean} = __LINE__ . <<'END_OF_SUB';
sub new_clean {
# -----------------------------------------------------------------------------
# $obj->new_clean;
# ----------------
#   Returns the same condition object, but ready to be prepared again.
#
    my $self  = shift;
    my $class = ref $self;
    my $res   = $class->new;
    $res->boolean($self->boolean);
    for my $cond (@{$self->{cond}}) {
        $res->add($cond);
    }
    return $res;
}
END_OF_SUB

sub boolean {
# -----------------------------------------------------------------------------
# $obj->boolean;
# --------------
#   Returns the boolean operator which is being used for the current object.
#
# $obj->boolean($string);
# ------------------------
#   Sets $string as the boolean operator for this condition object. Typically
#   this should be nothing else than "AND" or "OR", but no checks are
#   performed, so watch out for typos!
#
    my $self = shift;
    $self->{bool} = shift || return $self->{bool};
}

sub add {
# -----------------------------------------------------------------------------
# $obj->add($col => $op => $val [, $col2 => $op2 => $val2, ...]);
# ----------------------------
#   Adds a one or more COL OP VAL clauses to the current condition.
#
# $obj->add($condition [, $cond2, ...]);
# -----------------------
#   Adds one or more condition clauses to the current condition.
#
    my $self = shift;

    while (@_) {
        my $var = shift;
        if (ref $var eq 'ARRAY' or UNIVERSAL::isa($var, __PACKAGE__)) {
            push @{$self->{cond}}, $var;
        }
        elsif (ref $var eq 'HASH') {
            for (keys %$var) {
                push @{$self->{cond}}, [$_ => '=' => $var->{$_}];
            }
        }
        else {
            my $op = @_ >= 2 ? shift || '=' : '='; # To support $cond->add(foo => $bar);
            my $val = shift;
            if (not defined $val) {
                if ($op eq '=' and $self->{bool} ne ',') {
                    $op = 'IS';
                }
                elsif ($op eq '!=' or $op eq '<>') {
                    $op = 'IS NOT';
                }
            }
            push @{$self->{cond}}, [$var => $op => $val];
        }
    }

    return 1;
}

sub sql {
# -----------------------------------------------------------------------------
# Returns a string for the current SQL object which is the SQL representation
# of that condition. The string can then be inserted after a SQL WHERE clause.
# Optionally takes an option which, if true, uses placeholders and returns
# ($sql, \@values, \@columns) instead of just $sql.
#
    my ($self, $ph) = @_;
    my $bool = $self->{bool};
    my (@vals, @cols, @output);

    foreach my $cond (@{$self->{cond}}) {
        if (ref $cond eq 'ARRAY') {
            my ($col, $op, $val) = @$cond;
# Perl: column => '=' => [1,2,3]
# SQL:  column IN (1,2,3)
            if (uc $op eq 'IN' || $op eq '=' and ref $val eq 'ARRAY') {
                if (@$val > 1) {
                    $op = 'IN';
                    $val = '('
                        . join(',' => map !length || /\D/ ? quote($_) : $_, @$val)
                        . ')';
                }
                elsif (@$val == 0) {
                    ($col, $op, $val) = (qw(1 = 0));
                }
                else {
                    $op  = '=';
                    $val = quote($val->[0]);
                }
                push @output, "$col $op $val";
            }
# Perl: column => '!=' => [1,2,3]
# SQL:  NOT(column IN (1,2,3))
            elsif ($op eq '!=' || $op eq '<>' and ref $val eq 'ARRAY') {
                my $output;
                if (@$val > 1) {
                    $output = "NOT ($col IN ";
                    $output .= '('
                        . join(',' => map !length || /\D/ ? quote($_) : $_, @$val)
                        . ')';
                    $output .= ')';
                }
                elsif (@$val == 0) {
                    $output = '1 = 1';
                }
                else {
                    $output = "$col $op " . quote($val->[0]);
                }
                push @output, $output;
            }
            elsif ($ph and defined $val and not ref $val) {
                push @output, "$col $op ?";
                push @cols, $col;
                push @vals, $val;
            }
            else {
                push @output, "$col $op " . quote($val);
            }
        }
        elsif (UNIVERSAL::isa($cond, __PACKAGE__)) {
            my @sql = $cond->sql($ph);
            if ($sql[0]) {
                push @output, "($sql[0])";
                if ($ph) {
                    push @vals, @{$sql[1]};
                    push @cols, @{$sql[2]};
                }
            }
        }
    }
    my $final = join " $bool ", @output;
    $final &&= "NOT ($final)" if $self->{not};

    return wantarray ? ($final, $ph ? (\@vals, \@cols) : ()) : $final;
}

$COMPILE{sql_ph} = __LINE__ . <<'END_OF_SUB';
sub sql_ph {
# -----------------------------------------------------------------------------
# Depreciated form of ->sql(1);
    shift->sql(1);
}
END_OF_SUB

sub quote {
# -----------------------------------------------------------------------------
# this subroutines quotes (or not) a value given its column.
#
    defined(my $val = pop) or return 'NULL';
    return ref $val eq 'SCALAR' ? $$val : GT::SQL::Driver->quote($val);
}

sub as_hash {
# -----------------------------------------------------------------------------
# returns the condition object as a flattened hash.
#
    my $cond = shift;
    ref $cond eq 'HASH' and return $cond;
    my %ret;
    for my $arr (@{$cond->{cond}}) {
        if (ref $arr eq 'ARRAY') {
            $ret{$arr->[0]} = $arr->[2];
        }
        else {
            my $h = as_hash($arr);
            for my $k (keys %$h) {
                $ret{$k} = $h->{$k};
            }
        }
    }
    return \%ret;
}

1;

__END__

=head1 NAME

GT::SQL::Condition - Creates complex where clauses

=head1 SYNOPSYS

    my $cond = GT::SQL::Condition->new(Column => LIKE => 'foo%');
    print $cond->sql;

    my $cond = GT::SQL::Condition->new(
        Column  => LIKE => 'foo%',
        Column2 => '<'  => 'abc'
    );
    $cond->bool('OR');
    print $cond->sql;

=head1 DESCRIPTION

The condition module is useful for generating complex SQL WHERE clauses.  At
it's simplest, a condition is composed of three parts: column, condition and
value.

Here are some examples.

To find all users with a first name that starts with Alex use:

    my $cond = GT::SQL::Condition->new(FirstName => LIKE => 'Alex%');

To find users with first name like alex, B<and> last name like krohn use:

    my $cond = GT::SQL::Condition->new(
        FirstName => LIKE => 'Alex%',
        LastName  => LIKE => 'Krohn%'
    );

To find users with first name like alex B<or> last name like krohn use:

    my $cond = GT::SQL::Condition->new(
        FirstName => LIKE => 'Alex%',
        LastName  => LIKE => 'Krohn%'
    );
    $cond->bool('OR');

You may also specify this as:

    my $cond = GT::SQL::Condition->new(
        FirstName => LIKE => 'Alex%',
        LastName  => LIKE => 'Krohn%',
        'OR'
    );

Now say we wanted something a bit more complex that would normally involve
setting parentheses. We want to find users who have either first name like alex
or last name like krohn, and whose employer is Gossamer Threads. We could use:

    my $cond1 = GT::SQL::Condition->new(
        'FirstName', 'LIKE', 'Alex%',
        'LastName', 'LIKE', 'Krohn%'
    );
    $cond1->bool('or');
    my $cond2 = GT::SQL::Condition->new(
        $cond1,
        Employer => '=' => 'Gossamer Threads'
    );

By default, all values are quoted, so you don't need to bother using any quote
function. If you don't want something quoted (say you want to use a function
for example), then you pass in a reference.

For example, to find users who have a last name that sounds like 'krohn', you
could use your SQL engines SOUNDEX function:

    my $cond = GT::SQL::Condition->new(LastName => '=' => \"SOUNDEX('krohn')");

and the right side wouldn't be quoted.

You can also use a condition object to specify a list of multiple values, which
will become the SQL 'IN' operator.  For example, to match anyone with a first
name of Alex, Scott or Jason, you can do:

    my $cond = GT::SQL::Condition->new(FirstName => IN => ['Alex', 'Scott', 'Jason']);

which will turn into:

    FirstName IN ('Alex', 'Scott', 'Jason')

Note that when using multiple values, you can use '=' instead of 'IN'.  Empty
lists will be treated as an impossible condition (1 = 0).  This is primarily
useful for list handling list of id numbers.

To match NULL values, you can use C<undef> for the value passed to the add()
method.  If specifying '=' as the operator, it will automatically be changed to
'IS':

    $cond->add(MiddleName => '=' => undef);

becomes:

    MiddleName IS NULL


To negate your queries you can use the C<not> function.

    my $cond = GT::SQL::Condition->new(a => '=' => 5);
    $cond->not;

would translate into NOT (a = '5'). You can also do this all on one line like:

    print GT::SQL::Condition->new(a => '=' => '5')->not->sql;

This returns the sql right away.

=head1 COPYRIGHT

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

=head1 VERSION

Revision: $Id: Condition.pm,v 1.45 2006/02/16 20:26:14 jagerman Exp $

=cut
