helm/ocaml/metadata/extractor/extractor_manager.ml

   1 (* HELPERS *)
   2 let create_all dbd =
   3   let obj_tbl = MetadataTypes.obj_tbl () in
   4   let sort_tbl = MetadataTypes.sort_tbl () in
   5   let rel_tbl = MetadataTypes.rel_tbl () in
   6   let name_tbl =  MetadataTypes.name_tbl () in
   7   let count_tbl = MetadataTypes.count_tbl () in
   8   let tbls = [
   9     (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
  10     (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
  11   in
  12   let statements =
  13     (SqlStatements.create_tables tbls) @ (SqlStatements.create_indexes tbls)
  14   in
  15   List.iter (fun statement ->
  16     try
  17       ignore (Mysql.exec dbd statement)
  18     with
  19       exn ->
  20          let status = Mysql.status dbd in
  21          match status with
  22          | Mysql.StatusError Mysql.Table_exists_error -> ()
  23          | Mysql.StatusError _ -> raise exn
  24          | _ -> ()
  25       ) statements
  26
  27 let drop_all dbd =
  28   let obj_tbl = MetadataTypes.obj_tbl () in
  29   let sort_tbl = MetadataTypes.sort_tbl () in
  30   let rel_tbl = MetadataTypes.rel_tbl () in
  31   let name_tbl =  MetadataTypes.name_tbl () in
  32   let count_tbl = MetadataTypes.count_tbl () in
  33   let tbls = [
  34     (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
  35     (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
  36   in
  37   let statements =
  38     (SqlStatements.drop_tables tbls) @ (SqlStatements.drop_indexes tbls)
  39   in
  40   List.iter (fun statement ->
  41     try
  42       ignore (Mysql.exec dbd statement)
  43     with Mysql.Error _ as exn ->
  44       match Mysql.errno dbd with
  45       | Mysql.Bad_table_error
  46       | Mysql.No_such_index | Mysql.No_such_table -> ()
  47       | _ -> raise exn
  48     ) statements
  49
  50 let slash_RE = Str.regexp "/"
  51
  52 let partition l =
  53   let l = List.fast_sort Pervasives.compare l in
  54   let matches s1 s2 =
  55     let l1,l2 = Str.split slash_RE s1, Str.split slash_RE s2 in
  56     match l1,l2 with
  57     | _::x::_,_::y::_ -> x = y
  58     | _ -> false
  59   in
  60   let rec chunk l =
  61     match l with
  62     | [] -> [],[]
  63     | h::(h1::tl as rest) when matches h h1 ->
  64         let ch,todo = chunk rest in
  65         (h::ch),todo
  66     | h::(h1::tl as rest)-> [h],rest
  67     | h::_ -> [h],[]
  68   in
  69   let rec split l =
  70     let ch, todo = chunk l in
  71     match todo with
  72     | [] -> [ch]
  73     | _ -> ch :: split todo
  74   in
  75   split l
  76
  77
  78 (* ARGV PARSING *)
  79
  80 let _ =
  81   try
  82   if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
  83     begin
  84     prerr_endline "
  85 usage: ./extractor_manager[.opt] [processes] [owner]
  86
  87 defaults:
  88   processes = 2
  89   owner = NEW
  90
  91 ";
  92     exit 1
  93     end
  94   with Invalid_argument _ -> ()
  95
  96 let processes =
  97   try
  98     int_of_string (Sys.argv.(1))
  99   with
 100     Invalid_argument _ -> 2
 101
 102 let owner =
 103   try
 104     Sys.argv.(2)
 105   with Invalid_argument _ -> "NEW"
 106
 107 let create_peons i =
 108   let rec aux = function
 109     | 0 -> []
 110     | n -> (n,0) :: aux (n-1)
 111   in
 112   ref (aux i)
 113
 114 let is_a_peon_idle peons =
 115   List.exists (fun (_,x) -> x = 0) !peons
 116
 117 let get_ide_peon peons =
 118   let p = fst(List.find (fun (_,x) -> x = 0) !peons) in
 119   peons := List.filter (fun (x,_) -> x <> p) !peons;
 120   p
 121
 122 let assign_peon peon pid peons =
 123   peons := (peon,pid) :: !peons
 124
 125 let wait_a_peon peons =
 126   let pid,status = Unix.wait () in
 127   (match status with
 128   | Unix.WEXITED 0 -> ()
 129   | Unix.WEXITED s ->
 130       prerr_endline (Printf.sprintf "PEON %d EXIT STATUS %d" pid s)
 131   | Unix.WSIGNALED s ->
 132       prerr_endline
 133        (Printf.sprintf "PEON %d HAD A PROBLEM, KILLED BY SIGNAL %d" pid s)
 134   | Unix.WSTOPPED s ->
 135       prerr_endline
 136        (Printf.sprintf "PEON %d HAD A PROBLEM, STOPPED BY %d" pid s));
 137   let p = fst(List.find (fun (_,x) -> x = pid) !peons) in
 138   peons := List.filter (fun (x,_) -> x <> p) !peons;
 139   peons := (p,0) :: !peons
 140
 141 let is_a_peon_busy peons =
 142   List.exists (fun (_,x) -> x <> 0) !peons
 143
 144 (* MAIN *)
 145 let main () =
 146       Helm_registry.load_from "extractor.conf.xml";
 147       Http_getter.init ();
 148       print_endline "Updating the getter....";
 149       Http_getter.update ();
 150       let base = (Helm_registry.get "tmp.dir") ^ "/maps" in
 151       let formats i =
 152         (Helm_registry.get "tmp.dir") ^ "/"^(string_of_int i)^"/maps"
 153       in
 154       for i = 1 to processes do
 155         let fmt = formats i in
 156         ignore(Unix.system ("rm -rf " ^ fmt));
 157         ignore(Unix.system ("mkdir -p " ^ fmt));
 158         ignore(Unix.system ("cp -r " ^ base ^ " " ^ fmt ^ "/../"));
 159       done;
 160       let dbd =
 161         Mysql.quick_connect
 162           ~host:(Helm_registry.get "db.host")
 163           ~user:(Helm_registry.get "db.user")
 164           ~database:(Helm_registry.get "db.database") ()
 165       in
 166       MetadataTypes.ownerize_tables owner;
 167       let uri_RE = Str.regexp ".*\\(ind\\|var\\|con\\)$" in
 168       drop_all dbd;
 169       create_all dbd;
 170       let uris = Http_getter.getalluris () in
 171       let uris = List.filter (fun u -> Str.string_match uri_RE u 0) uris in
 172       let todo = partition uris in
 173       let cur = ref 0 in
 174       let tot = List.length todo in
 175       let peons = create_peons processes in
 176       print_string "START "; flush stdout;
 177       ignore(Unix.system "date");
 178       while !cur < tot do
 179         if is_a_peon_idle peons then
 180           let peon = get_ide_peon peons in
 181           let fmt = formats peon in
 182           let oc = open_out (fmt ^ "/../todo") in
 183           List.iter (fun s -> output_string oc (s^"\n")) (List.nth todo !cur);
 184           close_out oc;
 185           let pid = Unix.fork () in
 186           if pid = 0 then
 187             Unix.execv
 188               "./extractor.opt" [| "./extractor.opt" ; fmt ^ "/../" ; owner|]
 189           else
 190             begin
 191               assign_peon peon pid peons;
 192               incr cur
 193             end
 194         else
 195           wait_a_peon peons
 196       done;
 197       while is_a_peon_busy peons do wait_a_peon peons done;
 198       print_string "END "; flush stdout;
 199       ignore(Unix.system "date")
 200 ;;
 201
 202 main ()