##########################################################################
# package DBTools.pm
# This Perl module contains functions useful for accessing databases
# using DBI

# V      Who       When        What
# ---------------------------------------------------------------------------
# 1.0.5  skendric  06-16-2008  Stylistic mods
# 1.0.4  skendric  03-12-2007  Stylistic mods
# 1.0.3  skendric  07-11-2006  More debugging
# 1.0.2  skendric  06-24-2005  More debugging
# 1.0.1  skendric  06-13-2005  Check subroutine parameters
# 1.0.0  skendric  02-13-2005  First version
#
#
#
# Authors:  Stuart Kendrick <sbk {insert at sign here } skendric
#                                {insert dot here} com>
#
# Source:  http://www.skendric.com/device/soma
#
# This software is available under the GNU GENERAL PUBLIC LICENSE, see
# http://www.fsf.org/licenses/gpl.html
#


package FHCRC::VDOPS::DBTools;

#### Load modules ####
use strict;
use warnings;
use Carp qw(carp cluck croak confess);
use Data::Dumper;
use DBI qw(:sql_types);
use DBD::Pg qw(:pg_types);
use Exporter;
use Perl6::Say;
use Switch;

use lib '/home/soma/lib';
use FHCRC::VDOPS::SomaData;
use FHCRC::VDOPS::Utilities;

#### Set-up export stuff ####
our @ISA = qw(Exporter);
our @EXPORT = qw(
                       close_dbi_handles
                       connect_db
                       dbi_trace
                       disconnect_db
                       find_multiple
                       find_one_list
                       find_one_scalar
                 );


##### Assign global variables ####

##### Only subroutines below here ####


########################################################################
# Given a DBI dbh followed by an optional list of DBI sth, close the 
# sth and disconnect from the database
########################################################################
sub close_dbi_handles {
  my $dbh = shift;
  my @sth = @_;

  # Debug trace
  trace_location('begin') if $debug > 3;

  # Close statement handles
  for my $sth (@sth) {
    $sth->finish() if defined $sth;
  }

  # Disconnect from database
  $dbh->disconnect() or print_it("DBI: $DBI::errstr\n") if defined $dbh;

  # Debug trace
  trace_location('end') if $debug > 3;

  return $dbh;
}




########################################################################
# Given a database name, username, and password, return a DBI reference
# to a connection handle
########################################################################
sub connect_db {
  my ($name, $host, $port, $user, $password) = @_;
  my $dbh;

  # Debug trace
  trace_location('begin') if $debug;

  # Sanity checking
  confess 'Not enough parameters' unless (defined $name and defined $host and defined $port and defined $user and defined $password);

  # Do the work
  $dbh = DBI->connect("$dbDriver:dbname=$name;host=$host;port=$port;",  
                      "$user", "$password", {
           AutoCommit => 1,
           PrintError => 0,
           RaiseError => 0
  }  );

  # Debug trace
  trace_location('end') if $debug;

  return $dbh;
}




####################################################################### 
# Given a trace level, call DBI->trace
########################################################################
sub dbi_trace {
  my $level = shift;
  my ($subroutine) = (caller (1))[3];
  my $file;

  # Debug trace
  trace_location('begin') if $debug;

  # Define variables
  $file = $subroutine . $DOT . $dbiTrace;

  # Remove previous trace file
  unless ($level == 0) {
    if (-e $file) {
      unlink $file or warn "Cannot delete $file: $!\n";
    }
  }

  # Do the work 
  switch($level) {
    case 0  { DBI->trace( 0, $file ) }
    case 1  { DBI->trace( 1, $file ) }
    case 2  { DBI->trace( 2, $file ) }
    case 3  { DBI->trace( 3, $file ) }
    case 4  { DBI->trace( 4, $file ) }
    case 5  { DBI->trace( 5, $file ) }
    case 6  { DBI->trace( 5, $file ) }
    case 7  { DBI->trace( 5, $file ) }
    case 8  { DBI->trace( 5, $file ) }
    case 9  { DBI->trace( 5, $file ) }
    case 10 { DBI->trace( 5, $file ) }
    case 11 { DBI->trace( 5, $file ) }
    case 12 { DBI->trace( 5, $file ) }
    case 13 { DBI->trace( 5, $file ) }
    case 14 { DBI->trace( 5, $file ) }
    case 15 { DBI->trace( 5, $file ) }
  }

  # Debug trace
  trace_location('end') if $debug;

  return 1;
}




########################################################################
# Given a DBI connect handle, disconnect
########################################################################
sub disconnect_db {
  my $dbh = shift;

  # Debug trace
  trace_location('begin') if $debug;

  $dbh->disconnect or print_it("Failed to disconnect $DBI::errstr\n");

  # Debug trace
  trace_location('end') if $debug;

  return $dbh;
}




########################################################################
# Given a bind_param and a DBI sth, return:
#   (a) an array ref to a list of the resulting values from the database
#   (b) undef if not found
# I use this routine when I'm expecting one or more values 
########################################################################
sub find_multiple {
  my $array_ref;
  my $param = shift;      # bind_param handed to us by calling routine
  my $sth = shift;        # DBI statement handle
  my $val;                # value returned from database

  # Debug trace
  trace_location('begin') if $debug == 7;

  # Sanity checking
  confess 'Not enough parameters' unless (defined $param and defined $sth);

  # Acquire result
  $sth->bind_param(1, $param);
  $sth->execute();
  $array_ref = $sth->fetchall_arrayref();

  # Process results
  if    (@$array_ref >= 1) {    # Found one or more values
    $val = $array_ref;
  }
  elsif (@$array_ref < 1) {     # $param is not in database
    undef $val;
  }

  # Debug trace
  trace_location('end') if $debug == 7;

  return $val;
}




########################################################################
# Given a bind_param, a DBI sth,  and optionally an SQL data type, return:
#   (a) the resulting list value from database
#   (b) undef if not found
#   (c) undef if more than one row
# I use this routine when I expect exactly one row from the database and 
# when I want to complain if the database returns more than one row
########################################################################
sub find_one_list {
  my $array_ref;
  my $param = shift;      # bind_param handed to us by calling routine
  my @row;                # row returned from the database
  my $sth = shift;        # DBI statement handle
  my $type = shift;       # SQL data type of $param

  # Sanity checking
  confess 'Not enough parameters' unless (defined $param and defined $sth);

  # Debug trace
  trace_location('begin') if $debug == 7;

  # Acquire result
  if (defined $type) {
    $sth->bind_param(1, $param, { TYPE => $type } );
  }
  else {
    $sth->bind_param(1, $param);
  }
  $sth->execute();
  $array_ref = $sth->fetchall_arrayref();

  # Process results
  if    (@$array_ref == 1) {    # Found exactly one row
    @row = @{$array_ref->[0]};
  }
  elsif (@$array_ref > 1)  {    # Found more than one row
    undef @row;
    my ($me) = (caller (0))[3];
    my ($parent) = (caller (1))[3];
    log_it("$me found multiple entries for $param when called from $parent\n");
    if ($debug > 3) {
      for my $element (@$array_ref) { print Dumper($element) }
      say();
    }
  }
  elsif (@$array_ref < 1) {     # $param is not in the database
    undef @row;
  }

  # Debug info
  if ($debug == 7) {
    for (my $i = 0; $i < @row; $i++) {
      say "row[$i] = $row[$i]" if defined $row[$i];
    }
  }

  # Debug trace
  trace_location('end') if $debug == 7;

  return @row;
}




########################################################################
# Given a bind_param, a DBI sth,  and optionally an SQL data type, return:
#   (a) the resulting scalar value from the database
#   (b) undef if not found
#   (c) undef if more than one row
# I use this routine when I expect exactly one row from the database and 
# when I want to complain if the database returns more than one row
########################################################################
sub find_one_scalar {
  my $array_ref;
  my $param = shift;      # bind_param handed to us by calling routine
  my $val;                # val returned from the database
  my $sth = shift;        # DBI statement handle
  my $type = shift;       # SQL data type of $param

  # Debug trace
  trace_location('begin') if $debug == 7;

  # Sanity checking
  confess 'Not enough parameters' unless (defined $param and defined $sth);

  # Debug info
  say "Receiving '$param'" if $debug == 7;

  # Acquire result
  if (defined $type) {
    $sth->bind_param(1, $param, { TYPE => $type } );
  }
  else {
    $sth->bind_param(1, $param);
  }
  $sth->execute();
  $array_ref = $sth->fetchall_arrayref();

  # Process results
  if    (@$array_ref == 1) {    # Found exactly one row
    $val = $array_ref->[0]->[0];
  }
  elsif (@$array_ref > 1)  {    # Found more than one row
    undef $val;
    my ($me) = (caller (0))[3];
    my ($parent) = (caller (1))[3];
    log_it("$me found multiple entries for $param\n");
    if ($debug > 3) {
      for my $element (@$array_ref) { print Dumper($element) }
      say();
    }
  }
  elsif (@$array_ref < 1) {     # $param is not in the database
    undef $val;
  }

  # Debug info
  say "Returning '$val'" if ($val and $debug == 7);

  # Debug trace
  trace_location('end') if $debug == 7;

  return $val;
}



1;