Markus Mottl avatar Markus Mottl committed b956987

Added describe_prepared, nparams, and paramtype methods

Comments (0)

Files changed (9)

+2008-09-29:  Added support for connection methods:
+
+               * describe_prepared
+
+             Added support for result methods:
+
+               * nparams
+               * paramtype
+
+             Thanks to Paolo Donadeo <p.donadeo@ex-nunc.org> for the
+             above contributions!
+
+             Updated OCamlMakefile.
+
 2008-03-19:  Allow several commands in one query again (was broken after
              support for query parameters had been added).  Updated the
              INSTALL file with a hint on how to solve a potential linking
 export CFLAGS += -I$(shell pg_config --includedir)
 export LDFLAGS += -L$(shell pg_config --libdir)
 export OCAMLMKLIB_FLAGS = -L$(shell pg_config --libdir)
+
+export PG_OCAML_MAJOR_VERSION = \
+  $(shell pg_config --version | sed -e  "s/^.* \([0-9]\+\).*/\1/g")
+
+export PG_OCAML_MINOR_VERSION = \
+  $(shell pg_config --version | sed -e "s/^.* [^.]*\.\([0-9]\+\).*/\1/g")
   OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL)
 endif
 
+ifdef LIB_PACK_NAME
+  FOR_PACK_NAME := $(shell echo $(LIB_PACK_NAME) | sed -e 's/^\(.\)/\U\1/')
+endif
+
 # If we have to make byte-code
 ifndef REAL_OCAMLC
   BYTE_OCAML := y
   # the path since I don't know the paths built into the compiler, so
   # just include the ones with slashes in their names.
   EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
-  SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS)
+
+
+  ifndef LIB_PACK_NAME
+    SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS)
+  else	
+    SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLBCFLAGS)
+  endif
 
   REAL_OCAMLC := $(INTF_OCAMLC)
 
     PLDFLAGS := -p
   endif
 
+  ifndef LIB_PACK_NAME
+    SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS)
+  else	
+    SPECIAL_OCAMLFLAGS := -for-pack $(FOR_PACK_NAME) $(OCAMLNCFLAGS)
+  endif
   REAL_IMPL := $(IMPL_CMX)
   REAL_IMPL_INTF := $(IMPLX_INTF)
   IMPL_SUF := .cmx
 				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
 dcnl:	debug-code-nolink
 
+# generates byte-code with debugging information (native code)
+debug-native-code:	$(PRE_TARGETS)
+			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+				REAL_RESULT="$(NCRESULT)" make_deps=yes \
+				REAL_OCAMLC="$(OCAMLOPT)" \
+				OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dnc:	debug-native-code
+
+debug-native-code-nolink:	$(PRE_TARGETS)
+			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+				REAL_RESULT="$(NCRESULT)" make_deps=yes \
+				REAL_OCAMLC="$(OCAMLOPT)" \
+				OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dncnl:	debug-native-code-nolink
+
 # generates byte-code libraries with debugging information
 debug-code-library:	$(PRE_TARGETS)
 			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
 				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
 dcl:	debug-code-library
 
+# generates byte-code libraries with debugging information (native code)
+debug-native-code-library:	$(PRE_TARGETS)
+			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+				$(RES_CLIB) $(NCRESULT).cma \
+				REAL_RESULT="$(NCRESULT)" make_deps=yes \
+				REAL_OCAMLC="$(OCAMLOPT)" \
+				CREATE_LIB=yes \
+				OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+				OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dncl:	debug-native-code-library
+
 # generates byte-code for profiling
 profiling-byte-code:		$(PRE_TARGETS)
 			$(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
 $(RESULT).cmxa $(RESULT).$(EXT_LIB):	$(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS)
 			$(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(REAL_IMPL)
 else
+# Packing a bytecode library
 ifdef BYTE_OCAML
 $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF)
 			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(OCAMLLDFLAGS) $(REAL_IMPL)
+# Packing into a unit which can be transformed into a library
+# Remember the .ml's must have been compiled with -for-pack $(LIB_PACK_NAME)
 else
 $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF)
-			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx  $(OCAMLLDFLAGS) $(REAL_IMPL)
+			$(REAL_OCAMLFIND) $(OCAMLOPT) -pack -o $(LIB_PACK_NAME).cmx  $(OCAMLLDFLAGS) $(REAL_IMPL)
 endif
 
 $(RESULT).cma:		$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
 			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmo
 
 $(RESULT).cmxa $(RESULT).$(EXT_LIB):	$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS)
-			$(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmx
+			$(REAL_OCAMLFIND) $(OCAMLOPT) -a $(filter-out -custom, $(ALL_LDFLAGS)) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmx
 endif
 
 $(RES_CLIB): 		$(OBJ_LINK)
 				-c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \
 			fi
 
-ifdef PACK_LIB
-$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
-			$(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \
-				$(OBJS_LIBS) -o $@ $(REAL_IMPL)
-endif
-
 .PRECIOUS:		%.ml
 %.ml:			%.mll
 			$(OCAMLLEX) $(LFLAGS) $<
 	$(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META $(LIBINSTALL_FILES)
 	$(QUIET)printf "\nInstallation successful.\n"
 
+.PHONY: libinstall-byte-code
+libinstall-byte-code:	all
+	$(QUIET)printf "\nInstalling byte-code library with ocamlfind\n"
+	$(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META \
+	  $(filter-out $(RESULT).$(EXT_LIB) $(RESULT).cmxa, $(LIBINSTALL_FILES))
+	$(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: libinstall-native-code
+libinstall-native-code:	all
+	$(QUIET)printf "\nInstalling native-code library with ocamlfind\n"
+	$(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META \
+	  $(filter-out $(DLLSONAME) $(RESULT).cma, $(LIBINSTALL_FILES))
+	$(QUIET)printf "\nInstallation successful.\n"
+
 .PHONY: libuninstall
 libuninstall:
 	$(QUIET)printf "\nUninstalling library with ocamlfind\n"
-release-1-8-2
+release-1-9-0
 name="postgresql"
-version="1.8.2"
+version="1.9.0"
 description="PostgreSQL bindings for OCaml"
 requires="unix"
 archive(byte)="postgresql.cma"
 
 SOURCES = postgresql.mli postgresql.ml postgresql_stubs.c
 CFLAGS += -O2 -Wall -pedantic -Wno-long-long -fPIC -DPIC
+CFLAGS += -DPG_OCAML_MAJOR_VERSION=$(PG_OCAML_MAJOR_VERSION)
+CFLAGS += -DPG_OCAML_MINOR_VERSION=$(PG_OCAML_MINOR_VERSION)
 CLIBS   = pq
 RESULT  = postgresql
 

lib/postgresql.ml

   external exec_params :
     connection -> string -> string array -> result = "PQexecParams_stub"
 
+  external describe_prepared :
+    connection -> string -> result = "PQdescribePrepared_stub"
+
   external result_status :
     result -> result_status = "PQresultStatus_stub" "noalloc"
 
     connection -> result_status -> result = "PQmakeEmptyPGresult_stub"
 
   external ntuples : result -> int = "PQntuples_stub" "noalloc"
+
+(* FIXME: switch to noalloc once PostgreSQL 8.2 is out for CentOS *)
+(*   external nparams : result -> int = "PQnparams_stub" "noalloc" *)
+  external nparams : result -> int = "PQnparams_stub"
+
   external nfields : result -> int = "PQnfields_stub" "noalloc"
   external fname : result -> int -> string = "PQfname_stub"
   external fnumber : result -> string -> int ="PQfnumber_stub" "noalloc"
   external fformat : result -> int -> FFormat.t = "PQfformat_stub" "noalloc"
   external ftype : result -> int -> oid = "PQftype_stub" "noalloc"
+
+(* FIXME: switch to noalloc once PostgreSQL 8.2 is out for CentOS *)
+(*   external paramtype : result -> int -> oid = "PQparamtype_stub" "noalloc" *)
+  external paramtype : result -> int -> oid = "PQparamtype_stub"
+
   external fmod : result -> int -> int = "PQfmod_stub" "noalloc"
   external fsize : result -> int -> int = "PQfsize_stub" "noalloc"
   external binary_tuples : result -> bool = "PQbinaryTuples_stub" "noalloc"
 class result res =
   let nfields = Stub.nfields res in
   let ntuples = Stub.ntuples res in
+  let nparams = Stub.nparams res in
   let binary_tuples = Stub.binary_tuples res in
   let check_field field =
     if field < 0 || field >= nfields then
       raise (Error (Field_out_of_range (field, nfields))) in
+  let check_param param =
+    if param < 0 || param >= nparams then
+      raise (Error (Field_out_of_range (param, nparams))) in
   let check_tuple tuple =
     if tuple < 0 || tuple >= ntuples then
       raise (Error (Tuple_out_of_range (tuple, ntuples))) in
   method status = Stub.result_status res
   method error = Stub.result_error res
   method ntuples = ntuples
+  method nparams = nparams
   method nfields = nfields
   method binary_tuples = binary_tuples
   method fname field = check_field field; Stub.fname res field
     check_field field;
     ftype_of_oid (Stub.ftype res field)
 
+  method paramtype field =
+    check_param field;
+    ftype_of_oid (Stub.paramtype res field)
+
   method fmod field = check_field field; Stub.fmod res field
   method fsize field = check_field field; Stub.fsize res field
 
     let res = new result r in
     let stat = res#status in
     if not (expect = []) && not (List.mem stat expect) then
-      raise (Error (Unexpected_status (stat, res#error, expect)));
-    res
+      raise (Error (Unexpected_status (stat, res#error, expect)))
+    else res
+
+  method describe_prepared query =
+    check_null ();
+    let r = Stub.describe_prepared conn query in
+    if Stub.result_isnull r then signal_error ()
+    else new result r
 
   method send_query ?(params = [||]) query =
     check_null ();

lib/postgresql.mli

   method ntuples : int
   (** [#ntuples] @return the number of tuples of a query result. *)
 
+  method nparams : int
+  (** [#nparams] @return the number of parameters of a prepared
+      statement.  This function is only useful when inspecting the result
+      of [#describe_prepared].  For other types of queries it will return
+      zero. *)
+
   method nfields : int
   (** [#nfields] @return the number of fields in a query result. *)
 
       @raise Error if field out of range.
   *)
 
+  method paramtype : int -> ftype
+  (** [#paramtype n] @return the datatype of the indicated statement
+      parameter.  Parameter numbers start at 0.  This function is
+      only useful when inspecting the result of [#describe_prepared].
+      For other types of queries it will return zero.
+
+      @raise Oid if there was no corresponding ftype for the internal [oid].
+      @raise Error if field out of range.
+  *)
+
   method fmod : int -> int
   (** [#fmod n] @return type-specific modification data of the [n]th field.
 
       @raise Error if there is an unexpected result status.
   *)
 
+  method describe_prepared : string -> result
+  (** [#describe_prepared stm_name] submits a request to obtain
+      information about the specified prepared statement, and waits for
+      completion.  {!describe_prepared} allows an application to obtain
+      information about a previously prepared statement.  The [stm_name]
+      parameter can be the empty string ("") to reference the unnamed
+      statement, otherwise it must be the name of an existing prepared
+      statement.  On success, a {!result} with status [Command_ok] is
+      returned.  The methods {!result.nparams} and {!result.paramtype}
+      of the class [result] can be used to obtain information about
+      the parameters of the prepared statement, and the methods
+      {!result.nfields}, {!result.fname} and {!result.ftype} provide
+      information about the result columns (if any) of the statement.
+
+      To prepare a statement use the SQL command PREPARE.
+
+      @param stm_name The name of the previously prepared query
+
+      @raise Error if there is a connection error.
+
+      @see <http://www.postgresql.org/docs/8.3/interactive/sql-prepare.html>
+      PostgreSQL documentation about [PREPARE]
+  *)
+
   method send_query : ?params : string array -> string -> unit
   (** [send_query ?params query] asynchronous execution of query or
       command [query].

lib/postgresql_stubs.c

 # define inline
 #endif
 
+#if PG_OCAML_MAJOR_VERSION > 8 \
+    || ( PG_OCAML_MAJOR_VERSION >= 8 && PG_OCAML_MINOR_VERSION >= 2)
+# define PG_OCAML_8_2
+#endif
+
 #include <string.h>
 
 #include <caml/mlvalues.h>
   CAMLreturn(alloc_result(res, np_cb));
 }
 
+CAMLprim value PQdescribePrepared_stub(value v_conn, value v_query)
+{
+#ifdef PG_OCAML_8_2
+  CAMLparam1(v_conn);
+  PGconn *conn = get_conn(v_conn);
+  np_callback *np_cb = get_conn_cb(v_conn);
+  PGresult *res;
+  int len = caml_string_length(v_query) + 1;
+  char *query = caml_stat_alloc(len);
+  memcpy(query, String_val(v_query), len);
+  caml_enter_blocking_section();
+    res = PQdescribePrepared(conn, query);
+    free(query);
+  caml_leave_blocking_section();
+  CAMLreturn(alloc_result(res, np_cb));
+#else
+  caml_failwith("Postgresql.describe_prepared: not supported");
+#endif
+}
+
 noalloc_res_info(PQresultStatus, Val_int)
 
 CAMLprim value PQresStatus_stub(value v_status)
 noalloc_res_info(PQbinaryTuples, Val_bool)
 fieldnum_info(PQfname, make_string)
 
+#ifdef PG_OCAML_8_2
+noalloc_res_info(PQnparams, Val_int)
+#else
+  CAMLprim value PQnparams_stub(value v_res)
+  {
+    caml_failwith("Postgresql.nparams: not supported");
+  }
+#endif
+
 CAMLprim value PQfnumber_stub(value v_res, value v_field_name)
 {
   return Val_int(PQfnumber(get_res(v_res), String_val(v_field_name)));
 noalloc_fieldnum_info(PQfsize, Val_int)
 noalloc_fieldnum_info(PQfmod, Val_int)
 
+#ifdef PG_OCAML_8_2
+noalloc_fieldnum_info(PQparamtype, Val_int)
+#else
+  CAMLprim value PQparamtype_stub(value v_res, value v_field_num)
+  {
+    caml_failwith("Postgresql.paramtype: not supported");
+  }
+#endif
+
+
 CAMLprim value PQgetvalue_stub(value v_res, value v_tup_num, value v_field_num)
 {
   CAMLparam1(v_res);
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.