/* Postgres: OCaml bindings for PostgreSQL
   Copyright (C) 2001  Alain Frisch         <Alain.Frisch@ens.fr>

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License; see the file LGPL.
*/

#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>
#include <caml/callback.h>
#include <libpq-fe.h>
#include "libpq/libpq-fs.h"


value empty_string = 0;

value init_PQstub()
{
  register_global_root(&empty_string);
  empty_string = alloc_string(0);
  return Val_unit;
}

/* Management of notice_processor callbacks */

/* One must me careful with notice processors: the callback 
   can be called after the death of the connection, if
   a living PGresult was made from the connection. */

typedef struct {
  int counter;  /* reference counter; number of connection (atmost 1) and
		   results attached to the callback */
  value callback; /* the callback itself, registered as a global root */
} np_callback;

np_callback * np_new(value handler)
{
  np_callback * c;
  c = (np_callback *) stat_alloc(sizeof(np_callback));
  c->callback = handler;
  c->counter = 1;
  register_global_root(& (c->callback));
  return c;
}

void np_incr_refcount(np_callback * c)
{
  if (c)
    (c->counter)++;
}

void np_decr_refcount(np_callback * c)
{
  if (c)
    {
      (c->counter)--;
      if ((c->counter)==0)
	{
	  remove_global_root(& (c->callback));
	  stat_free(c); 
	}
    }
}


/* Database Connection Functions */

/* Missing: 
     PQsetdbLogin, PQsetdb: superseded by stub_PQconnectdb
     PQconnectStart, PQconnectPoll, PQresetStart PQresetPoll: 
          for non-blocking connection
     PQconndefaults: the default connection options
     PQgetssl,PQgetssl: the SSL structure used in the connection
*/
     
#define connection(v) *((PGconn**) Data_custom_val(v))
#define conn_callback(v) ((np_callback*) Field(v,2))

void free_conn(value vconn)
{
  np_decr_refcount(conn_callback(vconn));
  Field(vconn,2) = 0;

  if (connection(vconn)) 
    PQfinish(connection(vconn)); 
  connection(vconn) = NULL;
}

value conn_isnull(value vconn)
{
  return Val_int((connection(vconn))?0:1);
}

value alloc_conn(PGconn* conn)
{
  value vconn = alloc_final(3, free_conn, 1, 30);
  /* one may raise this 30 to 500 for instance,
     if the program takes the responsability to close the connections */
  connection(vconn) = conn;
  Field(vconn,2) = 0;
  return vconn;
}

value stub_PQconnectdb(value conninfo)
{
  return alloc_conn (PQconnectdb(String_val(conninfo)));
}

value stub_PQfinish(value vconn)
{
  free_conn(vconn);
  return Val_unit;
}

value stub_PQreset(value vconn)
{
  PQreset(connection(vconn));
  return Val_unit;
}

value make_string(const char *s)
{
  if (s)
    return (copy_string(s));
  else
    return (empty_string);
}

#define conn_info(fun,ret) \
value stub_##fun(value vconn) { return ret ( fun( connection (vconn) ) ); }


conn_info(PQdb, make_string)
conn_info(PQuser, make_string)
conn_info(PQpass, make_string)
conn_info(PQhost, make_string)
conn_info(PQport, make_string)
conn_info(PQtty, make_string)
conn_info(PQoptions, make_string)
conn_info(PQstatus, Val_int)
conn_info(PQerrorMessage, make_string)
conn_info(PQbackendPID, Val_int)


/* Query Execution Functions */

/* Missing:
       PQoidStatus (deprecated)
       PQprint (no longer actively supported)
*/

#define result(v) *((PGresult**) Data_custom_val(v))
#define res_callback(v) ((np_callback*) Field(v,2))

#define res_info(fun,ret) \
value stub_##fun(value vres) { return ret ( fun( result (vres) ) ); }

#define fieldnum_info(fun,ret)					\
value stub_##fun(value vres, value field_num) 			\
{ 								\
  return ret ( fun( result (vres), Int_val(field_num) ) ); 	\
}

#define field_info(fun,ret)						   \
value stub_##fun(value vres, value tup_num, value field_num)		   \
{                                                               	   \
  return ret ( 								   \
	      fun( result (vres), Int_val(tup_num) , Int_val(field_num)) \
	      ); 							   \
}

void free_result(value vres)
{
  np_decr_refcount(res_callback(vres));
  Field(vres,2) = 0;

  if (result(vres)) 
    PQclear(result(vres));
  result(vres) = NULL;
}

value res_isnull(value vres)
{
  return Val_int((result(vres))?0:1);
}

value alloc_result(PGresult* res, np_callback * c)
{
  value vres = alloc_final(3, free_result, 1, 500);
  result(vres) = res;
  Field(vres,2) = c;
  np_incr_refcount(c);
  return vres;
}
     
value stub_PQexec(value vconn, value query)
{
  return alloc_result( PQexec(connection(vconn), String_val(query)) ,
		       conn_callback(vconn));
}

res_info(PQresultStatus, Val_int)

value stub_PQresStatus(value status)
{
  return make_string (PQresStatus (Int_val (status)));
}

res_info(PQresultErrorMessage, make_string)
res_info(PQntuples, Val_int)
res_info(PQnfields, Val_int)
res_info(PQbinaryTuples, Val_int)
fieldnum_info(PQfname, make_string)

value stub_PQfnumber(value res, value field_name)
{
  return Val_int( PQfnumber (result (res), String_val(field_name) ) );
}

fieldnum_info(PQftype, Val_int)
fieldnum_info(PQfsize, Val_int)
fieldnum_info(PQfmod, Val_int)

     /* Not for binary result ! */
field_info(PQgetvalue, make_string)
field_info(PQgetlength, Val_int)
field_info(PQgetisnull, Val_int)

res_info(PQcmdStatus, make_string)
res_info(PQcmdTuples, make_string)
res_info(PQoidValue, Val_int)

/* 
value stub_PGclear(value vres)
{
  free_result(vres);
  return Val_unit;
  } 
*/

value stub_PQmakeEmptyPGresult(value vconn, value status)
{
  return alloc_result(PQmakeEmptyPGresult(connection(vconn), Int_val(status)),
		      conn_callback(vconn));
}


/* Asynchronous Query Processing */

value stub_PQsetnonblocking(value vconn, value arg)
{
  return Val_int( PQsetnonblocking( connection(vconn), Int_val(arg) ) );
}

value stub_PQisnonblocking(value vconn)
{
  return Val_int (PQisnonblocking( connection(vconn) ));
}

value stub_PQsendQuery(value vconn, value query)
{
  return Val_int (PQsendQuery( connection(vconn) , String_val(query)));
}

value stub_PQgetResult(value vconn)
{
  return alloc_result( PQgetResult(connection(vconn) ),
		       conn_callback(vconn));
}

value stub_PQconsumeInput(value vconn)
{
  return Val_int (PQconsumeInput( connection(vconn) ));
}

value stub_PQisBusy(value vconn)
{
  return Val_int (PQisBusy( connection(vconn) ));
}

value stub_PQflush(value vconn)
{
  return Val_int ((PQflush( connection(vconn) )));
}

value stub_PQsocket(value vconn)
{
  return Val_int (PQsocket( connection(vconn) ));
}

value stub_PQrequestCancel(value vconn)
{
  return Val_int (PQsocket( connection(vconn) ));
}


/* Asynchronous Notification */

value stub_PQnotifies(value vconn)
{
  CAMLparam1(vconn);
  CAMLlocal2(couple,ret);

  PGnotify * noti = PQnotifies(connection(vconn));
  if (noti)
    {
      couple = alloc_tuple (2);
      Field(couple, 0) = make_string (noti -> relname);
      Field(couple, 1) = Val_int (noti -> be_pid);
      ret = alloc_small(1,0);  // Some
      Field(ret, 0) = couple;
      CAMLreturn(ret);
    }
  else
    CAMLreturn(Val_int(0)); // None
}


/* Functions Associated with the COPY Command */

value stub_PQgetline(value vconn, value buf, value pos, value len)
{
  return Val_int ( PQgetline( connection(vconn), 
			      String_val (buf) + Int_val(pos), 
			      Int_val(len) ) );
}

value stub_PQgetlineAsync(value vconn, value buf, value pos, value len)
{
  return Val_int ( PQgetline( connection(vconn), 
			      String_val (buf) + Int_val(pos), 
			      Int_val(len) ) );
}

value stub_PQputline(value vconn, value string)
{
  return Val_int ( PQputline( connection(vconn), 
			      String_val (string) ));
}

value stub_PQputnbytes(value vconn, value buf, value pos, value len)
{
  return Val_int ( PQputnbytes( connection(vconn), 
			      String_val (buf) + Int_val(pos), 
			      Int_val(len) ) );
}

value stub_PQendcopy(value vconn)
{
  return Val_int (PQendcopy( connection(vconn) ));
}

/* libpq Control Functions */

void notice_ml(void *arg, const char *message)
{
  np_callback * c = arg;
  callback(c->callback, make_string(message));
  return;
}

value stub_PQsetNoticeProcessor(value vconn, value callback)
{
  np_decr_refcount(conn_callback(vconn));
  Field(vconn,2) = np_new(callback);

  PQsetNoticeProcessor(connection(vconn),&notice_ml,
		       conn_callback(vconn));
  return Val_unit;
}

/* Large objects */

value stub_lo_open(value vconn, value oid)
{
  return Val_int(lo_open(connection(vconn), Int_val(oid), INV_READ | INV_WRITE));
}

value stub_lo_close(value vconn, value fd)
{
  return Val_int (lo_close(connection(vconn), Int_val(fd)));
}

value stub_lo_read(value vconn, value fd, value buf, value pos, value len)
{
  return Val_int(lo_read(connection(vconn), Int_val(fd), 
                     String_val (buf) + Int_val (pos), Int_val(len)));
}

value stub_lo_write(value vconn, value fd, value buf, value pos, value len)
{
  return Val_int(lo_write(connection(vconn), Int_val(fd), 
                     String_val (buf) + Int_val (pos), Int_val(len)));
}

value stub_lo_lseek(value vconn, value fd, value pos)
{
  return Val_int(lo_lseek(connection(vconn), Int_val(fd), Int_val(pos), 0));
}

value stub_lo_creat(value vconn)
{
  return Val_int(lo_creat(connection(vconn), INV_READ | INV_WRITE));
}

value stub_lo_tell(value vconn, value fd)
{
  return Val_int(lo_tell(connection(vconn), Int_val(fd)));
}

value stub_lo_unlink(value vconn, value oid)
{
  return Val_int(lo_unlink(connection(vconn), Int_val(oid)));
}

value stub_lo_import(value vconn, value fname)
{
  return Val_int(lo_import(connection(vconn), String_val(fname)));
}

value stub_lo_export(value vconn, value oid, value fname)
{
  return Val_int(lo_export(connection(vconn), Int_val(oid), String_val(fname)));
}


/* Escaping */

value stub_PQescapeString(value to, value posto, value from, value posfrom, value len)
{
  return 
    Val_int (
	     PQescapeString(
			    String_val(to) + Int_val(posto), 
			    String_val(from) + Int_val(posfrom), 
			    Int_val(len)));
}