package DB::DBlib;

use DBI;
use Carp;

use vars (@ISA, @EXPORT_TAGS, %$dbh);
$dbh = undef; # package global

$DB::DBlib::VERSION='0.10';

require Exporter;
@ISA = qw(Exporter);

# export nothing by default
@EXPORT = ();

# export functions by request
@EXPORT_OK = qw(

	DBSelectSQL 

	DBConnect 
	DBExecSQL 
	DBSQLError 

	DBGetRow 
	DBGetRowSet 
	DBGetRowsAll 
	DBGetNext 
	DBGetRowValues 
	DBGetColValues 
);

# named sets of functions to export
%EXPORT_TAGS = ( 

	# Just SQL Parsing Functions
	Parse => [ qw (
		DBSelectSQL
	)], 

	# Parsing & Execution Functions
	Execute => [ qw (
		DBSelectSQL 
		DBConnect 
		DBExecSQL 
		DBSQLError 
	)], 

	# Parsing, Execution & Row-Processing Functions (e.g. everything)
	Fetch	=> [ @EXPORT_OK ], 
);


################################################
# SQL Parsing Functions
################################################

sub DBSelectSQL {
	# takes a hash of named parms:
	#	columns 	=> [@column_names] 	or $column_name,
	#	from  	=> [@table_names] 	or $table_name,
	#	where		=> [@criteria_expressions] 	or $criteria_expression,
	#	orderby	=> [@column_names_or_numbers]	or $column_name_or_number,
	#	limit		=> $max_num_of_rows_to_return,
	#	offset	=> $first_row_number_to_return, 	# (only if limit >0) 
	#
	# and (hopefully) returns a formatted SQL statement as a scalar string

	croak "odd parms passed to DBSelectSQL" if @_%2;
	my %parms=@_;

	croak "no from clause" unless $parms{from};

	my @from = ref($parms{from})=~/^array/i ? @{$parms{from}} : ($parms{from});
	
	my @cols = exists $parms{columns} 
		? ref($parms{columns})=~/^array/i ? @{$parms{columns}} : $parms{columns} : ('*');

	my @where = $parms{where} 
		? ref($parms{where})=~/^array/i ? @{$parms{where}} : ($parms{where}) :();

	my @groupby = $parms{groupby} 
		? ref($parms{groupby})=~/^array/i ? @{$parms{groupby}} : ($parms{groupby}) : ();

	my @having = $parms{having} 
		? ref($parms{having})=~/^array/i ? @{$parms{having}} : $parms{having} : ();

	my @orderby = $parms{orderby} 
		? ref($parms{orderby})=~/^array/i ? @{$parms{orderby}} : $parms{orderby} : ();

	my ($offset, $limit) = @parms{'offset', 'limit'};
	my $distinct = "DISTINCT" if $parms{distinct};

	my $sql = "SELECT $distinct \n\t" . join (" ,\n\t", @cols);
	$sql .= "\n" . "FROM \n\t" . join (" ,\n\t", @from);
	$sql .= "\n" . "WHERE \n\t" . join (" AND \n\t", @where) if @where;
	$sql .= ("\n" . "GROUP BY \n\t" . join (" ,\n\t", @groupby)) if @groupby ;
	$sql .= ("\n" . "HAVING \n\t" . join (" ,\n\t", @having)) if @having;
	$sql .= ("\n" . "ORDER BY \n\t" . join (" ,\n\t", @orderby)) if @orderby;
	$sql .= ("\n" . "LIMIT " . ($offset || '0') . ", ".$limit) if $limit;

	return $sql;
}

################################################
# SQL Execution & Error Handling Functions
################################################

sub DBConnect {
	croak "DBConnect requires named parms (odd parms passed)" if @_%2;
	my %db = @_;

	
	my $or_die = $db{or_die} ? 1 : 0;

	$dbh = DBI->connect(
		"DBI:mysql:$db{name}:$db{host}:$db{port}", 
		$db{user}, 
		$db{pass}, 
		{
			RaiseError => $or_die, 
			PrintError => $or_die,
		}, 
	);

	return $dbh;
}

sub DBExecSQL {
	# takes DBSelectSQL style named parms, plus, optionally
	# debug => 1 to dump: the SQL before execution and "info" after, 
	# and sql => $sqlcommand to bypass the DBSelectSQL call

	# if $parms{$sql} is not supplied, calls DBSelectSQL
	# with the other parms to generate an SQL command, 

	# executes the SQL, and returns the DBI statement handle 
	# (this does not fetch the result - see the DBGet* calls for that)

	croak "odd parms passed to DBExecSQL" if @_%2;
	croak "no parms passed to DBExecSQL" unless @_;

	my %parms=@_;
	my $sql=$parms{sql};
	my $debug = $parms{debug};

	$sql = &DBSelectSQL(%parms) unless $sql;

	croak "no sql" unless $sql;

	if ($debug) {
		&Header("debug") unless $didheader || $main::didheader;
		print "<h3>query:</h3>\n", 
			"<pre>", $sql, "</pre><br>\n";
	}

	$dbh->{RaiseError}=0;

	my $sth = $dbh->prepare($sql) or &DBSQLError($sql, "prepare failed", $sth);
	$sth->execute or &DBSQLError($sql, "execute failed", $sth);

	if ($debug and $dbh->{info}) {
		&Header("debug") unless $didheader || $main::didheader;
		print "<h3>info:</h3>\n", 
			"<pre>", $dbh->{info}, "</pre><br>\n";
	}
	return $sth;
}

sub DBSQLError {
	my ($sql, $msg, $query_obj) = @_;
	&Header("", "SQL Error") unless $didheader or $main::didheader;
	print "<h3>SQL Error: $msg</h3><pre>\n", 
		$query_obj->err, ": ", $query_obj->errstr, "</pre><br>\n",
		"<h3>SQL:</h3><pre>\n$sql\n</pre><p>\n";
	&Footer;
}

sub Header {
	my ($heading, $title)=@_;
	$title = ($title or $heading or $cgi{name});

	# %bodytags & %font can be defined here, or in main::

	my %bodytags = %main::bodytags;
	my %font = %main::font;

	unless ($didheader || $main::didheader) {
		$didheader++;
		$main::didheader++;
		print (
			"Content-type: text/html\n\n",
			"<html><head><title>$title</title>\n",
			"<body", map (" $_=\"$bodytags{$_}\"", keys %bodytags), ">\n", 
			"<font", map (" $_=\"$font{$_}\"", keys %font), ">\n", 
		);
	}
	print $heading? "<h3>$heading</h3>\n" : '';
}

sub Footer {
	print "\n</body>\n</html>\n";
	exit;
}


################################################
# Row Fetching & Processing (DBGet*) Functions
################################################

sub DBGetRow {
	# takes DBSelectSQL style named parms
	# and returns a hash of the first row
	croak "odd parms passed to DBGetRow" if @_%2;
	croak "no parms passed to DBGetRow" unless @_;
	my %parms=@_;
	my $query=&DBExecSQL(%parms);
	return %{$query->fetchrow_hashref};	
}

sub DBGetRowSet {
	# takes DBSelectSQL style named parms
	# and returns a reference to the (executed) statement handle
	croak "odd parms passed to DBGetRowSet" if @_%2;
	croak "no parms passed to DBGetRowSet" unless @_;
	my %parms=@_;
	return &DBExecSQL(%parms);
}

sub DBGetRowsAll {
	# takes DBSelectSQL style named parms
	# and returns an array of hashes of the returned rows
	croak "odd parms passed to DBGetRowSet" if @_%2;
	croak "no parms passed to DBGetRowSet" unless @_;
	my %parms=@_;
	my $sth = &DBExecSQL(%parms);
	my (%row, @allrows);
	while (%row = &DBGetNext($sth)) {
		push @allrows, {%row};
	}
	return @allrows;
}

sub DBGetNext {
	# takes an already-executed DBI statement handle object
	# does a fetch, and returns a hash of the fetched row
	my $query=shift or croak "no query passed to DBGetNext";
	croak "query not an object" unless ref($query);
	return %{$query->fetchrow_hashref};	
}

sub DBGetRowValues { 
	# takes DBSelectSQL style named parms
	# in list context, returns a list (of just the values) from the first row returned
	# in scalar context, returns just the first value from the first row returned
	croak "odd parms passed to DBGetRowValues" if @_%2;
	croak "no parms passed to DBGetRowValues" unless @_;
	my %parms=@_;
	my $query=&DBExecSQL(%parms);
	return wantarray? @{$query->fetch} : $query->fetch->[0];	
}

sub DBGetColValues { 
	# takes DBSelectSQL style named parms
	# returns a list of just the values from the 1st column of a result set
	croak "odd parms passed to DBGetColValues" if @_%2;
	croak "no parms passed to DBGetColValues" unless @_;
	my %parms=@_;
	my $query=&DBExecSQL(%parms);
	my (@resultrow, @resultcol);
	while (@resultrow=@{$query->fetch}){
		push @resultcol, $resultrow[0];
	}
	return @resultcol;
}

1;