# $Id: SqlWrapper.pm,v 1.2 2004/11/24 02:27:56 cmungall Exp $
#
# This GO module is maintained by Chris Mungall <cjm@fruitfly.org>
#
# see also - http://www.geneontology.org
#          - http://www.godatabase.org/dev
#
# You may distribute this module under the same terms as perl itself

package GO::SqlWrapper;

=head1 NAME

  GO::SqlWrapper

=head1 SYNOPSIS

  helper functions for creating sql statements

=head1 USAGE

  use GO::SqlWrapper qw(:all);
  use GO::SqlWrapper qw(make_sql_select 
			     make_sql_insert 
			     make_sql_update 
			     sql_delete
                	     db_null 
			     sql_quote);

=cut

use GO::DebugUtils qw(sqllog);
use Carp;

use Exporter;

@EXPORT_OK = qw(make_sql_select
		make_sql_insert
		make_sql_update 
		orterm
		andterm
		db_null 
		sqlin
		sql_quote
		get_iterator
		get_hashrow
		update_h
		insert_h 
		insert_hash 
		insert_hash_wp
		select_hashlist
                select_vallist
                select_structlist
                select_rowlist
		select_hash
		select_val
		select_row
		sql_delete
		get_result_column
		get_autoincrement_val);
%EXPORT_TAGS = (all=> [@EXPORT_OK]);
@GO::SqlWrapper::ISA = qw(Exporter);

use strict;

=head2 db_null

value to represent a database null column value

=cut

sub db_null {
    "NULL"
}



=head2 get_autoincrement_val

args: dbh

returns the id created for the latest insert
(serial cols under informix, auto_increment under mysql)

the default is informix; for this to work under mysql,
the env variable $DBMS must be set to "mysql"

=cut

sub get_autoincrement_val {
    my $dbh = shift;
    my $table = shift;
    my $dbms = $dbh->{private_dbms};
    if (!$ENV{DBMS} || lc($ENV{DBMS}) eq "mysql") {
	return $dbh->{mysql_insertid};
    }
    elsif (lc($dbms) eq "pg") {
        my $id;
        if (grep {$table eq $_}
            qw(
               term_dbxref
               term_synonym
              )) {
            return;
        }
        eval {
            my $h = 
              select_hash($dbh,
                          $table."_id_seq",
                          undef,
                          "last_value AS lv"); 
            confess unless $h->{lv};
            print STDERR "LAST VAL=$h->{lv}\n" if $ENV{SQL_TRACE};
            $id = $h->{lv};
        };
        if ($@) {
            warn("Couldn't get id for $table");
            return 0;
        }
        return $id;
    }
    else {
	return $dbh->{ix_sqlerrd}[1];
    }
}

=head2 make_sql_select

 usage: make_sql_select({select_arr=>\@columns,
			 table_arr=>\@tables,
			 where_arr=>\@and_clauses},
		         order_arr=>\@order_columns);

returns: sql string

will remove duplicate items in the above arrays

=cut

sub make_sql_select {

    my %query = %{shift || carp("No query hash specified")};
    
    if (!@{$query{table_arr}}) {
	confess("No table specified in query");
    }
    if (!@{$query{select_arr}}) {
	confess("No columns specified in query");
    }

    # first of all, we have to check for the scenario whereby
    # a table has been specified twice, once as an outer join
    # the other time as a normal table
    # - we replace this with a single entry (so remove duplicates
    #   below spots that they are the same), discarding the "outer"
    # it is presumed an outer join is not required, unless all instances
    # of that table in the {table_arr} are specified as outer
    my $i=0;
    for ($i=0; $i<@{$query{table_arr}}; $i++) {
	if ($query{table_arr}->[$i] =~ /outer /) {
	    my $actual_table_name = $query{table_arr}->[$i];
	    $actual_table_name =~ s/outer //;
	    my $j=0;
	    for ($j=0; $j<@{$query{table_arr}}; $j++) {
		if ($query{table_arr}->[$j] eq $actual_table_name) {
		    $query{table_arr}->[$i] = $actual_table_name;
		}
	    }
	}
    }

    # build the sql statement from the $query structure
    my @select_cols = remove_duplicates($query{select_arr});
    my $select_text = join(", ", @select_cols);
    if (!$select_text) {
	$select_text = "*";
    }
    if ($query{distinct}) {
	$select_text = "distinct $select_text";
    }
    my $sql = "select ".$select_text;
    $sql.= " from ".join(", ", 
			 remove_duplicates($query{table_arr}));
    my @where_arr = remove_duplicates($query{where_arr});
    if (@where_arr) {
	$sql.= " where ".join(" and ", @where_arr);
    }
    my @order_arr = @{$query{order_arr} || []};
    if (@order_arr) {
	$sql.= " order by ".join(", ", @order_arr);
    }
    return $sql;
}

=head2 sqlin

  Usage   -
  Returns -
  Args    -

=cut

sub sqlin {
    my $fld = shift;
    my @ids = @{shift || []};
    my $qt = shift;
    
    @ids = grep {$_} @ids;
    if (!@ids) {
        @ids = $qt ? ('') : (0);
    }
    if ($qt) {
        return "$fld in (".join(",",map {sql_quote($_)} @ids).")";
    }
    return "$fld in (".join(",",@ids).")";
}



=head2 sql_quote

escapes any quotes in a string, so that it can be passed
to a sql engine safely

usage: sql_quote($col_value)

=cut

sub sql_quote {
    my $string = shift;
    # escape real quotes by double-quoting
    if (!$string) {
	return "";
    }
    $string =~ s/\'/\'\'/g;

    # also escape any backslashes
    $string =~ s/\\/\\\\/g;

    return "'".$string."'";
}

=head2 make_sql_insert

 usage: my $sql_stmt = make_sql_insert($table, \%entry_h)

  given a list of name/values pairs for the entry hash, turns
  it into an SQL statement.

all values will be sql-quoted (surrounded by single quotes, actual
quotes are escaped by preceeding the quote with another quote). in
cases where you do not want the value quoted (e.g. if the values you
are inserting must be dynamically fetched with an sql statement), then
you should pass the values as a hash, rather than a string. the hash
keys should by 'type' and 'val'. if 'type' is char or varchar, the
string is quoted, other wise it is unquoted.

for example:

my $sql = make_sql_insert("seq2ext_db", 
			  {seq_id=>900,
			   name=>"AC000052",
			   ext_db_id=>{type=>"sql",
				       val=>"(select id from ext_db ".
				            "where name = 'genbank')"}});

will produce:

insert into seq2ext_db (seq_id, name, ext_db_id) values ('900',
'AC000052', (select id from ext_db where name = 'genbank'))

=cut

sub make_sql_insert {
  my ($table, $entry) = @_;
  
  my $key;
  my $names = "";
  my $values = "";

  foreach $key (keys %{$entry}) {
      if (!defined($entry->{$key})) {
	  delete $entry->{$key};
      }
  }

  $names = join(", ", keys %{$entry});
  $values = join(", ",
		 map {
		     if (ref($entry->{$_})) {
			 if ($entry->{$_}->{'type'} =~ /char/) {
			     sql_quote($entry->{$_}->{val});
			 }
			 else {
			     $entry->{$_}->{val}
			 }
		     }
		     else {
			 sql_quote($entry->{$_});
		     }
		 } keys %{$entry});

  my $sql = "insert into $table ";
  $sql .= "($names) values ($values);";

  return $sql;
}


=head2 make_sql_update

=cut

sub make_sql_update {
  my ($table, $entry, $where_r) = @_;
  
  my $key;
  my $names = "";
  my $values = "";

  # where clause can be ref to an array or the actual text of the clause
  my $where = $where_r;
  if (ref($where_r)) {
      $where = join(" and ", @{$where_r});
  }
  
  $names = join(", ", keys %{$entry});
  $values = join(", ",
		 map {
		     if (ref($entry->{$_})) {
			 if ($entry->{$_}->{'type'} =~ /char/) {
			     sql_quote($entry->{$_}->{val});
			 }
			 else {
			     $entry->{$_}->{val}
			 }
		     }
		     else {
			 sql_quote($entry->{$_});
		     }
		 } keys %{$entry});

  my $sql = "update $table set ";
  $sql .= "($names) = ($values) where $where;";

  return $sql;
}

=head2 select_hashlist

selects rows from the database and returns the results as an
array of hashrefs

parameters: dbh, tables, where, columns

the sql parameters can be either strings or arrays of strings

eg

  select_hashlist($dbh, "clone");     # gets all results from clone table

or
  
  select_hashlist($dbh, 
		  ["seq", "seq_origin"], 
		  ["seq.id" = "seq_origin.seq_id"],
		  ["seq.id"]);    # gets a list of all seq_ids with origin

=cut

sub select_hashlist {

    my $iterator = get_iterator(@_);
    my $hashr;
    my @hashes = ();
    while ($hashr = get_hashrow($iterator)) {
	push(@hashes, ($hashr));
    }
    return \@hashes;
}



=head2 select_hash

=cut

sub select_hash {

    my $hl = select_hashlist(@_);
    return $hl->[0];
}



=head2 select_structlist

  Usage   -
  Returns -
  Args    - dbh, name, tables, where, cols

=cut

sub select_structlist {
    my $dbh = shift;
    my $name = shift;
    my $hl =
      select_hashlist($dbh, @_);
    return [
            map {
                my $h = $_;
                [$name =>
                 [
                  map {
                     [$_ => $h->{$_}],
                 } keys %$h
                 ]
                ]
            } @$hl
           ];
}

=head2 select_vallist

  Usage   -
  Returns -
  Args    -

as select hashlist, returns a list of scalars

=cut

sub select_vallist {
    my $dbh = shift;
#    my $sth = get_iterator($dbh, @_);
    my ($sql, @bind) = get_sql(@_);
#    my $sth = get_iterator($dbh, @_);
    sqllog("$sql [@bind]");
    return $dbh->selectcol_arrayref($sql, {}, @bind);
}


=head2 select_val

  Usage   -
  Returns -
  Args    -

=cut

sub select_val {
    my $dbh = shift;
    my $vals = select_vallist($dbh, @_);
    return shift @$vals;
}

=head2 select_rowlist

  Usage   -
  Returns -
  Args    -

as select hashlist, returns a list of arrays

=cut

sub select_rowlist {
    my $dbh = shift;
    my $sth = get_iterator($dbh, @_);
    return $dbh->selectall_arrayref($sth);
}


=head2 get_hashrow

 parameters: statement handle

=cut

sub get_hashrow {

    my $sth = shift;
    my $hr = $sth->fetchrow_hashref;
    if ($hr) {
	return $hr;
    }
    else {
	if ($sth->err) {
	    confess($sth->err);
	}
	$sth->finish();
	return undef;
    }
}

=head2 get_iterator

 parameters: as for select_hashlist

gets a statement handle for a query. the results can be queried a row
at a time with get_hashrow

=cut

sub get_iterator {

    my ($dbh, $table_arr, $where_arr, $select_arr, $order_arr, $group_arr, $distinct) =
      rearrange(['dbh', 'tables', 'where', 'columns', 'order', 'group', 'distinct'], @_);

    if (!$table_arr) {
	confess("you must specify at least one table");
    }

    # either array or string
    if (!ref($table_arr)) {
	$table_arr = [$table_arr];
    }

    # either array or string
    if ($order_arr && !ref($order_arr)) {
	$order_arr = [$order_arr];
    }

    # either array or string
    if ($group_arr && !ref($group_arr)) {
	$group_arr = [$group_arr];
    }

    my @bind_vals = ();
    # either array or string
    if (!defined($where_arr)) {
	$where_arr = [];
    }
    if (!ref($where_arr)) {
	$where_arr = [$where_arr];
    }
    if (ref($where_arr) eq "HASH") {
	$where_arr =
	  [map {push(@bind_vals, $where_arr->{$_});"$_= ?"} keys %$where_arr];
    }

    if (!$select_arr) {
	$select_arr = ["*"];
    }
    elsif (!ref($select_arr)) {
	$select_arr = [$select_arr];
    }

#    my $sql = make_sql_select({select_arr=>$select_arr,
#			       where_arr=>$where_arr,
#			       table_arr=>$table_arr,
#			       order_arr=>$order_arr});
 
    my $sql = "select ";
    if ($distinct) {
        $sql.= "distinct ";
    }
    $sql .=
      join(", ", @$select_arr)." from ".join(", ", @$table_arr);
    if (@$where_arr) {
	$sql.= " where ".join(" and ", @$where_arr);
    }

    my @group_arr = @{$group_arr || []};
    if (@group_arr) {
	$sql.= " group by ".join(", ", @group_arr);
    }

    my @order_arr = @{$order_arr || []};
    if (@order_arr) {
	$sql.= " order by ".join(", ", @order_arr);
    }

    my $sth;
    sqllog($sql);
    $sth = $dbh->prepare($sql) ||
      confess "Err:".$dbh->errstr;

    @bind_vals && sqllog("   VALS: ".join(", ", map {$_ || ""} @bind_vals));
    # execute SQL
    $sth->execute(@bind_vals) ||
      confess $dbh->errstr;
    
    return $sth;
}

sub get_sql {

    my ($table_arr, $where_arr, $select_arr, $order_arr, $group_arr, $distinct, $limit) =
      rearrange(['tables', 'where', 'columns', 'order', 'group', 'distinct', 'limit'], @_);

    if (!$table_arr) {
	confess("you must specify at least one table");
    }

    # either array or string
    if (!ref($table_arr)) {
	$table_arr = [$table_arr];
    }

    # either array or string
    if ($order_arr && !ref($order_arr)) {
	$order_arr = [$order_arr];
    }

    # either array or string
    if ($group_arr && !ref($group_arr)) {
	$group_arr = [$group_arr];
    }

    my @bind_vals = ();
    # either array or string
    if (!defined($where_arr)) {
	$where_arr = [];
    }
    if (!ref($where_arr)) {
	$where_arr = [$where_arr];
    }
    if (ref($where_arr) eq "HASH") {
	$where_arr =
	  [map {push(@bind_vals, $where_arr->{$_});"$_= ?"} keys %$where_arr];
    }

    if (!$select_arr) {
	$select_arr = ["*"];
    }
    elsif (!ref($select_arr)) {
	$select_arr = [$select_arr];
    }

#    my $sql = make_sql_select({select_arr=>$select_arr,
#			       where_arr=>$where_arr,
#			       table_arr=>$table_arr,
#			       order_arr=>$order_arr});
 
    my $sql = "select ";
    if ($distinct) {
        $sql.= "distinct ";
    }
    $sql .=
      join(", ", @$select_arr)." from ".join(", ", @$table_arr);
    if (@$where_arr) {
	$sql.= " where ".join(" and ", @$where_arr);
    }

    my @order_arr = @{$order_arr || []};
    if (@order_arr) {
	$sql.= " order by ".join(", ", @order_arr);
    }

    my @group_arr = @{$group_arr || []};
    if (@group_arr) {
	$sql.= " group by ".join(", ", @group_arr);
    }
    if ($limit) {
	$sql .= " limit $limit";
    }

    return ($sql, @bind_vals);
}

=head2 sql_delete

 parameters: dbh, table, where

the "where" parameters can be either a string representing the where
clause, or an arrayref of clauses to be ANDed.

=cut

sub sql_delete {

    my ($dbh, $table, $where_arr) =
      rearrange(['dbh', 'table', 'where'], @_);

    if (!$table) {
	confess("you must specify a table");
    }

    # either array or string
    if (!defined($where_arr)) {
	$where_arr = [];
    }
    if (!ref($where_arr)) {
	$where_arr = [$where_arr];
    }

    my $sql = "delete from $table";
    if (@{$where_arr}) {
	$sql.= " where ".join(" and ", @{$where_arr});
    }
    
    my $sth;
    sqllog($sql);

    $sth = $dbh->prepare($sql) ||
      confess ($sql."\n\t".$dbh->errstr);

    # execute SQL
    $sth->execute() ||
      confess ($sql."\n\t".$dbh->errstr);
    
    return $sth;
}

=head2 insert_h

insert name/value pairs into a database table 

parameters: dbh, table, values (hashref of name/value pairs)

=cut

sub insert_h  {
    my ($dbh, $table, $values_hashref) =
      rearrange(['dbh', 'table', 'values'], @_);

    my @cols = keys %{$values_hashref};
    my @vals = values %{$values_hashref};
    my @qs = map { '?' } @cols;
    my $sth;
    my $sql = "insert into $table (".
      join(", ", @cols).
	") values (".
	  join(", ", @qs).
	    ")";

    sqllog($sql);
    $sth = $dbh->prepare($sql);
    if (!$sth) {
	confess ($sql."\n\t".$dbh->errstr);
    }
    sqllog("   VALS: ".join(", ", map {$_ || ""} @vals));
    $sth->execute(@vals) || confess($sql."\n\t".$sth->errstr);
#    return $dbh->{ix_sqlerrd}[1];
    return get_autoincrement_val($dbh, $table);
}

=head2 insert_hash_wp

synonym for insert_h

=cut

sub insert_hash_wp  {
    insert_h(@_);
}

=head2 insert_hash

parameters: dbh, table, values (hashref of name/value pairs)

returns: new primary key val (if the primary key is of type
informix-serial)

all values will be automatically sql-quoted (this may not be the
semantics you want - consider using insert_h() instead)

does not use DBI placeholders; the consequence of this is that it
cannot be used to insert BYTE or TEXT fields. Use insert_h()
instead. I would deprecate this method for the sake of aesthetics,
except a lot of code uses it.

note: 

=cut

sub insert_hash {

    my ($dbh, $table, $values_hashref) =
      rearrange(['dbh', 'table', 'values'], @_);
    my $sql = make_sql_insert($table, $values_hashref);
    sqllog($sql);
    my $sth = $dbh->prepare($sql) ||
      confess ($sql."\n\t".$dbh->errstr);

    $sth->execute() ||
      confess ($sql."\n\t".$dbh->errstr);

#    my $pkval = $dbh->{ix_sqlerrd}[1];
    my $pkval = get_autoincrement_val($dbh, $table);
    return $pkval;

}

=head2 update_h

update name/value pairs into a database table 

parameters: dbh, table, values (hashref of name/value pairs), where
(sql clause)

=cut

sub update_h  {
    my ($dbh, $table, $values_hashref, $where, $hints) =
      rearrange(['dbh', 'table', 'values', 'where', 'hints'], @_);

    my %vh = %{$values_hashref};

    # under informix, updates on text columns are forbidden
    # (sigh). the user of this method can specify in hints
    # that a column is text to use this jump-through-hoops way
    # of updating; requires _ldr table

    if ($hints 
	&& $hints->{text_column}
	&& defined($vh{$hints->{text_column}})
	&& ($ENV{DBMS} && lc($ENV{DBMS}) eq "informix")) {
	my $col = $hints->{text_column};
	my $pk = $hints->{primary_key} || 
	  confess("must set hints->{primary_key to use text_column");
	my $tmp_id = 
	  insert_h($dbh,
		   $table."_ldr",
		   {$col=>$vh{$col}});
	delete $vh{$col};
	my $sql = "update $table set $col = ".
	  "(select $col from $table"."_ldr where $pk=$tmp_id)".
	    " where $where";
	sqllog($sql);    
	my $sth = $dbh->prepare($sql) || confess($sql."\n\t".$dbh->errstr);
	$sth->execute() || confess($sql."\n\t".$sth->errstr);
	sql_delete($dbh, $table."_ldr", "$pk = $tmp_id");
    }
    
    my @cols = keys %vh;
    my @vals = values %vh;
    if (!@cols) {
	return;
    }
    my $sth;
#    my @qs = map { '?' } @cols;
#    my $sql = "update $table set (".
#      join(", ", @cols).
#	") = (".
#	  join(", ", @qs).
#	    ")";
#    $sql.= " where $where";
    my $sql = "update $table set ".
	join(", ", map {"$_=?"} @cols).
	    " where $where";
    sqllog($sql);    
    sqllog("   VALS: ".join(", ", @vals));
    $sth = $dbh->prepare($sql) || confess($sql."\n\t".$dbh->errstr);
    
    $sth->execute(@vals) || confess($sql."\n\t".$sth->errstr);
#    my $id = $dbh->{ix_sqlerrd}[1];  # this is probably pointless
    my $id = get_autoincrement_val($dbh, $table);

    return $id;
}

=head2 get_result_column

=cut

sub get_result_column {

    my ($dbh, $sql) = 
      rearrange(['dbh', 'sql'], @_);
    
    my $sth = $dbh->prepare($sql) ||
	confess ($sql."\n\t".$dbh->errstr);

    $sth->execute() ||
      confess $dbh->errstr;

    my $row = $sth->fetch();
    if (!$row) {
	if ($sth->err()) {
	    confess ($sql."\n\t".$sth->err())
	}
	return undef;
    }
    return $row->[0];
}

=head2 orterm

 usage: orterm($t1, $t2, $t3, ..);

=cut

sub orterm {
    return "(".join(" or ", @_).")";
}				

=head2 andterm

 usage: andterm($t1, $t2, $t3, ..);

=cut

sub andterm {
    return "(".join(" and ", @_).")";
}				

=head2 rearrange()

 Usage    : n/a
 Function : Rearranges named parameters to requested order.
 Returns  : @params - an array of parameters in the requested order.
 Argument : $order : a reference to an array which describes the desired
                     order of the named parameters.
            @param : an array of parameters, either as a list (in
                     which case the function simply returns the list),
                     or as an associative array (in which case the
                     function sorts the values according to @{$order}
                     and returns that new array.

 Exceptions : carps if a non-recognised parameter is sent

=cut

sub rearrange {
  # This function was taken from CGI.pm, written by Dr. Lincoln
  # Stein, and adapted for use in Bio::Seq by Richard Resnick.
  # ...then Chris Mungall came along and adapted it for BDGP
  my($order,@param) = @_;

  # If there are no parameters, we simply wish to return
  # an undef array which is the size of the @{$order} array.
  return (undef) x $#{$order} unless @param;

  # If we've got parameters, we need to check to see whether
  # they are named or simply listed. If they are listed, we
  # can just return them.
  return @param unless (defined($param[0]) && $param[0]=~/^-/);

  # Now we've got to do some work on the named parameters.
  # The next few lines strip out the '-' characters which
  # preceed the keys, and capitalizes them.
  my $i;
  for ($i=0;$i<@param;$i+=2) {
      if (!defined($param[$i])) {
	  carp("Hmmm in $i ".join(";", @param)." == ".join(";",@$order)."\n");
      }
      else {
	  $param[$i]=~s/^\-//;
	  $param[$i]=~tr/a-z/A-Z/;
      }
  }
  
  # Now we'll convert the @params variable into an associative array.
  my(%param) = @param;

  my(@return_array);
  
  # What we intend to do is loop through the @{$order} variable,
  # and for each value, we use that as a key into our associative
  # array, pushing the value at that key onto our return array.
  my($key);

  foreach $key (@{$order}) {
      $key=~tr/a-z/A-Z/;
      my($value) = $param{$key};
      delete $param{$key};
      push(@return_array,$value);
  }
  
  # catch user misspellings resulting in unrecognized names
  my(@restkeys) = keys %param;
  if (scalar(@restkeys) > 0) {
       carp("@restkeys not processed in rearrange(), did you use a
       non-recognized parameter name ? ");
  }
  return @return_array;
}


=head2 remove_duplicates

remove duplicate items from an array

 usage: remove_duplicates(\@arr)

affects the array passed in, and returns the modified array

=cut

sub remove_duplicates {
    
    my $arr_r = shift;
    my @arr = @{$arr_r};
    my %h = ();
    my $el;
    foreach $el (@arr) {
	$h{$el} = 1;
    }
    my @new_arr = ();
    foreach $el (keys %h) {
	push (@new_arr, $el);
    }
    @{$arr_r} = @new_arr;
    @new_arr;
}

1;