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;