# This Software Package is copyrighted and the SOLE OWNERSHIP is
 # (c) 1997 - 2000  DragonWare Internet Solutions Corp. ALL RIGHTS RESERVED
 #
 # You may freely copy and distribute this software so long
 # as all documentation and this notice is included.
 #
 # If you wish to modify and distribute this software, feel free.
 # You MAY NOT charge for distributing it. If you modify it,
 # please make sure you document it (and if it is a good hack
 # let me know - I might include it in a future release).chris@zarahemla.com
 #
 # The most current release can always be found at
 # <URL:http://www.zarahemla.com/~chris/gnu/>
 #
 #                                  SOFTWARE WARRANTY AND DISCLAIMER
 #
 #DragonWare Internet Solutions Corp. makes no warranty of any kind, either express or implied
 #with respect to the design or use of this software package.  This software package provided
 #hereunder is provided "as is", and all warranties, express or implied including but not limited
 # to implied warranties of merchantability and fitness for a particular purpose are expressly
 # disclaimed.  There is no guarantee that the operation of the software package will be error 
 #free.  USER assumes any and all risk as the the results and the performance of this software
 #package.  In no event shall DragonWare Internet Solutions Corp. be held liable for any loss, 
 #expenses, or damages of any kind, whether such damages are direct, indirect, incidental or 
 #consequential arising in any manner from the use of the software package or any portion 
 #thereof.  
 # 
 ############################################################
 #VERSION 4.95
package Sql;
use constant MAILPROGRAM=>'/usr/lib/sendmail -t';
use constant LOGLOCATION=>'/var/log/Sql/translog';
$adminmail='admin@localhost';
# defaukt postgres perl lib get it at www.postgresql.org
use Pg;

sub Open {
    my($db, $host) = @_; my($conn);
    $db = lc($db);
   
    $host = 'localhost'; # replace with the machine name
    chomp($host);
    for (my($i) = 0; !$conn && $i < 2; ++$i) {
	    $conn = Pg::connectdb("dbname=$db");  #  host=$host
	$conn = 0, Restart() if $conn->status() != 0;
    }
    open(LOG, ">> LOGLOCATION/$db.log");
    return $conn;
}

sub Restart {
  
  open(MAIL, "| MAILPROGRAM");
  print MAIL <<"!EOF!";
To: $adminmail
Subject: Problem with postmaster on $host

There seems to be a problem with the postmaster running on $host.
It appears to be running, but psql was unable to connect.
!EOF!
  close(MAIL);
  
}

# Return a single value
sub Value {
  my($conn, $cmd) = @_;  my(@reply);
  Query($conn, $cmd, \@reply);
  return 0 if $#reply != 0;
  my($val) = $reply[0];
  chomp($val);
  return $val =~ /\t/ ? split('\t', $val) : $val;
}

sub Query {
  my($conn, $sql, $ref_array_values, $delimiter, $ref_array_names, $ref_array_types, $ref_array_sizes) = @_;
  $delimiter = "\t" if ( ! defined $delimiter );
  my($cmd, $result, $status, $nfields, $ntuples, $i, $j);
  $result = $conn->exec($sql);
  if ($result->resultStatus() == 2) {   # PGRES_TUPLES_OK == 2
    $nfields = $result->nfields();
    $ntuples = $Sql::Rows = $result->ntuples();
    if ($ref_array_names) {
      for ($j = 0; $j < $nfields; ++$j) {
	$$ref_array_names[$j] = $result->fname($j);
      }
    }
    if ($ref_array_types) {
      for ($j = 0; $j < $nfields; ++$j) {
	$$ref_array_types[$j] = $result->ftype($j);
      }
    }
    if ($ref_array_sizes) {
      for ($j = 0; $j < $nfields; ++$j) {
	$$ref_array_sizes[$j] = $result->fsize($j);
      }
    }
    for ($i = 0; $i < $ntuples; ++$i) {
      $$ref_array_values[$i] = '';
      for ($j = 0; $j < $nfields; ++$j) {
	my($val) = $result->getvalue($i, $j);
	$$ref_array_values[$i] .= $j ? $delimiter . $val : $val;
      }
    }
  }
  return 0;
}

# HQuery works like Query, but it returns an array of hashrefs instead of an array of delimited strings.
# Usage:
#       Sql::HQuery( $dbHandle, $query, \@results );
# To see the results, dereference the array and hash with the name of one of the fields in the select statement:
#       foreach my $r ( @results ) {
#           print $r->{ 'product_id' } . "\n";
#       }
# Or:
#       print ${$results[ 0 ]}{ 'product_id' } . "\n";
# Caveat: HQuery uses the names of fields as hash keys, but those names do not include the table names. So if
# you do something like this:
#       $query = "select table1.description, table2.description, ...";
# then 'description' from one table will clobber the other 'description'. The solution is to use verbose field
# names or to not call both of them in one select statement. Or use Sql::Query.
sub HQuery{
  my($conn, $sql, $ref_hash_values, $ref_array_names, $ref_array_types, $ref_array_sizes) = @_;
  my($cmd, $result, $status, $nfields, $ntuples, $i, $j);
  $result = $conn->exec($sql);
  if ($result->resultStatus() == 2) {	  # PGRES_TUPLES_OK == 2
    $nfields = $result->nfields();
    $ntuples = $Sql::Rows = $result->ntuples();
    if ($ref_array_names) {
      for ($j = 0; $j < $nfields; ++$j) {
	$$ref_array_names[$j] = $result->fname($j);
      }
    }
    if ($ref_array_types) {
      for ($j = 0; $j < $nfields; ++$j) {
	$$ref_array_types[$j] = $result->ftype($j);
      }
    }
    if ($ref_array_sizes) {
      for ($j = 0; $j < $nfields; ++$j) {
	$$ref_array_sizes[$j] = $result->fsize($j);
      }
    }
    for ($i = 0; $i < $ntuples; $i++) {
      my %value;
      for ($j = 0; $j < $nfields; ++$j) {
	$value{ $result->fname($j) } = $result->getvalue($i, $j);
      }
      $$ref_hash_values[ $i ] = \%value;
    }
  }
  return 0;
}

sub Trans {
  my($conn, $sql, $ref_array_values) = @_;
  $sql = LogSql($sql);
  my($result) = $conn->exec("begin; $sql end;");	# PGRES_COMMAND_OK == 1
  $Sql::Rows = $result->cmdTuples();
  
  return $result->resultStatus() !=1 ;
}

sub Sql {
  my($conn, $sql) = @_;
  $sql = LogSql($sql);  
  my($result) = $conn->exec($sql);			# PGRES_COMMAND_OK == 1
  $Sql::Rows = $result->cmdTuples();
  
  return $result->resultStatus() != 1;
}

sub Close {
  my($conn) = @_;
  close(LOG);
}

sub LogSql {
  my($sql) = @_;
  # Remove next line when postgres is fixed so it does not require semicolons.
  #$sql =~ s/\n/;\n/g;
  $sql.=";";
  # Do file locking so we don't trample the log file
  $LOCK_EX = 2; # Exclusive lock with blocking
  $LOCK_UN = 8; # Unlock (it does anyway when you close the file)
  
  open TICKET, "/var/lock/logsql.lock";
  flock TICKET, $LOCK_EX;
  print LOG "$sql\n";
  flock TICKET, $LOCK_UN;
  close TICKET;
  return $sql;
}

1;