DBIx::SearchBuilder::Handle - Perl extension which is a generic DBI handle

  use DBIx::SearchBuilder::Handle;

  my $handle = DBIx::SearchBuilder::Handle->new();
  $handle->Connect( Driver => 'mysql',
                    Database => 'dbname',
                    Host => 'hostname',
                    User => 'dbuser',
                    Password => 'dbpassword');
  # now $handle isa DBIx::SearchBuilder::Handle::mysql                    

     DisconnectHandleOnDestroy => 1 

    Returns the DSN for this database connection.

  $handle->BeginTransaction;
    $handle->BeginTransaction;
    ...
    $handle->Rollback;
    $handle->BeginTransaction;
    ...
    $handle->Commit;
  $handle->Commit;

# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle.pm,v 1.21 2002/01/28 06:11:37 jesse Exp $
package DBIx::SearchBuilder::Handle;

use strict;
use warnings;

use Carp qw(croak cluck);
use DBI;
use Class::ReturnValue;
use Encode qw();

use vars qw(@ISA %DBIHandle $PrevHandle $DEBUG %TRANSDEPTH %FIELDS_IN_TABLE);

sub new  {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    bless ($self, $class);

    @{$self->{'StatementLog'}} = ();
    return $self;
}

sub Connect  {
  my $self = shift;
  
  my %args = ( Driver => undef,
	       Database => undef,
	       Host => undef,
           SID => undef,
	       Port => undef,
	       User => undef,
	       Password => undef,
	       RequireSSL => undef,
           DisconnectHandleOnDestroy => undef,
	       @_);

   if( $args{'Driver'} && !$self->isa( 'DBIx::SearchBuilder::Handle::'. $args{'Driver'} ) ) {
      if ( $self->_UpgradeHandle($args{Driver}) ) {
          return ($self->Connect( %args ));
      }
   }


    my $dsn = $self->DSN || '';

    # Setting this actually breaks old RT versions in subtle ways. So we need to explicitly call it

    $self->{'DisconnectHandleOnDestroy'} = $args{'DisconnectHandleOnDestroy'};
    

  $self->BuildDSN(%args);

    # Only connect if we're not connected to this source already
   if ((! $self->dbh ) || (!$self->dbh->ping) || ($self->DSN ne $dsn) ) { 
     my $handle = DBI->connect($self->DSN, $args{'User'}, $args{'Password'}) || croak "Connect Failed $DBI::errstr\n" ;
 
  #databases do case conversion on the name of columns returned. 
  #actually, some databases just ignore case. this smashes it to something consistent 
  $handle->{FetchHashKeyName} ='NAME_lc';

  #Set the handle 
  $self->dbh($handle);
  
  return (1); 
    }

    return(undef);

}

sub _UpgradeHandle {
    my $self = shift;
    
    my $driver = shift;
    my $class = 'DBIx::SearchBuilder::Handle::' . $driver;
    local $@;
    eval "require $class";
    return if $@;

    bless $self, $class;
    return 1;
}

sub BuildDSN {
    my $self = shift;
  my %args = ( Driver => undef,
	       Database => undef,
	       Host => undef,
	       Port => undef,
           SID => undef,
	       RequireSSL => undef,
	       @_);
  
  
  my $dsn = "dbi:$args{'Driver'}:dbname=$args{'Database'}";
  $dsn .= ";sid=$args{'SID'}" if ( defined $args{'SID'} && $args{'SID'});
  $dsn .= ";host=$args{'Host'}" if (defined$args{'Host'} && $args{'Host'});
  $dsn .= ";port=$args{'Port'}" if (defined $args{'Port'} && $args{'Port'});
  $dsn .= ";requiressl=1" if (defined $args{'RequireSSL'} && $args{'RequireSSL'});

  $self->{'dsn'}= $dsn;
}

sub DSN {
    return shift->{'dsn'};
}

sub RaiseError {
    my $self = shift;

    my $mode = 1; 
    $mode = shift if (@_);

    $self->dbh->{RaiseError}=$mode;
}

sub PrintError {
    my $self = shift;

    my $mode = 1; 
    $mode = shift if (@_);

    $self->dbh->{PrintError}=$mode;
}

sub LogSQLStatements {
    my $self = shift;
    if (@_) {
        require Time::HiRes;
        $self->{'_DoLogSQL'} = shift;
    }
    return ($self->{'_DoLogSQL'});
}

sub _LogSQLStatement {
    my $self = shift;
    my $statement = shift;
    my $duration = shift;
    my @bind = @_;
    push @{$self->{'StatementLog'}} , ([Time::HiRes::time(), $statement, [@bind], $duration, Carp::longmess("Executed SQL query")]);

}

sub ClearSQLStatementLog {
    my $self = shift;
    @{$self->{'StatementLog'}} = ();
}   

sub SQLStatementLog {
    my $self = shift;
    return  (@{$self->{'StatementLog'}});

}

sub AutoCommit {
    my $self = shift;

    my $mode = 1; 
    $mode = shift if (@_);

    $self->dbh->{AutoCommit}=$mode;
}

sub Disconnect  {
    my $self = shift;
    my $dbh = $self->dbh;
    return unless $dbh;
    $self->Rollback(1);
    return $dbh->disconnect;
}

# allow use of Handle as a synonym for DBH
*Handle=\&dbh;

sub dbh {
  my $self=shift;
  
  #If we are setting the database handle, set it.
  if ( @_ ) {
      $DBIHandle{$self} = $PrevHandle = shift;
      %FIELDS_IN_TABLE = ();
  }

  return($DBIHandle{$self} ||= $PrevHandle);
}

sub Insert {
    my $self = shift;
    return $self->SimpleQuery( $self->InsertQueryString(@_) );
}

sub InsertQueryString {
    my($self, $table, @pairs) = @_;
    my(@cols, @vals, @bind);

    while ( my $key = shift @pairs ) {
        push @cols, $key;
        push @vals, '?';
        push @bind, shift @pairs;
    }

    my $QueryString = "INSERT INTO $table";
    $QueryString .= " (". join(", ", @cols) .")";
    $QueryString .= " VALUES (". join(", ", @vals). ")";
    return ($QueryString, @bind);
}

sub UpdateRecordValue {
    my $self = shift;
    my %args = ( Table         => undef,
                 Column        => undef,
                 IsSQLFunction => undef,
                 PrimaryKeys   => undef,
                 @_ );

    my @bind  = ();
    my $query = 'UPDATE ' . $args{'Table'} . ' ';
     $query .= 'SET '    . $args{'Column'} . '=';

  ## Look and see if the field is being updated via a SQL function. 
  if ($args{'IsSQLFunction'}) {
     $query .= $args{'Value'} . ' ';
  }
  else {
     $query .= '? ';
     push (@bind, $args{'Value'});
  }

  ## Constructs the where clause.
  my $where  = 'WHERE ';
  foreach my $key (keys %{$args{'PrimaryKeys'}}) {
     $where .= $key . "=?" . " AND ";
     push (@bind, $args{'PrimaryKeys'}{$key});
  }
     $where =~ s/AND\s$//;
  
  my $query_str = $query . $where;
  return ($self->SimpleQuery($query_str, @bind));
}

sub UpdateTableValue  {
    my $self = shift;

    ## This is just a wrapper to UpdateRecordValue().     
    my %args = (); 
    $args{'Table'}  = shift;
    $args{'Column'} = shift;
    $args{'Value'}  = shift;
    $args{'PrimaryKeys'}   = shift; 
    $args{'IsSQLFunction'} = shift;

    return $self->UpdateRecordValue(%args)
}

sub SimpleQuery {
    my $self        = shift;
    my $QueryString = shift;
    my @bind_values;
    @bind_values = (@_) if (@_);

    my $sth = $self->dbh->prepare($QueryString);
    unless ($sth) {
        if ($DEBUG) {
            die "$self couldn't prepare the query '$QueryString'"
              . $self->dbh->errstr . "\n";
        }
        else {
            warn "$self couldn't prepare the query '$QueryString'"
              . $self->dbh->errstr . "\n";
            my $ret = Class::ReturnValue->new();
            $ret->as_error(
                errno   => '-1',
                message => "Couldn't prepare the query '$QueryString'."
                  . $self->dbh->errstr,
                do_backtrace => undef
            );
            return ( $ret->return_value );
        }
    }

    # Check @bind_values for HASH refs
    for ( my $bind_idx = 0 ; $bind_idx < scalar @bind_values ; $bind_idx++ ) {
        if ( ref( $bind_values[$bind_idx] ) eq "HASH" ) {
            my $bhash = $bind_values[$bind_idx];
            $bind_values[$bind_idx] = $bhash->{'value'};
            delete $bhash->{'value'};
            $sth->bind_param( $bind_idx + 1, undef, $bhash );
        }
        # Some databases, such as Oracle fail to cope if it's a perl utf8
        # string. they desperately want bytes.
         Encode::_utf8_off($bind_values[$bind_idx]);
    }

    my $basetime;
    if ( $self->LogSQLStatements ) {
        $basetime = Time::HiRes::time();
    }
    my $executed;
    {
        no warnings 'uninitialized' ; # undef in bind_values makes DBI sad
        eval { $executed = $sth->execute(@bind_values) };
    }
    if ( $self->LogSQLStatements ) {
        $self->_LogSQLStatement( $QueryString, Time::HiRes::time() - $basetime, @bind_values );
    }

    if ( $@ or !$executed ) {
        if ($DEBUG) {
            die "$self couldn't execute the query '$QueryString'"
              . $self->dbh->errstr . "\n";

        }
        else {
            cluck "$self couldn't execute the query '$QueryString'";

            my $ret = Class::ReturnValue->new();
            $ret->as_error(
                errno   => '-1',
                message => "Couldn't execute the query '$QueryString'"
                  . $self->dbh->errstr,
                do_backtrace => undef
            );
            return ( $ret->return_value );
        }

    }
    return ($sth);

}

sub FetchResult {
  my $self = shift;
  my $query = shift;
  my @bind_values = @_;
  my $sth = $self->SimpleQuery($query, @bind_values);
  if ($sth) {
    return ($sth->fetchrow);
  }
  else {
   return($sth);
  }
}

sub BinarySafeBLOBs {
    my $self = shift;
    return(1);
}

sub KnowsBLOBs {
    my $self = shift;
    return(1);
}

sub BLOBParams {
    my $self = shift;
    # Don't assign to key 'value' as it is defined later. 
    return ( {} );
}

sub DatabaseVersion {
    my $self = shift;
    my %args = ( Short => 1, @_ );

    unless ( defined $self->{'database_version'} ) {

        # turn off error handling, store old values to restore later
        my $re = $self->RaiseError;
        $self->RaiseError(0);
        my $pe = $self->PrintError;
        $self->PrintError(0);

        my $statement = "SELECT VERSION()";
        my $sth       = $self->SimpleQuery($statement);

        my $ver = '';
        $ver = ( $sth->fetchrow_arrayref->[0] || '' ) if $sth;
        $ver =~ /(\d+(?:\.\d+)*(?:-[a-z0-9]+)?)/i;
        $self->{'database_version'}       = $ver;
        $self->{'database_version_short'} = $1 || $ver;

        $self->RaiseError($re);
        $self->PrintError($pe);
    }

    return $self->{'database_version_short'} if $args{'Short'};
    return $self->{'database_version'};
}

sub CaseSensitive {
    my $self = shift;
    return(1);
}

our $RE_CASE_INSENSITIVE_CHARS = qr/[-'"\d: ]/;

sub _MakeClauseCaseInsensitive {
    my $self = shift;
    my $field = shift;
    my $operator = shift;
    my $value = shift;

    # don't downcase integer values and things that looks like dates
    if ($value !~ /^$RE_CASE_INSENSITIVE_CHARS+$/o) {
        $field = "lower($field)";
        $value = lc($value);
    }
    return ($field, $operator, $value,undef);
}

sub BeginTransaction {
    my $self = shift;

    my $depth = $self->TransactionDepth;
    return unless defined $depth;

    $self->TransactionDepth(++$depth);
    return 1 if $depth > 1;

    return $self->dbh->begin_work;
}

sub EndTransaction {
    my $self = shift;
    my %args = ( Action => 'commit', Force => 0, @_ );
    my $action = lc $args{'Action'} eq 'commit'? 'commit': 'rollback';

    my $depth = $self->TransactionDepth || 0;
    unless ( $depth ) {
        unless( $args{'Force'} ) {
            Carp::cluck( "Attempted to $action a transaction with none in progress" );
            return 0;
        }
        return 1;
    } else {
        $depth--;
    }
    $depth = 0 if $args{'Force'};

    $self->TransactionDepth( $depth );
    return 1 if $depth;

    if ($action eq 'commit') {
        return $self->dbh->commit;
    }
    else {
        DBIx::SearchBuilder::Record::Cachable->FlushCache
            if DBIx::SearchBuilder::Record::Cachable->can('FlushCache');
        return $self->dbh->rollback;
    }
}

sub Commit {
    my $self = shift;
    $self->EndTransaction( Action => 'commit', Force => shift );
}

sub Rollback {
    my $self = shift;
    $self->EndTransaction( Action => 'rollback', Force => shift );
}

sub ForceRollback {
    my $self = shift;
    $self->Rollback(1);
}

sub TransactionDepth {
    my $self = shift;

    my $dbh = $self->dbh;
    return undef unless $dbh && $dbh->ping;

    if ( @_ ) {
        my $depth = shift;
        if ( $depth ) {
            $TRANSDEPTH{ $dbh } = $depth;
        } else {
            delete $TRANSDEPTH{ $dbh };
        }
    }
    return $TRANSDEPTH{ $dbh } || 0;
}

sub ApplyLimits {
    my $self = shift;
    my $statementref = shift;
    my $per_page = shift;
    my $first = shift;

    my $limit_clause = '';

    if ( $per_page) {
        $limit_clause = " LIMIT ";
        if ( $first ) {
            $limit_clause .= $first . ", ";
        }
        $limit_clause .= $per_page;
    }

   $$statementref .= $limit_clause; 

}

sub Join {

    my $self = shift;
    my %args = (
        SearchBuilder => undef,
        TYPE          => 'normal',
        ALIAS1        => 'main',
        FIELD1        => undef,
        TABLE2        => undef,
        COLLECTION2   => undef,
        FIELD2        => undef,
        ALIAS2        => undef,
        EXPRESSION    => undef,
        @_
    );


    my $alias;

#If we're handed in an ALIAS2, we need to go remove it from the Aliases array.
# Basically, if anyone generates an alias and then tries to use it in a join later, we want to be smart about
# creating joins, so we need to go rip it out of the old aliases table and drop it in as an explicit join
    if ( $args{'ALIAS2'} ) {

        # this code is slow and wasteful, but it's clear.
        my @aliases = @{ $args{'SearchBuilder'}->{'aliases'} };
        my @new_aliases;
        foreach my $old_alias (@aliases) {
            if ( $old_alias =~ /^(.*?) (\Q$args{'ALIAS2'}\E)$/ ) {
                $args{'TABLE2'} = $1;
                $alias = $2;
            }
            else {
                push @new_aliases, $old_alias;
            }
        }

# If we found an alias, great. let's just pull out the table and alias for the other item
        unless ($alias) {

            # if we can't do that, can we reverse the join and have it work?
            my $a1 = $args{'ALIAS1'};
            my $f1 = $args{'FIELD1'};
            $args{'ALIAS1'} = $args{'ALIAS2'};
            $args{'FIELD1'} = $args{'FIELD2'};
            $args{'ALIAS2'} = $a1;
            $args{'FIELD2'} = $f1;

            @aliases     = @{ $args{'SearchBuilder'}->{'aliases'} };
            @new_aliases = ();
            foreach my $old_alias (@aliases) {
                if ( $old_alias =~ /^(.*?) ($args{'ALIAS2'})$/ ) {
                    $args{'TABLE2'} = $1;
                    $alias = $2;

                }
                else {
                    push @new_aliases, $old_alias;
                }
            }

        }

        unless ( $alias ) {
            # XXX: this situation is really bug in the caller!!!
            return ( $self->_NormalJoin(%args) );
        }
        $args{'SearchBuilder'}->{'aliases'} = \@new_aliases;
    } elsif ( $args{'COLLECTION2'} ) {
        # We're joining to a pre-limited collection.  We need to take
        # all clauses in the other collection, munge 'main.' to a new
        # alias, apply them locally, then proceed as usual.
        my $collection = delete $args{'COLLECTION2'};
        $alias = $args{ALIAS2} = $args{'SearchBuilder'}->_GetAlias( $collection->Table );
        $args{TABLE2} = $collection->Table;

        eval {$collection->_ProcessRestrictions}; # RT hate

        # Move over unused aliases
        push @{$args{SearchBuilder}{aliases}}, @{$collection->{aliases}};

        # Move over joins, as well
        for my $join (keys %{$collection->{left_joins}}) {
            my %alias = %{$collection->{left_joins}{$join}};
            $alias{depends_on} = $alias if $alias{depends_on} eq "main";
            $alias{criteria} = $self->_RenameRestriction(
                RESTRICTIONS => $alias{criteria},
                NEW          => $alias
            );
            $args{SearchBuilder}{left_joins}{$join} = \%alias;
        }

        my $restrictions = $self->_RenameRestriction(
            RESTRICTIONS => $collection->{restrictions},
            NEW          => $alias
        );
        $args{SearchBuilder}{restrictions}{$_} = $restrictions->{$_} for keys %{$restrictions};
    } else {
        $alias = $args{'SearchBuilder'}->_GetAlias( $args{'TABLE2'} );
    }

    my $meta = $args{'SearchBuilder'}->{'left_joins'}{"$alias"} ||= {};
    if ( $args{'TYPE'} =~ /LEFT/i ) {
        $meta->{'alias_string'} = " LEFT JOIN " . $args{'TABLE2'} . " $alias ";
        $meta->{'type'} = 'LEFT';
    }
    else {
        $meta->{'alias_string'} = " JOIN " . $args{'TABLE2'} . " $alias ";
        $meta->{'type'} = 'NORMAL';
    }
    $meta->{'depends_on'} = $args{'ALIAS1'};

    my $criterion = $args{'EXPRESSION'} || $args{'ALIAS1'}.".".$args{'FIELD1'};
    $meta->{'criteria'}{'base_criterion'} =
        [ { field => "$alias.$args{'FIELD2'}", op => '=', value => $criterion } ];

    return ($alias);
}

sub _RenameRestriction {
    my $self = shift;
    my %args = (
        RESTRICTIONS => undef,
        OLD          => "main",
        NEW          => undef,
        @_,
    );

    my %return;
    for my $key ( keys %{$args{RESTRICTIONS}} ) {
        my $newkey = $key;
        $newkey =~ s/^\Q$args{OLD}\E\./$args{NEW}./;
        my @parts;
        for my $part ( @{ $args{RESTRICTIONS}{$key} } ) {
            if ( ref $part ) {
                my %part = %{$part};
                $part{field} =~ s/^\Q$args{OLD}\E\./$args{NEW}./;
                $part{value} =~ s/^\Q$args{OLD}\E\./$args{NEW}./;
                push @parts, \%part;
            } else {
                push @parts, $part;
            }
        }
        $return{$newkey} = \@parts;
    }
    return \%return;
}

sub _NormalJoin {

    my $self = shift;
    my %args = (
        SearchBuilder => undef,
        TYPE          => 'normal',
        FIELD1        => undef,
        ALIAS1        => undef,
        TABLE2        => undef,
        FIELD2        => undef,
        ALIAS2        => undef,
        @_
    );

    my $sb = $args{'SearchBuilder'};

    if ( $args{'TYPE'} =~ /LEFT/i ) {
        my $alias = $sb->_GetAlias( $args{'TABLE2'} );
        my $meta = $sb->{'left_joins'}{"$alias"} ||= {};
        $meta->{'alias_string'} = " LEFT JOIN $args{'TABLE2'} $alias ";
        $meta->{'depends_on'}   = $args{'ALIAS1'};
        $meta->{'type'}         = 'LEFT';
        $meta->{'criteria'}{'base_criterion'} = [ {
            field => "$args{'ALIAS1'}.$args{'FIELD1'}",
            op => '=',
            value => "$alias.$args{'FIELD2'}",
        } ];

        return ($alias);
    }
    else {
        $sb->DBIx::SearchBuilder::Limit(
            ENTRYAGGREGATOR => 'AND',
            QUOTEVALUE      => 0,
            ALIAS           => $args{'ALIAS1'},
            FIELD           => $args{'FIELD1'},
            VALUE           => $args{'ALIAS2'} . "." . $args{'FIELD2'},
            @_
        );
    }
}

# this code is all hacky and evil. but people desperately want _something_ and I'm 
# super tired. refactoring gratefully appreciated.

sub _BuildJoins {
    my $self = shift;
    my $sb   = shift;

    $self->OptimizeJoins( SearchBuilder => $sb );

    my $join_clause = join " CROSS JOIN ", ($sb->Table ." main"), @{ $sb->{'aliases'} };
    my %processed = map { /^\S+\s+(\S+)$/; $1 => 1 } @{ $sb->{'aliases'} };
    $processed{'main'} = 1;

    # get a @list of joins that have not been processed yet, but depend on processed join
    my $joins = $sb->{'left_joins'};
    while ( my @list =
        grep !$processed{ $_ }
            && (!$joins->{ $_ }{'depends_on'} || $processed{ $joins->{ $_ }{'depends_on'} }),
        keys %$joins
    ) {
        foreach my $join ( @list ) {
            $processed{ $join }++;

            my $meta = $joins->{ $join };
            my $aggregator = $meta->{'entry_aggregator'} || 'AND';

            $join_clause .= $meta->{'alias_string'} . " ON ";
            my @tmp = map {
                    ref($_)?
                        $_->{'field'} .' '. $_->{'op'} .' '. $_->{'value'}:
                        $_
                }
                map { ('(', @$_, ')', $aggregator) } values %{ $meta->{'criteria'} };
            pop @tmp;
            $join_clause .= join ' ', @tmp;
        }
    }

    # here we could check if there is recursion in joins by checking that all joins
    # are processed
    if ( my @not_processed = grep !$processed{ $_ }, keys %$joins ) {
        die "Unsatisfied dependency chain in joins @not_processed";
    }
    return $join_clause;
}

sub OptimizeJoins {
    my $self = shift;
    my %args = (SearchBuilder => undef, @_);
    my $joins = $args{'SearchBuilder'}->{'left_joins'};

    my %processed = map { /^\S+\s+(\S+)$/; $1 => 1 } @{ $args{'SearchBuilder'}->{'aliases'} };
    $processed{ $_ }++ foreach grep $joins->{ $_ }{'type'} ne 'LEFT', keys %$joins;
    $processed{'main'}++;

    my @ordered;
    # get a @list of joins that have not been processed yet, but depend on processed join
    # if we are talking about forest then we'll get the second level of the forest,
    # but we should process nodes on this level at the end, so we build FILO ordered list.
    # finally we'll get ordered list with leafes in the beginning and top most nodes at
    # the end.
    while ( my @list = grep !$processed{ $_ }
            && $processed{ $joins->{ $_ }{'depends_on'} }, keys %$joins )
    {
        unshift @ordered, @list;
        $processed{ $_ }++ foreach @list;
    }

    foreach my $join ( @ordered ) {
        next if $self->MayBeNull( SearchBuilder => $args{'SearchBuilder'}, ALIAS => $join );

        $joins->{ $join }{'alias_string'} =~ s/^\s*LEFT\s+/ /;
        $joins->{ $join }{'type'} = 'NORMAL';
    }

    # here we could check if there is recursion in joins by checking that all joins
    # are processed

}

sub MayBeNull {
    my $self = shift;
    my %args = (SearchBuilder => undef, ALIAS => undef, @_);
    # if we have at least one subclause that is not generic then we should get out
    # of here as we can't parse subclauses
    return 1 if grep $_ ne 'generic_restrictions', keys %{ $args{'SearchBuilder'}->{'subclauses'} };

    # build full list of generic conditions
    my @conditions;
    foreach ( grep @$_, values %{ $args{'SearchBuilder'}->{'restrictions'} } ) {
        push @conditions, 'AND' if @conditions;
        push @conditions, '(', @$_, ')';
    }

    # find tables that depends on this alias and add their join conditions
    foreach my $join ( values %{ $args{'SearchBuilder'}->{'left_joins'} } ) {
        # left joins on the left side so later we'll get 1 AND x expression
        # which equal to x, so we just skip it
        next if $join->{'type'} eq 'LEFT';
        next unless $join->{'depends_on'} eq $args{'ALIAS'};

        my @tmp = map { ('(', @$_, ')', $join->{'entry_aggregator'}) } values %{ $join->{'criteria'} };
        pop @tmp;

        @conditions = ('(', @conditions, ')', 'AND', '(', @tmp ,')');

    }
    return 1 unless @conditions;

    # replace conditions with boolean result: 1 - allows nulls, 0 - not
    # all restrictions on that don't act on required alias allow nulls
    # otherwise only IS NULL operator 
    foreach ( splice @conditions ) {
        unless ( ref $_ ) {
            push @conditions, $_;
        } elsif ( rindex( $_->{'field'}, "$args{'ALIAS'}.", 0 ) == 0 ) {
            # field is alias.xxx op ... and only IS op allows NULLs
            push @conditions, lc $_->{op} eq 'is';
        } elsif ( $_->{'value'} && rindex( $_->{'value'}, "$args{'ALIAS'}.", 0 ) == 0 ) {
            # value is alias.xxx so it can not be IS op
            push @conditions, 0;
        } elsif ( $_->{'field'} =~ /^(?i:lower)\(\s*\Q$args{'ALIAS'}\./ ) {
            # handle 'LOWER(alias.xxx) OP VALUE' we use for case insensetive
            push @conditions, lc $_->{op} eq 'is';
        } else {
            push @conditions, 1;
        }
    }

    # resturns index of closing paren by index of openning paren
    my $closing_paren = sub {
        my $i = shift;
        my $count = 0;
        for ( ; $i < @conditions; $i++ ) {
            if ( $conditions[$i] eq '(' ) {
                $count++;
            }
            elsif ( $conditions[$i] eq ')' ) {
                $count--;
            }
            return $i unless $count;
        }
        die "lost in parens";
    };

    # solve boolean expression we have, an answer is our result
    my $parens_count = 0;
    my @tmp = ();
    while ( defined ( my $e = shift @conditions ) ) {
        #print "@tmp >>>$e<<< @conditions\n";
        return $e if !@conditions && !@tmp;

        unless ( $e ) {
            if ( $conditions[0] eq ')' ) {
                push @tmp, $e;
                next;
            }

            my $aggreg = uc shift @conditions;
            if ( $aggreg eq 'OR' ) {
                # 0 OR x == x
                next;
            } elsif ( $aggreg eq 'AND' ) {
                # 0 AND x == 0
                my $close_p = $closing_paren->(0);
                splice @conditions, 0, $close_p + 1, (0);
            } else {
                die "unknown aggregator: @tmp $e >>>$aggreg<<< @conditions";
            }
        } elsif ( $e eq '1' ) {
            if ( $conditions[0] eq ')' ) {
                push @tmp, $e;
                next;
            }

            my $aggreg = uc shift @conditions;
            if ( $aggreg eq 'OR' ) {
                # 1 OR x == 1
                my $close_p = $closing_paren->(0);
                splice @conditions, 0, $close_p + 1, (1);
            } elsif ( $aggreg eq 'AND' ) {
                # 1 AND x == x
                next;
            } else {
                die "unknown aggregator: @tmp $e >>>$aggreg<<< @conditions";
            }
        } elsif ( $e eq '(' ) {
            if ( $conditions[1] eq ')' ) {
                splice @conditions, 1, 1;
            } else {
                $parens_count++;
                push @tmp, $e;
            }
        } elsif ( $e eq ')' ) {
            die "extra closing paren: @tmp >>>$e<<< @conditions"
                if --$parens_count < 0;

            unshift @conditions, @tmp, $e;
            @tmp = ();
        } else {
            die "lost: @tmp >>>$e<<< @conditions";
        }
    }
    return 1;
}

sub DistinctQuery {
    my $self = shift;
    my $statementref = shift;
    my $sb = shift;

    # Prepend select query for DBs which allow DISTINCT on all column types.
    $$statementref = "SELECT DISTINCT main.* FROM $$statementref";
    $$statementref .= $sb->_GroupClause;
    $$statementref .= $sb->_OrderClause;
}

sub DistinctCount {
    my $self = shift;
    my $statementref = shift;

    # Prepend select query for DBs which allow DISTINCT on all column types.
    $$statementref = "SELECT COUNT(DISTINCT main.id) FROM $$statementref";

}

sub Fields {
    my $self  = shift;
    my $table = shift;

    unless ( keys %FIELDS_IN_TABLE ) {
        my $sth = $self->dbh->column_info( undef, '', '%', '%' )
            or return ();
        my $info = $sth->fetchall_arrayref({});
        foreach my $e ( @$info ) {
            push @{ $FIELDS_IN_TABLE{ lc $e->{'TABLE_NAME'} } ||= [] }, lc $e->{'COLUMN_NAME'};
        }
    }

    return @{ $FIELDS_IN_TABLE{ lc $table } || [] };
}

sub Log {
	my $self = shift;
	my $msg = shift;
	warn $msg."\n";

}

  
sub DESTROY {
  my $self = shift;
  $self->Disconnect if $self->{'DisconnectHandleOnDestroy'};
  delete $DBIHandle{$self};
}


1;
__END__