Improved notification API + fixed recent notification GC bug

Author: mmottl

examples/prompt.ml

@@ -49,8 +49,8 @@ let rec dump_res conn =
 
 let rec dump_notification conn =
   match conn#notifies with
-  | Some (msg, pid, extra) ->
-      printf "Notication from backend %i: [%s] [%s]\n" pid msg extra;
+  | Some { Notification.name; pid; extra } ->
+      printf "Notication from backend %i: [%s] [%s]\n" pid name extra;
       flush stdout;
       dump_notification conn
   | None -> ()

lib/postgresql.ml

@@ -325,6 +325,9 @@ let string_of_error = function
 
 exception Error of error
 
+module Notification = struct
+  type t = { name : string; pid : int; extra : string }
+end  (* Notification *)
 
 module Stub = struct
   (* Database Connection Functions *)
@@ -452,7 +455,7 @@ module Stub = struct
 
   (* Asynchronous Notification *)
 
-  external notifies : connection -> (string * int * string) option = "PQnotifies_stub"
+  external notifies : connection -> Notification.t option = "PQnotifies_stub"
 
 
   (* Functions Associated with the COPY Command *)

lib/postgresql.mli

@@ -414,6 +414,15 @@ type conninfo_option =
     cio_dispsize : int;  (** Field size in characters for dialog *)
   }
 
+(** Type of asynchronous notifications *)
+module Notification : sig
+  type t = {
+    name : string;  (** name the of relation containing data *)
+    pid : int;  (** the process id of the backend *)
+    extra : string;  (** payload data (empty if not provided) *)
+  }
+end  (* Notification *)
+
 external conndefaults : unit -> conninfo_option array = "PQconndefaults_stub"
 (** [conndefaults ()] @return array of all records of type [conninfo_option] *)
 
@@ -468,11 +477,8 @@ object
 
   (** Asynchronous Notification *)
 
-  method notifies : (string * int * string) option
-  (** [#notifies] @return [Some (name, pid, extra)] if available ([None]
-      otherwise), where [name] is the name the of relation containing
-      data, [pid] the process id of the backend, and [extra] is any payload
-      data associated with the notification (empty it not provided).
+  method notifies : Notification.t option
+  (** [#notifies] @return [Some notification] if available ([None] otherwise).
 
       @raise Error if there is a connection error.
   *)

lib/postgresql_stubs.c

@@ -1005,20 +1005,24 @@ CAMLprim value PQunescapeBytea_stub(value v_from)
 CAMLprim value PQnotifies_stub(value v_conn)
 {
   CAMLparam1(v_conn);
-  CAMLlocal1(v_str);
-  CAMLlocal1(v_extra);
-  PGnotify *noti = PQnotifies(get_conn(v_conn));
-
-  if (noti) {
-    value v_pair;
-    v_str = make_string(noti->relname);
-    v_pair = caml_alloc_small(3, 0);
-    v_extra = make_string(noti->extra);
-    Field(v_pair, 0) = v_str;
-    Field(v_pair, 1) = Val_int(noti->be_pid);
-    Field(v_pair, 2) = v_extra;
-    PQfreemem(noti);
-    CAMLreturn(make_some(v_pair));
+  CAMLlocal2(v_str, v_extra);
+  PGnotify *notif = PQnotifies(get_conn(v_conn));
+
+  if (notif) {
+    value v_notif;
+    v_str = make_string(notif->relname);
+    v_extra =
+#if PG_OCAML_MAJOR_VERSION >= 9
+      make_string(notif->extra);
+#else
+    v_empty_string;
+#endif
+    v_notif = caml_alloc_small(3, 0);
+    Field(v_notif, 0) = v_str;
+    Field(v_notif, 1) = Val_int(notif->be_pid);
+    Field(v_notif, 2) = v_extra;
+    PQfreemem(notif);
+    CAMLreturn(make_some(v_notif));
   }
   else CAMLreturn(v_None);
 }