X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fhmysql%2FhSqlite3.ml;h=310893ac5af2d10589d86f291844d359aafbcd82;hb=258d2e384e8bf7008d2fb01c7d3fee5126d65120;hp=0038c650f7406db53fc12e08e9fe0e138a29ac34;hpb=42e4ab5293078dd99a89933971403fa652d26b09;p=helm.git diff --git a/helm/software/components/hmysql/hSqlite3.ml b/helm/software/components/hmysql/hSqlite3.ml index 0038c650f..310893ac5 100644 --- a/helm/software/components/hmysql/hSqlite3.ml +++ b/helm/software/components/hmysql/hSqlite3.ml @@ -29,6 +29,12 @@ type result = Mysql.result option *) + +let debug = false +let debug_print = + if debug then prerr_endline else (fun _ ->()) +;; + type result = Sqlite3.row list type dbd = Sqlite3.db option @@ -43,8 +49,6 @@ type error_code = exception Error of string -let prerr_endline s = () (*HLog.debug s*);; - let profiler = HExtlib.profile "Sqlite3" let quick_connect @@ -60,20 +64,21 @@ let quick_connect let files = HExtlib.find ~test:(Pcre.pmatch ~pat:(base^"[0-9]+")) root in let rec aux = function | [] -> - HLog.debug ("HSqlite3: no valid db files found in memory"); + debug_print ("HSqlite3: no valid db files found in memory"); let name = root ^ base ^ string_of_int (Unix.getpid ()) in - HLog.debug ("HSqlite3: memory db file name: "^name); + debug_print ("HSqlite3: memory db file name: "^name); name, true | x::tl -> - HLog.debug ("HSqlite3: found a .db in memory: " ^ x); + debug_print ("HSqlite3: found a .db in memory: " ^ x); match Array.to_list (Pcre.extract ~pat:"\\.([0-9]+)$" x) with | [] | _::_::_::_ -> assert false | [_;p] when HExtlib.is_dir ("/proc/" ^ p) -> - HLog.debug ("HSqlite3: found valid db file: " ^ x); + debug_print ("HSqlite3: found valid db file: " ^ x); x, false | _ -> HLog.warn ("HSqlite3: dead process db file found: " ^ x); - HLog.warn ("HSqlite3: ignoring: " ^ x); + HLog.warn ("HSqlite3: removing: " ^ x); + ignore (Sys.command ("rm " ^ x)); aux tl in aux files @@ -87,17 +92,18 @@ let quick_connect let cp_to_ram_cmd = "cp " ^ db_name ^ " " ^ tmp_db_name in if first_time then if HExtlib.is_regular db_name then ignore (Sys.command cp_to_ram_cmd) - else HLog.debug ("HSqlite3: no initial db: " ^ db_name) - else HLog.debug "HSqlite3: not copying the db, already in memory"; + else debug_print ("HSqlite3: no initial db: " ^ db_name) + else debug_print "HSqlite3: not copying the db, already in memory"; let mv_to_disk_cmd _ = if first_time then ignore (Sys.command ("mv "^tmp_db_name^" "^db_name)) - else HLog.debug "HSqlite3: not copying back the db" + else debug_print "HSqlite3: not copying back the db" in at_exit mv_to_disk_cmd; tmp_db_name) else db_name in + HExtlib.mkdir (Filename.dirname db_to_open); let db = Sqlite3.db_open db_to_open in (* attach the REGEX function *) Sqlite3.create_fun2 db "REGEXP" @@ -108,11 +114,12 @@ let quick_connect | Sqlite3.Data.TEXT rex, Sqlite3.Data.TEXT s -> let r = Str.regexp rex in if Str.string_match r s 0 then - Sqlite3.Data.INT 1L + Sqlite3.Data.INT Int64.one else - Sqlite3.Data.INT 0L + Sqlite3.Data.INT Int64.zero | _ -> raise (Error "wrong types to 'REGEXP'") - with exn -> HLog.error (Printexc.to_string exn); raise exn); + with Sys.Break -> Sqlite3.Data.INT Int64.zero + | exn -> HLog.error (Printexc.to_string exn); raise exn); Some db ;; @@ -121,15 +128,15 @@ let disconnect db = | None -> () | Some db -> let b = Sqlite3.db_close db in - if b=false then prerr_endline "No Closed DataBase" + if b=false then debug_print "No Closed DataBase" ;; (* XXX hack, sqlite has a print "%q" that should be used, but is not bound *) let escape s = let s_escaped = Pcre.replace ~pat:"'" ~templ:"''" s in (*let s_escaped = Pcre.replace ~pat:"([^'])'([^'])" ~templ:"$1''$2" s in*) - prerr_endline s; - prerr_endline s_escaped; + debug_print s; + debug_print s_escaped; s_escaped ;; @@ -167,10 +174,10 @@ let string_of_rc = function "Sqlite3.Rc.UNKNOWN " ^ string_of_int (Sqlite3.Rc.int_of_unknown n) ;; -let pp_rc rc = prerr_endline (string_of_rc rc);; +let pp_rc rc = debug_print (string_of_rc rc);; let exec s db = - prerr_endline s; + debug_print s; let stored_result = ref [] in let store row = stored_result := row :: !stored_result