#
# COPYRIGHT
#       Copyright (C) 2001-3, Bernard Quatermass
#                             bernard at quatermass.co.uk
#                             http://quatermass.co.uk/
# 
#       This package may be distributed under the terms of either the
#       GNU General Public License
#         or the
#       Perl Artistic License
# 
#       All rights reserved.
#

package DBIUtil;

use strict;

BEGIN {
    use Exporter   ();
    use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    # set the version for version checking
    #$VERSION     = 1.00;
    # if using RCS/CVS, this may be preferred
    $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker

    @ISA         = qw(Exporter);
    @EXPORT      = qw(&DBConnect &DBDisconnect);
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

    # your exported package globals go here,
    # as well as any optionally exported functions
    #@EXPORT_OK   = qw($Var1 %Hashit &func3);
    @EXPORT_OK   = qw(  &fetch_row
			&fetch_rows
			&get_seq_nbr
			&db_start_transaction
			&db_commit_transaction
			&db_rollback_transaction
			&db_execute
			&array_to_hash
		     );
}
use vars      @EXPORT_OK;

use DBI;
use FileHandle;

my $dbconf="/etc/DBConnect.conf";

my $defattrs = { RaiseError => 0, PrintError => 0, AutoCommit => 1 };
my $cfg;

##
## DBConnect performs a DBI connect, optionally looking
##  pertinent details like full dsn, user and password
##  If no dsn is supplied then it takes the value of the
##  "default" and performs the lookout with that.
##
## A typical DBConnect file might look like....
##
##  DEFAULT=normaldb
##
##  otherdb dbi:Pg:dbname=otherdb;host=dbhost.example.com dbuser dbpassword
##
##  normaldb dbi:Pg:dbname=normaldb;host=localhost me
##
sub
DBConnect
{
    my ($dsn,$user,$upwd,$attrs) = @_;
    _load_config() if ! $cfg;

    $dsn = $cfg->{'default'}
	if ! $dsn;
    if(exists $cfg->{'DB'}->{$dsn})
    {
	#Use the various parameters where applicable
	my $db = $cfg->{'DB'}->{$dsn};
	$dsn = $db->{'dsn'};
	$user = $db->{'user'} if ! $user;
	$upwd = $db->{'passwd'} if ! $upwd;
    }
    $attrs = $defattrs if ! $attrs;

    my $dbh = DBI->connect( $dsn, $user, $upwd, $attrs );
    return $dbh;
}

##
## Disconnect that database
##
sub
DBDisconnect
{
    my $dbh = shift;
    $dbh->disconnect;
    undef $dbh;
}

##
## fetch a number of rows from the db,
##  returning an array reference of hash references
##  and optionally a count
##
sub
fetch_rows
{
    my $dbh = shift;
    my $select = shift;
    my ($rv,$rref,$cnt);
    my $sth = $dbh->prepare($select);
    if ($sth->execute(@_))
    {
	$rv=();
	while($rref= $sth->fetchrow_hashref)
	{
	    $cnt++;
	    push @$rv, $rref;
	}
    }
    undef $sth;
    $rv=[] if ! $cnt;
    return wantarray ? ($cnt,$rv) : $rv;
}

##
## fetch a single row, returning hashref of resultant row
##
## THINKS: should this use wantarray and possibly return the error ?
##
sub
fetch_row
{
    my $dbh = shift;
    my $select = shift;
    my $rref;
    my $sth = $dbh->prepare($select);
    $rref = $sth->fetchrow_hashref
	if $sth->execute(@_);
    undef $sth;
    return $rref;
}

##
## start a transaction
##  returns the previous state of the AutoCommit variable which
##  should be handed to either the abort or commit routine at
##  some point later.
##
sub
db_start_transaction
{
    my $dbh=shift;
    my $oldcommit = $dbh->{'AutoCommit'};
    $dbh->{'AutoCommit'} = 0;
    return($oldcommit);
}

##
## commit a transaction
##  pass in the value from the start_transaction
##  returns the value from the commit
##
sub
db_commit_transaction
{
    my $dbh=shift;
    my $rv = $dbh->commit;
    $dbh->{'AutoCommit'} = $_[0];
    return($rv);
}

##
## abort a transaction
##  pass in the value from the start_transaction
##  returns the value from the abort
##
sub
db_rollback_transaction
{
    my $dbh=shift;
    my $rv = $dbh->rollback;
    $dbh->{'AutoCommit'} = $_[0];
    return($rv);
}

##
## execute some j-random piece of supplied SQL
##
sub
db_execute
{
    my $dbh=shift;
    my $statement=shift;
    #Directly execute some supplied piece of supplied SQL
    my $sth = $dbh->prepare($statement);
    my $rv = $sth->execute(@_);
    my $emsg = $dbh->errstr;
    return wantarray ? ($rv,$emsg) : $rv;
}

##
## fetch the next value from a sequence number
##
sub
get_seq_nbr
{
    my $dbh = shift;
    my $sname = shift;
    my ($rv,$mess);

    my $rref = fetch_row($dbh, sprintf("select nextval('%s')",$sname));
    if ($rref)
    {
	$rv = $rref->{'nextval'};
	$mess="";
    }else
    {
	$mess = $dbh->errstr;
    }
    return wantarray ? ($rv,$mess) : $rv;
}

##
## convert an array reference to a hash reference using
## the supplied field name as the key
## typically used in conjunction with the fetch_rows routine
##
sub
array_to_hash
{
    my $aref = shift;
    my $key = shift;
    my $href = {};
    foreach(@$aref)
    {
	$href->{$_->{$key}} = $_;
    }
    return $href;
}

##
## Private functions
##

sub
_load_config
{
    #Not sure where to load this stuff from.
    #so for now, we check /etc/DBConnect.conf
    # This will need to be improved upon, since we may well
    # have password in there.
    $cfg={
	    'default' => '',
	    'DB' => {},
	};
    my @bits;
    my $ifh = new FileHandle;
    if (open $ifh, $dbconf )
    {
	while(<$ifh>)
	{
	    chomp;
	    s/\s*\#.*//;
	    next if ! length;
	    if(/^default\s*=/i)
	    {
		@bits = split /=/,$_;
		$cfg->{'default'} = $bits[1]
		    if $bits[0] =~ /default/i;
	    }else
	    {
		@bits = split /\s+/,$_,4;
		$cfg->{'DB'}->{$bits[0]} = {
			    'alias' => $bits[0],
			    'dsn' => $bits[1],
			    'user' => $bits[2],
			    'passwd' => $bits[3],
			    };
	    }
	}
    }
    return $cfg;
}

1;