An #set_notice_processing as an alternative to #set_notice_processor.

Author: paurkedal

examples/async.ml

@@ -47,6 +47,13 @@ let test (c : connection) =
       (id SERIAL PRIMARY KEY, a INTEGER NOT NULL, b TEXT NOT NULL)";
   assert ((fetch_single_result c)#status = Command_ok);
 
+  (* Create another table which will trigger a notice. *)
+  c#send_query "\
+    CREATE TEMPORARY TABLE postgresql_ocaml_async_2 \
+      (id INTEGER PRIMARY KEY \
+        REFERENCES postgresql_ocaml_async ON DELETE CASCADE)";
+  assert ((fetch_single_result c)#status = Command_ok);
+
   (* Populate using a prepared statement. *)
   c#send_prepare "test_ins"
                  "INSERT INTO postgresql_ocaml_async (a, b) VALUES ($1, $2)";
@@ -93,7 +100,11 @@ let test (c : connection) =
     | Some r ->
       assert (r#status = Tuples_ok)
   done;
-  assert (fetch_result c = None)
+  assert (fetch_result c = None);
+
+  (* Drop the main table. *)
+  c#send_query "DROP TABLE postgresql_ocaml_async CASCADE";
+  assert ((fetch_single_result c)#status = Command_ok)
 
 let main () =
   (* Async connect and test. *)
@@ -109,6 +120,7 @@ let main () =
   finish_conn (Obj.magic c#socket) (fun () -> c#reset_poll) Polling_writing;
   if c#status = Bad then failwith_f "Reset connection bad: %s" c#error_message;
   assert (c#status = Ok);
+  c#set_notice_processing `Quiet;
   test c
 
 let _ =

src/postgresql.ml

@@ -566,6 +566,9 @@ module Stub = struct
   external set_notice_processor :
     connection -> (string -> unit) -> unit = "PQsetNoticeProcessor_stub"
 
+  external set_notice_processor_num :
+    connection -> int -> unit = "PQsetNoticeProcessor_num"
+
 
   (* Large objects *)
 
@@ -882,6 +885,10 @@ object (self)
   method set_notice_processor f =
     wrap_conn (fun conn -> Stub.set_notice_processor conn f)
 
+  method set_notice_processing (h : [`Stderr | `Quiet]) =
+    let i = match h with `Stderr -> 0 | `Quiet -> 1 in
+    wrap_conn (fun conn -> Stub.set_notice_processor_num conn i)
+
 
   (* Accessors *)
 

src/postgresql.mli

@@ -586,6 +586,18 @@ object
   (** [#set_notice_processor] controls reporting of notice and warning
       messages generated by a connection.
 
+      {e Warning:} This function is unsafe in combination with a number of libpq
+      entry points, and should not be used for now. As a workaround,
+      {!#set_notice_processing} can be used to silence notices, if this is more
+      appropriate than the default behaviour of printing them to standard error.
+
+      @raise Error if there is a connection error.
+  *)
+
+  method set_notice_processing : [`Stderr | `Quiet] -> unit
+  (** [#set_notice_processing] controls reporting of notice and warning messages
+      generated by a connection by providing predefined callbacks.
+
       @raise Error if there is a connection error.
   *)
 

src/postgresql_stubs.c

@@ -1420,6 +1420,31 @@ CAMLprim value PQsetNoticeProcessor_stub(value v_conn, value v_cb)
   return Val_unit;
 }
 
+static void np_quiet(void __unused *arg, const char __unused *message)
+{
+}
+
+static void np_stderr(void __unused *arg, const char *message)
+{
+    fprintf(stderr, "%s", message);
+}
+
+CAMLprim value PQsetNoticeProcessor_num(value v_conn, value v_cb_num)
+{
+  np_decr_refcount(get_conn_cb(v_conn));
+  set_conn_cb(v_conn, NULL);
+  switch (Int_val(v_cb_num)) {
+    case 0:
+      PQsetNoticeProcessor(get_conn(v_conn), np_stderr, NULL);
+      break;
+    case 1:
+      PQsetNoticeProcessor(get_conn(v_conn), np_quiet, NULL);
+      break;
+    default:
+      break;
+  }
+  return Val_unit;
+}
 
 /* Large objects */