Re: s48_extract_string?

/*

;;; Magic 2 -- a web application framework
;;; Copyright (C) 2005-2006 Transmogrify, LLC
;;;
;;; Written by Ed Watkeys <[email protected]>
;;; Transmogrify, LLC <http://xmog.com>
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; 2. Redistributions in binary form must reproduce the above copyright
;;; notice, this list of conditions and the following disclaimer in the
;;; documentation and/or other materials provided with the distribution.
;;;
;;; 3. Neither the name of the company nor the names of its contributors
;;; may be used to endorse or promote products derived from this
;;; software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
;;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
;;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
;;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS
;;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
;;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
;;; ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
;;; TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
;;; THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.

*/

#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#include <string.h>

#include "libpq-fe.h"
#include "scheme48.h"

typedef void(*simple_proc)(PGconn*);
typedef char *(*string_returning_proc)(const PGconn*);

static PGconn *get_conn(s48_value conn_s48) {
  PGconn **conn_ptr = (PGconn **)s48_extract_byte_vector(conn_s48);
  return *conn_ptr;
}

static s48_value call_simple_proc(s48_value conn_s48, simple_proc proc) {
  PGconn *conn = get_conn(conn_s48);
  proc(conn);
  return S48_UNSPECIFIC;
}

static s48_value call_string_returning_proc(s48_value conn_s48,
                                            string_returning_proc proc) {
  PGconn *conn = get_conn(conn_s48);
  char *db = proc(conn);
  s48_value db_48 = s48_enter_string(db);
  return db_48;
}

s48_value pq_connect_db(s48_value conninfo_s48) {
  char *conninfo = s48_extract_string(conninfo_s48);
  PGconn *conn = PQconnectdb(conninfo);
  s48_value conn_s48 = s48_enter_byte_vector((char *)&conn, sizeof(conn));
  return conn_s48;
}

s48_value pq_finish(s48_value conn_s48) {
  return call_simple_proc(conn_s48, PQfinish);
}

s48_value pq_reset(s48_value conn_s48) {
  return call_simple_proc(conn_s48, PQreset);
}

s48_value pq_db(s48_value conn_s48) {
  return call_string_returning_proc(conn_s48, PQdb);
}

s48_value pq_user(s48_value conn_s48) {
  return call_string_returning_proc(conn_s48, PQuser);
}

s48_value pq_pass(s48_value conn_s48) {
  return call_string_returning_proc(conn_s48, PQpass);
}

s48_value pq_host(s48_value conn_s48) {
  return call_string_returning_proc(conn_s48, PQhost);
}

s48_value pq_port(s48_value conn_s48) {
  return call_string_returning_proc(conn_s48, PQport);
}

s48_value pq_options(s48_value conn_s48) {
  return call_string_returning_proc(conn_s48, PQoptions);
}

s48_value pq_connection_good_p(s48_value conn_s48) {
  PGconn *conn = get_conn(conn_s48);
  ConnStatusType status = PQstatus(conn);
  return S48_ENTER_BOOLEAN(status == CONNECTION_OK);
}

s48_value pq_connection_status_impl(s48_value conn_s48) {
  PGconn *conn = get_conn(conn_s48);
  ConnStatusType status = PQstatus(conn);
  return status;
}

s48_value pq_connection_status(s48_value conn_s48) {
  ConnStatusType status = pq_connection_status_impl(conn_s48);
  return s48_enter_integer((int)status);
}

s48_value pq_transaction_status_impl(s48_value conn_s48) {
  PGconn *conn = get_conn(conn_s48);
  PGTransactionStatusType status = PQtransactionStatus(conn);
  return status;
}

s48_value pq_transaction_status(s48_value conn_s48) {
  PGTransactionStatusType status = pq_transaction_status_impl(conn_s48);
  return s48_enter_integer((int)status);
}

static void assign_param_values(s48_value param_values_s48,
                                char **param_values, 
                                long param_count) {
  long i;
  for(i = 0; i < param_count; i++) {
    s48_value a = S48_CAR(param_values_s48);
    if (a == S48_NULL) {
      param_values[i] = NULL;
    } else {
      param_values[i] =
	strdup(s48_extract_string(a));
    }
    param_values_s48 = S48_CDR(param_values_s48);
  }
}

static void free_param_values(char **param_values, long param_count) {
  int i;
  for(i = 0; i < param_count; i++) free(param_values[i]);
}

static s48_value handle_command(PGresult *result, s48_value proc_s48) {
  char *command_status = PQcmdStatus(result);
  char *command_tuples = PQcmdTuples(result);
  s48_value command_vector_s48;
  S48_DECLARE_GC_PROTECT(2);
  S48_GC_PROTECT_2(command_vector_s48, proc_s48);
  command_vector_s48 = s48_make_vector(2, S48_FALSE);
  S48_VECTOR_SET(command_vector_s48, 0, s48_enter_string(command_status));
  S48_VECTOR_SET(command_vector_s48, 1, s48_enter_integer(atol(command_tuples)));
  s48_call_scheme(proc_s48, 2, 
                  S48_VECTOR_REF(command_vector_s48, 0),
                  S48_VECTOR_REF(command_vector_s48, 1));
  S48_GC_UNPROTECT();
}

static s48_value handle_tuples(PGresult *result, s48_value proc_s48) {
  int ntuples = PQntuples(result);
  int nfields = PQnfields(result);
  s48_value field_names_s48;
  s48_value field_types_s48;
  int i, j;
  S48_DECLARE_GC_PROTECT(2);
  S48_GC_PROTECT_2(field_names_s48, field_types_s48);
  field_names_s48 = s48_make_vector(nfields, S48_FALSE);
  field_types_s48 = s48_make_vector(nfields, S48_FALSE);
  for(i = 0; i < nfields; i++) {
    S48_VECTOR_SET(field_names_s48,
                   i,
                   s48_enter_string(PQfname(result, i)));
    S48_VECTOR_SET(field_types_s48,
                   i,
                   s48_enter_integer(PQftype(result, i)));
  }
  {
    S48_DECLARE_GC_PROTECT(1);
    S48_GC_PROTECT_1(proc_s48);
    
    for(i = 0; i < ntuples; i++) {
      
      s48_value row_s48 = s48_make_vector(nfields, S48_FALSE);
      S48_DECLARE_GC_PROTECT(1);
      S48_GC_PROTECT_1(row_s48);
      
      for(j = 0; j < nfields; j++) {
        if(PQgetisnull(result, i, j))
          S48_VECTOR_SET(row_s48, j, S48_NULL);
        else
          S48_VECTOR_SET(row_s48,
                         j, 
                         s48_enter_string(PQgetvalue(result, i, j)));
      }
      (void)s48_call_scheme(proc_s48, 3, field_names_s48, field_types_s48, row_s48);
      
      S48_GC_UNPROTECT();
    }
    S48_GC_UNPROTECT();
  }
  S48_GC_UNPROTECT();
  return S48_TRUE;
}

static s48_value list_length (s48_value list_s48) {
  int i = 0;
  while(S48_PAIR_P(list_s48)) {
    list_s48 = S48_CDR(list_s48);
    i++;
  }
  return i;
}

s48_value pq_exec_params(s48_value conn_s48,
                         s48_value command_s48,
                         s48_value proc_s48,
                         s48_value param_values_s48) {
  PGconn *conn = get_conn(conn_s48);
  int param_count =  list_length(param_values_s48);
  char **param_values = malloc(sizeof(char *) * param_count);
  s48_value ret_value = S48_FALSE;
  char *command = s48_extract_string(command_s48);
  PGresult *result;
  s48_value error_vector_s48;

  if(param_values == NULL) goto finished;

  assign_param_values(param_values_s48, param_values, param_count);

  result = PQexecParams(conn, command, param_count, NULL,
                        (const char * const *)param_values, 
                        NULL, NULL, 0);
  ExecStatusType status = PQresultStatus(result);

  switch(status) {
  case PGRES_COMMAND_OK:
    ret_value = handle_command(result, proc_s48);
    break;
  case PGRES_TUPLES_OK:
    ret_value = handle_tuples(result, proc_s48);
    break;
  default:
    error_vector_s48 = s48_make_vector(3, S48_FALSE);
    S48_DECLARE_GC_PROTECT(1);
    S48_GC_PROTECT_1(error_vector_s48);
    S48_VECTOR_SET(error_vector_s48, 0,
                   s48_enter_integer(status));
    S48_VECTOR_SET(error_vector_s48, 1, 
                   s48_enter_string(PQresStatus(status)));
    S48_VECTOR_SET(error_vector_s48, 2,
                   s48_enter_string(PQresultErrorMessage(result)));
    S48_GC_UNPROTECT();
    ret_value = error_vector_s48;
    break;
  }

 finished:
  PQclear(result);
  if(param_values != NULL) {
    free_param_values(param_values, param_count);
    free(param_values);
  }
  return ret_value;
}

void s48_on_load(void) {
  S48_EXPORT_FUNCTION(pq_connect_db);
  S48_EXPORT_FUNCTION(pq_finish);
  S48_EXPORT_FUNCTION(pq_reset);
  S48_EXPORT_FUNCTION(pq_db);
  S48_EXPORT_FUNCTION(pq_user);
  S48_EXPORT_FUNCTION(pq_pass);
  S48_EXPORT_FUNCTION(pq_host);
  S48_EXPORT_FUNCTION(pq_port);
  S48_EXPORT_FUNCTION(pq_options);
  S48_EXPORT_FUNCTION(pq_connection_good_p);
  S48_EXPORT_FUNCTION(pq_connection_status);
  S48_EXPORT_FUNCTION(pq_transaction_status);
  S48_EXPORT_FUNCTION(pq_exec_params);
}

void s48_on_reload(void) {
  s48_on_load();
}