#!/usr/bin/perl
#
# Module for connecting to postgreSQL database using Pg
# use:
# require "connectDBD.pl";
#
# This programm depends on the DBI/DBD::Pg modules. 
# As this seems to be a project in progress, you might
# want to make sure you have the correct versions. 
# Sadly, these work only with the newer perl versions (5.8?).
# Upgrade with:
# perl -MCPAN -e shell
# > install Bundle::DBI
# > install Bundle::DBD::Pg
# > quit
#
# and hope for the best!
#
# If you can instal Debian packages, you can try to install
# >apt-get install libdbd-pg-perl
#
# Or just about the complete set of PostgreSQL packages including
# the Perl interfaces.
#
# 
use DBI;
use DBD::Pg;
#
#> Just ouptut the all comments if Help is used
if(grep(/\-?\-h(elp)/, @ARGV))
{
	my $Executable = $0;
	open(PROGRAMFILE, "<$Executable") || die "$Executable: $!\n";
	while(<PROGRAMFILE>)
	{
		next unless /^\#(\s|\#|$)/ or /^\s*sub/;
		s/^\s*\#( |$)//isg;
		print $_;
	};
	close(PROGRAMFILE);
	exit;
};
#
# $DBMSaddress, corpus name, user and password are defined in Links.pl!!!
# You can define all variables $DBMSaddress $DBMSname, $DBMSuser, $DBMSpassword
# before you 'require "connectDBD.pl";'
#
($pghost, $pgport, $pgoptions, $pgtty, $dbname, $user, $password, $pgsslmode) =
        ("$DBMSaddress", '5432', '', '', $DBMSname, $DBMSuser, $DBMSpassword, 'prefer');  
$conn;

#> Connecting to current user at a "postmaster" at the selected host.
$conn = DBI->connect(
    "dbi:Pg:dbname=$dbname;host=$pghost;port=$pgport;options='$pgoptions';tty='$pgtty';sslmode=$pgsslmode",
	$user, $password);

if(!$conn || $DBI::err)
{
    print STDERR << "DBDCONNECTIONERROR";
Connection Error:
DBI->connect("dbi:Pg:dbname=$dbname;host=$pghost;port=$pgport;options='$pgoptions';tty='$pgtty';sslmode='$pgsslmode'",
	$user, <PASSWD>)

parameter  environment variable  hard coded default
--------------------------------------------------
dbname     PGDATABASE            current userid
host       PGHOST                localhost
port       PGPORT                5432
options    PGOPTIONS             ""
tty        PGTTY                 ""
username   PGUSER                current userid
password   PGPASSWORD            ""
service*   PGSERVICE             (none)
sslmode*   PGSSLMODE             (none)

DBDCONNECTIONERROR
    print STDERR "connect error: ", $DBI::errstr, "\n";
    die "died failing connect $!\n";
};

#> A statement handle
$sth;

#############################################################################
#
# EXAMPLE OF HOW TO USE DBD::Pg (assuming you 'require "connectDBD.pl";' first)
#
#############################################################################
#
# Example function to extract values from records from a given table.
# All matching records are pushed onto a single flat list.
# NOTE: No security or sanity checks whatsoever are performed. DO NOT use
# this function unqualified in a HTTP/CGI environment. Unchecked CGI variables
# will allow internet-users to wreck havoc on your database/system
#
# $TableName	The name of the table, e.g., 'subjects'
# $IdentifyingWhere, 	The Where clause, e.g., "speaker~'F' and age > 30"
# $AttributeName1, ..., $AttributeNameN		The columnnames, e.g., ('height', 'weight', 'fl')
#
# The variable that gets the array reference to all the results
sub getSQLrecordvalues	# ($TableName, $IdentifyingWhere, $AttributeName1, ..., $AttributeNameN) -> @AllAttributeValues
{
	my $TableName = shift || return ();
	my $IdentifyingWhere = shift || "";
	my @AttributeNames = @_;
	@AttributeNames = ('*') unless @AttributeNames;
	#
	# Construct SELECT statement
	my $SELECT = "SELECT \n\t";	# Select only distinct entries
	$SELECT .= join(', ', @AttributeNames);	# The atribute names to get
	$SELECT .= "\nFROM \n\t$TableName";	# The tablename (this could be table NAMES)
	if($IdentifyingWhere =~ /\S/)
	{
		$SELECT .= "\nWHERE\n\t";		# Conditions to selct the records
		$SELECT .= "$IdentifyingWhere\n";	# Which record. Only ONE record is used (the LAST)
	};
	# Get a handle that will allow us to get at the query later on
    $sth = $conn->prepare("$SELECT;");
	# Get the record(s)
	my $result = $conn->selectall_arrayref($sth);

	# Signal an ERROR
	print $conn->errstr, 
		"\nExecuting: $conn->{Statement}\n" if($conn->err);

	# Extract the record
	my @ResultList = ();
	my @row;
	while(@$result && ($row = shift(@$result)))
	{
		push(@ResultList, @$row);
	};
	
	# Ready
	return @ResultList;
};

#
# Get the names of all the attributes from the last getSQLrecordvalues SELECT
sub getSQLattributeNames	# () -> @AllAttributeNames
{
	my @field_names = @{$sth->{NAME}};
	
	# Ready
	return @field_names;
};

#
###############################################################################
#
# Copyright R.J.J.H. van Son © 2000, 2001, 2006
#
# Author Rob van Son
# Institute of Phonetic Sciences & ACLC
# University of Amsterdam
# Herengracht 338
# NL-1016CG Amsterdam, The Netherlands
# Email: R.J.J.H.vanSon@uva.nl
#        ifa@uva.nl
# WWW  : http://www.fon.hum.uva.nl/rob/
# mail:  Institute of Phonetic Sciences
#        University of Amsterdam
#        Herengracht 338
#        NL-1016CG Amsterdam
#        The Netherlands
#        tel +31 205252183
#        fax +31 205252197
#
# License for use and disclaimers
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#
#######################################################
#
#> Make require happy
1;
