From: Claudio Sacerdoti Coen Date: Wed, 23 May 2007 15:58:53 +0000 (+0000) Subject: HSql.Error ==> HSql.Error of string X-Git-Tag: make_still_working~6310 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=31d99ae9216eeadfefd74202452748251d4ec275;p=helm.git HSql.Error ==> HSql.Error of string --- diff --git a/helm/software/components/hmysql/hMysql.ml b/helm/software/components/hmysql/hMysql.ml index 041f43922..76702b524 100644 --- a/helm/software/components/hmysql/hMysql.ml +++ b/helm/software/components/hmysql/hMysql.ml @@ -35,7 +35,7 @@ type error_code = | No_such_index | Bad_table_error | GENERIC_ERROR of string -exception Error +exception Error of string let profiler = HExtlib.profile "mysql" @@ -65,7 +65,7 @@ let exec dbd s = | Some dbd -> try Some (profiler.HExtlib.profile (Mysql.exec dbd) s) - with Mysql.Error _ -> raise Error + with Mysql.Error s -> raise (Error s) let map res ~f = match res with diff --git a/helm/software/components/hmysql/hSql.mli b/helm/software/components/hmysql/hSql.mli index 23761a2b6..53600b5bf 100644 --- a/helm/software/components/hmysql/hSql.mli +++ b/helm/software/components/hmysql/hSql.mli @@ -43,7 +43,7 @@ type error_code = | No_such_index | Bad_table_error | GENERIC_ERROR of string -exception Error +exception Error of string (* the exceptions raised are from the Mysql module *) diff --git a/helm/software/components/hmysql/hSqlite3.ml b/helm/software/components/hmysql/hSqlite3.ml index 031c09c9a..80c939ac8 100644 --- a/helm/software/components/hmysql/hSqlite3.ml +++ b/helm/software/components/hmysql/hSqlite3.ml @@ -41,7 +41,7 @@ type error_code = | Bad_table_error | GENERIC_ERROR of string -exception Error +exception Error of string let prerr_endline s = ()(*HLog.debug s;;*) @@ -87,6 +87,42 @@ 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 string_of_rc = function + |Sqlite3.Rc.OK -> "Sqlite3.Rc.OK" + |Sqlite3.Rc.ERROR -> "Sqlite3.Rc.ERROR" + |Sqlite3.Rc.INTERNAL -> "Sqlite3.Rc.INTERNAL" + |Sqlite3.Rc.PERM -> "Sqlite3.Rc.PERM" + |Sqlite3.Rc.ABORT -> "Sqlite3.Rc.ABORT" + |Sqlite3.Rc.BUSY -> "Sqlite3.Rc.BUSY" + |Sqlite3.Rc.LOCKED -> "Sqlite3.Rc.LOCKED" + |Sqlite3.Rc.NOMEM -> "Sqlite3.Rc.NOMEM" + |Sqlite3.Rc.READONLY -> "Sqlite3.Rc.READONLY" + |Sqlite3.Rc.INTERRUPT -> "Sqlite3.Rc.INTERRUPT" + |Sqlite3.Rc.IOERR -> "Sqlite3.Rc.IOERR" + |Sqlite3.Rc.CORRUPT -> "Sqlite3.Rc.CORRUPT" + |Sqlite3.Rc.NOTFOUND -> "Sqlite3.Rc.NOTFOUND" + |Sqlite3.Rc.FULL -> "Sqlite3.Rc.FULL" + |Sqlite3.Rc.CANTOPEN -> "Sqlite3.Rc.CANTOPEN" + |Sqlite3.Rc.PROTOCOL -> "Sqlite3.Rc.PROTOCOL" + |Sqlite3.Rc.EMPTY -> "Sqlite3.Rc.EMPTY" + |Sqlite3.Rc.SCHEMA -> "Sqlite3.Rc.SCHEMA" + |Sqlite3.Rc.TOOBIG -> "Sqlite3.Rc.TOOBIG" + |Sqlite3.Rc.CONSTRAINT -> "Sqlite3.Rc.CONSTRAINT" + |Sqlite3.Rc.MISMATCH -> "Sqlite3.Rc.MISMATCH" + |Sqlite3.Rc.MISUSE -> "Sqlite3.Rc.MISUSE" + |Sqlite3.Rc.NOFLS -> "Sqlite3.Rc.NOFLS" + |Sqlite3.Rc.AUTH -> "Sqlite3.Rc.AUTH" + |Sqlite3.Rc.FORMAT -> "Sqlite3.Rc.FORMAT" + |Sqlite3.Rc.RANGE -> "Sqlite3.Rc.RANGE" + |Sqlite3.Rc.NOTADB -> "Sqlite3.Rc.NOTADB" + |Sqlite3.Rc.ROW -> "Sqlite3.Rc.ROW" + |Sqlite3.Rc.DONE -> "Sqlite3.Rc.DONE" + |Sqlite3.Rc.UNKNOWN n -> + "Sqlite3.Rc.UNKNOWN " ^ string_of_int (Sqlite3.Rc.int_of_unknown n) +;; + +let pp_rc rc = prerr_endline (string_of_rc rc);; + let exec db s = prerr_endline s; let stored_result = ref [] in @@ -101,7 +137,7 @@ let exec db s = in match rc with | Sqlite3.Rc.OK -> !stored_result - | _ -> raise Error + | _ -> raise (Error (string_of_rc rc)) ;; let rec map res ~f = @@ -114,41 +150,6 @@ let iter res ~f = profiler.HExtlib.profile iter f ;; -let pp_rc = function - |Sqlite3.Rc.OK -> prerr_endline "Sqlite3.Rc.OK" - |Sqlite3.Rc.ERROR -> prerr_endline "Sqlite3.Rc.ERROR" - |Sqlite3.Rc.INTERNAL -> prerr_endline "Sqlite3.Rc.INTERNAL" - |Sqlite3.Rc.PERM -> prerr_endline "Sqlite3.Rc.PERM" - |Sqlite3.Rc.ABORT -> prerr_endline "Sqlite3.Rc.ABORT" - |Sqlite3.Rc.BUSY -> prerr_endline "Sqlite3.Rc.BUSY" - |Sqlite3.Rc.LOCKED -> prerr_endline "Sqlite3.Rc.LOCKED" - |Sqlite3.Rc.NOMEM -> prerr_endline "Sqlite3.Rc.NOMEM" - |Sqlite3.Rc.READONLY -> prerr_endline "Sqlite3.Rc.READONLY" - |Sqlite3.Rc.INTERRUPT -> prerr_endline "Sqlite3.Rc.INTERRUPT" - |Sqlite3.Rc.IOERR -> prerr_endline "Sqlite3.Rc.IOERR" - |Sqlite3.Rc.CORRUPT -> prerr_endline "Sqlite3.Rc.CORRUPT" - |Sqlite3.Rc.NOTFOUND -> prerr_endline "Sqlite3.Rc.NOTFOUND" - |Sqlite3.Rc.FULL -> prerr_endline "Sqlite3.Rc.FULL" - |Sqlite3.Rc.CANTOPEN -> prerr_endline "Sqlite3.Rc.CANTOPEN" - |Sqlite3.Rc.PROTOCOL -> prerr_endline "Sqlite3.Rc.PROTOCOL" - |Sqlite3.Rc.EMPTY -> prerr_endline "Sqlite3.Rc.EMPTY" - |Sqlite3.Rc.SCHEMA -> prerr_endline "Sqlite3.Rc.SCHEMA" - |Sqlite3.Rc.TOOBIG -> prerr_endline "Sqlite3.Rc.TOOBIG" - |Sqlite3.Rc.CONSTRAINT -> prerr_endline "Sqlite3.Rc.CONSTRAINT" - |Sqlite3.Rc.MISMATCH -> prerr_endline "Sqlite3.Rc.MISMATCH" - |Sqlite3.Rc.MISUSE -> prerr_endline "Sqlite3.Rc.MISUSE" - |Sqlite3.Rc.NOFLS -> prerr_endline "Sqlite3.Rc.NOFLS" - |Sqlite3.Rc.AUTH -> prerr_endline "Sqlite3.Rc.AUTH" - |Sqlite3.Rc.FORMAT -> prerr_endline "Sqlite3.Rc.FORMAT" - |Sqlite3.Rc.RANGE -> prerr_endline "Sqlite3.Rc.RANGE" - |Sqlite3.Rc.NOTADB -> prerr_endline "Sqlite3.Rc.NOTADB" - |Sqlite3.Rc.ROW -> prerr_endline "Sqlite3.Rc.ROW" - |Sqlite3.Rc.DONE -> prerr_endline "Sqlite3.Rc.DONE" - |Sqlite3.Rc.UNKNOWN n -> - prerr_endline - ("Sqlite3.Rc.UNKNOWN " ^ string_of_int (Sqlite3.Rc.int_of_unknown n)) -;; - let errno = function | None -> OK | Some db -> diff --git a/helm/software/components/library/libraryDb.ml b/helm/software/components/library/libraryDb.ml index 78cff7948..83bc3f6e6 100644 --- a/helm/software/components/library/libraryDb.ml +++ b/helm/software/components/library/libraryDb.ml @@ -58,7 +58,7 @@ let clean_owner_environment () = let owned_uris = try MetadataDb.clean ~dbd - with HSql.Error as exn -> + with (HSql.Error _) as exn -> match HSql.errno dbd with | HSql.No_such_table -> [] | _ -> raise exn @@ -77,7 +77,7 @@ let clean_owner_environment () = List.iter (fun statement -> try ignore (HSql.exec dbd statement) - with HSql.Error as exn -> + with (HSql.Error _) as exn -> match HSql.errno dbd with | HSql.No_such_table | HSql.Bad_table_error @@ -116,14 +116,14 @@ let create_owner_environment () = try ignore (HSql.exec dbd statement) with - HSql.Error -> + (HSql.Error _) as exc -> let status = HSql.errno dbd in match status with | HSql.Table_exists_error -> () | HSql.Dup_keyname -> () | HSql.GENERIC_ERROR _ -> prerr_endline statement; - raise HSql.Error + raise exc | _ -> ()