M.Property(true,M.RefineExact,[n],[],(cons false c),[],[],false,(M.Const ""))
in
let property_only n cl =
- let cll = List.map (cons true) cl in
+ let rec build = function
+ | [] -> []
+ | c :: tl ->
+ let r = (cons true) c in
+ if r = [] then build tl else r :: build tl
+ in
+ let cll = build cl in
M.Property(false,M.RefineExact,[n],[],!univ,cll,[],false,(M.Proj(None,(M.AVar "obj"))))
in
let rec aux = function
| Postgres_C c -> MQIPostgres.close c
| No_C -> ()
-let exec handle table cols ct cfl =
+let exec handle out table cols ct cfl =
match pgc handle with
- | MySQL_C c -> MQIMySql.exec c table cols ct cfl
- | Postgres_C c -> MQIPostgres.exec c table cols ct cfl
- | No_C -> [], ""
+ | MySQL_C c -> MQIMySql.exec (c, out) table cols ct cfl
+ | Postgres_C c -> MQIPostgres.exec (c, out) table cols ct cfl
+ | No_C -> []
let connected handle =
pgc handle <> No_C
val init : ?flags:(flag list) -> ?log:(string -> unit) -> unit -> handle
val close : handle -> unit
val connected : handle -> bool
-val exec : handle ->
+val exec : handle -> (MQITypes.query -> unit) ->
MQITypes.table -> MQITypes.columns ->
string MQITypes.con_true -> string MQITypes.con_false ->
- MQITypes.result * MQITypes.query
+ MQITypes.result
val init_if_connected : ?flags:(flag list) -> ?log:(string -> unit) -> unit -> handle
in
"'" ^ quote_aux s ^ "'"
-let exec c q =
+let exec (c, out) q =
let g = function None -> "" | Some v -> v in
let f a = List.map g (Array.to_list a) in
- Mysql.map ~f:f (Mysql.exec c q), q
+ out q; Mysql.map ~f:f (Mysql.exec c q)
let exec c table cols ct cfl =
- let rec iter f sep = function
- | [] -> ""
+ let rec iter f last sep = function
+ | [] -> last
| [head] -> f head
- | head :: tail -> f head ^ sep ^ iter f sep tail
+ | head :: tail -> f head ^ sep ^ iter f last sep tail
in
- let pg_cols = iter (fun x -> x) ", " cols in
- let pg_msval v = iter quote ", " v in
+ let pg_cols = iter (fun x -> x) "" ", " cols in
+ let pg_msval v = iter quote "" ", " v in
let pg_con (pat, col, v) =
if col <> "" then
let f s = col ^ " regexp " ^ quote ("^" ^ s ^ "$") in
- if pat then "(" ^ iter f " or " v ^ ")"
+ if pat then "(" ^ iter f "0" " or " v ^ ")"
else match v with
| [s] -> col ^ " = " ^ (quote s)
| v -> col ^ " in (" ^ pg_msval v ^ ")"
else "1"
in
- let pg_cons l = iter pg_con " and " l in
- let pg_cons_not l =
- match l with [] -> "1" | _ -> "not (" ^ pg_cons l ^ ")" in
- let pg_cons_not_l ll = iter pg_cons_not " and " ll in
+ let pg_cons l = iter pg_con "1" " and " l in
+ let pg_cons_not l = "not (" ^ pg_cons l ^ ")" in
+ let pg_cons_not_l ll = iter pg_cons_not "1" " and " ll in
let pg_where = match ct, cfl with
| [], [] -> ""
| lt, [] -> " where " ^ pg_cons lt
| lt, llf -> " where " ^ pg_cons lt ^ " and " ^ pg_cons_not_l llf
in
if cols = [] then
- let r, q = exec c ("select count(source) from " ^ table ^ pg_where) in
+ let r = exec c ("select count(source) from " ^ table ^ pg_where) in
match r with
- | [[s]] when int_of_string s > 0 -> [[]], q
- | _ -> [], q
+ | [[s]] when int_of_string s > 0 -> [[]]
+ | _ -> []
else
exec c ("select " ^ pg_cols ^ " from " ^ table ^ pg_where ^
" order by " ^ List.hd cols ^ " asc")
val close : Mysql.dbd -> unit
-val exec : Mysql.dbd ->
+val exec : Mysql.dbd * (MQITypes.query -> unit) ->
MQITypes.table -> MQITypes.columns ->
string MQITypes.con_true -> string MQITypes.con_false ->
- MQITypes.result * MQITypes.query
+ MQITypes.result
in
"'" ^ quote_aux s ^ "'"
-let exec c q = (c#exec q)#get_list, q
+let exec (c, out) q = out q; (c#exec q)#get_list
let exec c table cols ct cfl =
- let rec iter f sep = function
- | [] -> ""
+ let rec iter f last sep = function
+ | [] -> last
| [head] -> f head
- | head :: tail -> f head ^ sep ^ iter f sep tail
+ | head :: tail -> f head ^ sep ^ iter f last sep tail
in
- let pg_cols = iter (fun x -> x) ", " cols in
- let pg_msval v = iter quote ", " v in
+ let pg_cols = iter (fun x -> x) "" ", " cols in
+ let pg_msval v = iter quote "" ", " v in
let pg_con (pat, col, v) =
if col <> "" then
let f s = col ^ " ~ " ^ quote ("^" ^ s ^ "$") in
- if pat then "(" ^ iter f " or " v ^ ")"
+ if pat then "(" ^ iter f "false" " or " v ^ ")"
else match v with
| [s] -> col ^ " = " ^ (quote s)
| v -> col ^ " in (" ^ pg_msval v ^ ")"
else "true"
in
- let pg_cons l = iter pg_con " and " l in
- let pg_cons_not l =
- match l with [] -> "true" | _ -> "not (" ^ pg_cons l ^ ")" in
- let pg_cons_not_l ll = iter pg_cons_not " and " ll in
+ let pg_cons l = iter pg_con "true" " and " l in
+ let pg_cons_not l = "not (" ^ pg_cons l ^ ")" in
+ let pg_cons_not_l ll = iter pg_cons_not "true" " and " ll in
let pg_where = match ct, cfl with
| [], [] -> ""
| lt, [] -> " where " ^ pg_cons lt
| lt, llf -> " where " ^ pg_cons lt ^ " and " ^ pg_cons_not_l llf
in
if cols = [] then
- let r, q = exec c ("select count(source) from " ^ table ^ pg_where) in
+ let r = exec c ("select count(source) from " ^ table ^ pg_where) in
match r with
- | [[s]] when int_of_string s > 0 -> [[]], q
- | _ -> [], q
+ | [[s]] when int_of_string s > 0 -> [[]]
+ | _ -> []
else
exec c ("select " ^ pg_cols ^ " from " ^ table ^ pg_where ^
" order by " ^ List.hd cols ^ " asc")
val close : Postgres.connection -> unit
-val exec : Postgres.connection ->
+val exec : Postgres.connection * (MQITypes.query -> unit) ->
MQITypes.table -> MQITypes.columns ->
string MQITypes.con_true -> string MQITypes.con_false ->
- MQITypes.result * MQITypes.query
-
-
+ MQITypes.result
let cons_false = List.map mk_con cfl in
let other_cols = List.map (fun (p, _) -> conv p) el in
let cols = if first = "" then other_cols else first :: other_cols in
- let result, q = C.exec h (C.resolve h table) cols cons_true cons_false in
- if C.set h C.Queries then C.log h (q ^ "\n");
- pg_result false first el result
+ let out q = if C.set h C.Queries then C.log h (q ^ "\n") in
+ let r = C.exec h out (C.resolve h table) cols cons_true cons_false in
+ pg_result false first el r
let deadline = 100