#!/usr/local/bin/perl
#=======================================================================
#
#  NAME
#
#  db_access.pl
#
#  DESCRIPTION
#
#  3 subroutines to connect, retrieve and change the database
#
#  OPTIONS
#
#   None
#
#  HISTORY
#
#   01/26/2004 49680 L Gardner Initial Release
#   01/18/2011 67212 L Gardner Fix warning errors
#
#=======================================================================

use strict;
use warnings;

use STScI::DBI;            # Database access routines

#-----------------------------------------------------------------------
#
# Subroutine DBConnect:
#   Connects the the database and captures errors.
#   The func calls insures that all dates coming back will be to the 
#   millisecond level.
#
#-----------------------------------------------------------------------
sub DBConnect
{
   my ( $server, $database, $user )  = @_;

   my  $dbh = '';

   eval{
      $dbh = STScI::DBI->connect( "dbi:Sybase:server=$server" )
                or die "Can't connect to database: $DBI::errstr";

      $dbh->do("use $database") or die;
      $dbh->func("LONG","_date_fmt");
   };

   die "Can not connect to $server/$database, getting error\n$@\n" if $@;

   $dbh;
}

#-----------------------------------------------------------------------
#
# Subroutine GetDbValues:
#   Runs a select query and returns an array of array references.  It
#   also strips off leading and trailing spaces from each element
#   of the array returned.  
#
#-----------------------------------------------------------------------
sub GetDbValues
{
   my ( $dbh, $query )  = @_;

   my @refs = ();

   eval {

     my $sth = $dbh->prepare($query) or
                 die "Can't prepare query:" . $dbh->errstr;
               $sth->execute         or
                 die "Can't execute query:" . $dbh->errstr;

      while ( my @dat = $sth->fetchrow_array ) {
         if ( @dat ) {
            # Need this line to get rid of warnings.  nulls not allowed.
            @dat = map { defined($_) ? $_ : '' } @dat;
            s/^\s+//g for @dat;
            s/\s+$//g for @dat;
            push( @refs, [@dat] );
         }
      }

      $sth->finish;
   };

   die "Processing Query:$query\n$@" if $@;

   @refs;
}

#-----------------------------------------------------------------------
#
# Subroutine GetDbScalar:
#   Calls GetDbValues and returns a scalar.
#
#-----------------------------------------------------------------------
sub GetDbScalar
{
   my ( $dbh, $query )  = @_;

   my @rows = GetDbValues( $dbh, $query );
   return $rows[0]->[0] if @rows;
   return '';
}

#-----------------------------------------------------------------------
#
# Subroutine GetDbHash:
#   Calls GetDbValues and returns a hash.
#   map{@$_} - it's takes each key/value array ref, flattening it out 
#   to a little 2-element (key,value) array, and attaching that to the 
#   end of map's result. So the whole thing comes out of map looking 
#   like a (key,value,key,value,...) list. Assigning the return result 
#   of the sub to a hash is what turns the list into a hash.
#
#-----------------------------------------------------------------------
sub GetDbHash
{
   my ( $dbh, $query )  = @_;

   return map{@$_} GetDbValues( $dbh, $query );
}

#-----------------------------------------------------------------------
#
# Subroutine GetDbArray:
#   Calls GetDbValues and returns an array of the first record.
#
#-----------------------------------------------------------------------
sub GetDbArray
{
   my ( $dbh, $query )  = @_;

   my @rows = GetDbValues( $dbh, $query );

   return @{$rows[0]} if @rows;
   return ();
}

#-----------------------------------------------------------------------
#
# Subroutine SetDbValues:
#   Delete, Insert or Update a record to the database
#   DBI returns 0E0 when the number of rows returned is 0.  I want 
#   the original 0 so I'm translating it back.
#
#-----------------------------------------------------------------------
sub SetDbValues
{
   my ( $dbh, $query ) = @_;

   my $rowsAffected = '';

   eval {
      $rowsAffected = $dbh->do($query) or die $dbh->errstr . "\nQuery=$query\n";
      $rowsAffected = 0 if $rowsAffected eq "0E0";
   };

   die "Error encountered running query:$query\n$@" if $@;

   return $rowsAffected;
}
1;