ocaml 3.09 transition

[helm.git] / helm / ocaml / metadata / extractor / extractor.ml

diff --git a/helm/ocaml/metadata/extractor/extractor.ml b/helm/ocaml/metadata/extractor/extractor.ml
index f3c39d382a423cc4b0c6dfec6ad351ea60a2f9a3..418d5ff7cd8b7c6e32f323942aa884bee48ce129 100644 (file)
--- a/helm/ocaml/metadata/extractor/extractor.ml
+++ b/helm/ocaml/metadata/extractor/extractor.ml
@@ -1,92 +1,78 @@
 let _ = Helm_registry.load_from "extractor.conf.xml"
-let _ = Unix.system ("mkdir -p " ^ (Helm_registry.get "tmp.dir"))
-let _ = Http_getter.init () 
-(*let _ = Http_getter.update () *)
 
-let dbd =
-  Mysql.quick_connect 
-    ~host:(Helm_registry.get "db.host") 
-    ~user:(Helm_registry.get "db.user") 
-    ~database:(Helm_registry.get "db.database") ()
+let usage () =
+  prerr_endline "
 
-let _ =
+!! This binary should not be called by hand, use the extractor_manager. !!
+
+usage: ./extractor[.opt] path owner
+
+path: the path for the getter maps
+owner: the owner of the tables to update
+
+"
+
+let _ = 
   try
-    MetadataTypes.ownerize_tables Sys.argv.(1)
-  with Invalid_argument _ -> MetadataTypes.ownerize_tables "NEW"
+    let _ = Sys.argv.(2), Sys.argv.(1) in
+    if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
+      begin
+      usage ();
+      exit 1
+      end
+  with 
+    Invalid_argument _ -> usage (); exit 1
 
-let uri_RE = Str.regexp ".*\\(ind\\|var\\|con\\)$"
- 
-let create_all () =
-  let obj_tbl = MetadataTypes.obj_tbl () in
-  let sort_tbl = MetadataTypes.sort_tbl () in
-  let rel_tbl = MetadataTypes.rel_tbl () in
-  let name_tbl =  MetadataTypes.name_tbl () in
-  let count_tbl = MetadataTypes.count_tbl () in
-  let tbls = [ 
-    (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
-    (name_tbl,`ObjectName) ; (count_tbl,`Count) ] 
-  in
-  let statements = 
-    (SqlStatements.create_tables tbls) @ (SqlStatements.create_indexes tbls)
-  in
-  List.iter (fun statement -> 
-    try
-      ignore (Mysql.exec dbd statement)
-    with
-      exn -> 
-         let status = Mysql.status dbd in
-         match status with 
-         | Mysql.StatusError Mysql.Table_exists_error -> ()
-         | Mysql.StatusError _ -> raise exn
-         | _ -> ()
-      ) statements
+let owner = Sys.argv.(2)
+let path = Sys.argv.(1)
 
-let drop_all () =
-  let obj_tbl = MetadataTypes.obj_tbl () in
-  let sort_tbl = MetadataTypes.sort_tbl () in
-  let rel_tbl = MetadataTypes.rel_tbl () in
-  let name_tbl =  MetadataTypes.name_tbl () in
-  let count_tbl = MetadataTypes.count_tbl () in
-  let tbls = [ 
-    (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
-    (name_tbl,`ObjectName) ; (count_tbl,`Count) ] 
+let main () =
+  print_endline (Printf.sprintf "%d alive on path:%s owner:%s" 
+    (Unix.getpid()) path owner);
+  Helm_registry.set "tmp.dir" path;
+  Http_getter.init ();
+  let dbd =
+    HMysql.quick_connect 
+      ~host:(Helm_registry.get "db.host") 
+      ~user:(Helm_registry.get "db.user") 
+      ~database:(Helm_registry.get "db.database") ()
   in
-  let statements = 
-    (SqlStatements.drop_tables tbls) @ (SqlStatements.drop_indexes tbls)
+  MetadataTypes.ownerize_tables owner;
+  let uris =
+    let ic = open_in (path ^ "/todo") in
+    let acc = ref [] in
+    (try
+      while true do
+        let l = input_line ic in
+        acc := l :: !acc
+      done
+    with
+      End_of_file -> ());
+    close_in ic;
+    !acc
   in
-  List.iter (fun statement -> 
-    try
-      ignore (Mysql.exec dbd statement)
-    with Mysql.Error _ as exn ->
-      match Mysql.errno dbd with 
-      | Mysql.Bad_table_error 
-      | Mysql.No_such_index | Mysql.No_such_table -> () 
-      | _ -> raise exn
-    ) statements
-  
-
-let main () =
-  drop_all ();
-  create_all ();
-  let uris = Http_getter.getalluris () in
-  let uris = List.filter (fun u -> Str.string_match uri_RE u 0) uris in
   let len = float_of_int (List.length uris) in
   let i = ref 0 in
+  let magic = 45 in
   List.iter (fun u ->
     incr i;
     let perc = ((float_of_int !i)  /. len *. 100.0) in
     let l = String.length u in
     let short = 
-      if l < 60 then 
-        u ^ String.make (63 - l) ' ' 
+      if l < magic then 
+        u ^ String.make (magic + 3 - l) ' ' 
       else 
-        "..." ^  String.sub u (l - 60) 60
+        "..." ^  String.sub u (l - magic) magic
     in
-    Printf.printf "\rIndexing (%3.1f%%): %s" perc short;
+    Printf.printf "%d (%d of %.0f = %3.1f%%): %s\n" 
+     (Unix.getpid ()) !i len perc short;
     flush stdout;
     let uri = UriManager.uri_of_string u in
-    MetadataDb.index_obj ~dbd ~uri)
-  uris
+    MetadataDb.index_obj ~dbd ~uri;
+    CicEnvironment.empty ())
+  uris;
+  print_string "END "; Unix.system "date"
 ;;
 
 main ()
+