X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fhmysql%2FhSqlite3.ml;h=d5c5f0fcce34512e29b70f8211346698ba4be16a;hb=b73c1560045798ff1e77491050409a783d915345;hp=20e49451119fee9a5fca94f0db39a8f938124c47;hpb=0f3aa13cca7b39bf21b82738e1c183bc6c9e6ae3;p=helm.git diff --git a/helm/software/components/hmysql/hSqlite3.ml b/helm/software/components/hmysql/hSqlite3.ml index 20e494511..d5c5f0fcc 100644 --- a/helm/software/components/hmysql/hSqlite3.ml +++ b/helm/software/components/hmysql/hSqlite3.ml @@ -43,41 +43,41 @@ type error_code = exception Error of string -let prerr_endline s = ()(*HLog.debug s;;*) +let prerr_endline s = () (*HLog.debug s*);; let profiler = HExtlib.profile "Sqlite3" -let quick_connect ?host ?(database = "sqlite") ?port ?password ?user () = +let quick_connect + is_library + ?(host = Helm_registry.get "matita.basedir") + ?(database = "sqlite") ?port ?password ?user () += let username = Helm_registry.get "user.name" in - let tmp_db_name = - if HExtlib.is_dir "/dev/shm/" && HExtlib.writable_dir "/dev/shm/" then - ((*HLog.debug "using /dev/shm to store the working copy of the db";*) - "/dev/shm/matita.db." ^ username ^ "." ^ string_of_int (Unix.getpid ())) - else - ((*HLog.debug "/dev/shm not available";*) - Helm_registry.get "matita.basedir" ^ "/matita.db." ^ username ^ "." ^ - string_of_int (Unix.getpid ())) - in - let db_name = Helm_registry.get "matita.basedir" ^ "/" ^ database ^ ".db" in - let standard_db_name = - Helm_registry.get "matita.rt_base_dir" ^ "/metadata.db" + let host_mangled = Pcre.replace ~pat:"[/ .]" ~templ:"_" host in + let tmp_db_name = + "/dev/shm/matita.db." ^ username ^ "." ^ host_mangled ^ "." ^ + string_of_int (Unix.getpid ()) in - let cp_to_ram_cmd = - if HExtlib.is_regular db_name then - "cp " ^ db_name ^ " " ^ tmp_db_name + let db_name = host ^ "/" ^ database in + let db_to_open = + if HExtlib.is_dir "/dev/shm/" && HExtlib.writable_dir "/dev/shm/" + && (not is_library) + then + (let cp_to_ram_cmd = "cp " ^ db_name ^ " " ^ tmp_db_name in + ignore (Sys.command cp_to_ram_cmd); + let mv_to_disk_cmd _ = + ignore (Sys.command ("mv " ^ tmp_db_name ^ " " ^ db_name)) + in + at_exit mv_to_disk_cmd; + tmp_db_name) else - (* we start from the standard library *) - "cp " ^ standard_db_name ^ " " ^ tmp_db_name + db_name in - ignore (Sys.command cp_to_ram_cmd); - let mv_to_disk_cmd _ = - ignore (Sys.command ("mv " ^ tmp_db_name ^ " " ^ db_name)) - in - at_exit mv_to_disk_cmd; - let db = Sqlite3.db_open tmp_db_name in + let db = Sqlite3.db_open db_to_open in (* attach the REGEX function *) - Sqlite3.create_fun_2 db "REGEXP" + Sqlite3.create_fun2 db "REGEXP" (fun s rex -> + try match rex, s with | Sqlite3.Data.TEXT rex, Sqlite3.Data.BLOB s | Sqlite3.Data.TEXT rex, Sqlite3.Data.TEXT s -> @@ -86,7 +86,8 @@ let quick_connect ?host ?(database = "sqlite") ?port ?password ?user () = Sqlite3.Data.INT 1L else Sqlite3.Data.INT 0L - | _ -> raise (Error "wrong types to 'REGEXP'")); + | _ -> raise (Error "wrong types to 'REGEXP'") + with exn -> HLog.error (Printexc.to_string exn); raise exn); Some db ;; @@ -99,7 +100,13 @@ let disconnect db = ;; (* XXX hack, sqlite has a print "%q" that should be used, but is not bound *) -let escape s = Pcre.replace ~pat:"([^'])'([^'])" ~templ:"$1''$2" s +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; + s_escaped +;; let string_of_rc = function |Sqlite3.Rc.OK -> "Sqlite3.Rc.OK" @@ -137,7 +144,7 @@ let string_of_rc = function let pp_rc rc = prerr_endline (string_of_rc rc);; -let exec db s = +let exec s db = prerr_endline s; let stored_result = ref [] in let store row = @@ -151,7 +158,7 @@ let exec db s = in match rc with | Sqlite3.Rc.OK -> !stored_result - | _ -> raise (Error (string_of_rc rc)) + | _ -> raise (Error (string_of_rc rc ^ ": " ^ Sqlite3.errmsg db )) ;; let rec map res ~f =