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       (* and now the rename table stuff *)
 201       let obj_tbl = MetadataTypes.library_obj_tbl in
 202       let sort_tbl = MetadataTypes.library_sort_tbl in
 203       let rel_tbl = MetadataTypes.library_rel_tbl in
 204       let name_tbl =  MetadataTypes.library_name_tbl in
 205       let count_tbl = MetadataTypes.library_count_tbl in
 206       let hits_tbl = MetadataTypes.library_hits_tbl in
 207       let obj_tbl_b = obj_tbl ^ "_BACKUP" in
 208       let sort_tbl_b = sort_tbl ^ "_BACKUP" in
 209       let rel_tbl_b = rel_tbl ^ "_BACKUP" in
 210       let name_tbl_b = name_tbl ^ "_BACKUP" in
 211       let count_tbl_b = count_tbl ^ "_BACKUP" in
 212       let obj_tbl_c = MetadataTypes.obj_tbl () in
 213       let sort_tbl_c = MetadataTypes.sort_tbl () in
 214       let rel_tbl_c = MetadataTypes.rel_tbl () in
 215       let name_tbl_c =  MetadataTypes.name_tbl () in
 216       let count_tbl_c = MetadataTypes.count_tbl () in
 217       let stats =
 218         SqlStatements.drop_tables [
 219           (obj_tbl_b,`RefObj);
 220           (sort_tbl_b,`RefSort);
 221           (rel_tbl_b,`RefRel);
 222           (name_tbl_b,`ObjectName);
 223           (count_tbl_b,`Count) ] @
 224         SqlStatements.drop_indexes [
 225           (obj_tbl,`RefObj);
 226           (sort_tbl,`RefSort);
 227           (rel_tbl,`RefRel);
 228           (name_tbl,`ObjectName);
 229           (count_tbl,`Count);
 230           (obj_tbl_c,`RefObj);
 231           (sort_tbl_c,`RefSort);
 232           (rel_tbl_c,`RefRel);
 233           (name_tbl_c,`ObjectName);
 234           (count_tbl_c,`Count) ] @
 235         SqlStatements.rename_tables [
 236           (obj_tbl,obj_tbl_b);
 237           (sort_tbl,sort_tbl_b);
 238           (rel_tbl,rel_tbl_b);
 239           (name_tbl,name_tbl_b);
 240           (count_tbl,count_tbl_b) ] @
 241         SqlStatements.rename_tables [
 242           (obj_tbl_c,obj_tbl);
 243           (sort_tbl_c,sort_tbl);
 244           (rel_tbl_c,rel_tbl);
 245           (name_tbl_c,name_tbl);
 246           (count_tbl_c,count_tbl) ] @
 247         SqlStatements.create_tables [
 248           (hits_tbl,`Hits) ] @
 249         SqlStatements.fill_hits obj_tbl hits_tbl @
 250         SqlStatements.create_indexes [
 251           (obj_tbl,`RefObj);
 252           (sort_tbl,`RefSort);
 253           (rel_tbl,`RefRel);
 254           (name_tbl,`ObjectName);
 255           (count_tbl,`Count);
 256           (hits_tbl,`Hits) ]
 257       in
 258         List.iter (fun statement ->
 259           try
 260             ignore (Mysql.exec dbd statement)
 261           with exn ->
 262             let status = Mysql.status dbd in
 263             match status with
 264             | Mysql.StatusError Mysql.Table_exists_error -> ()
 265             | Mysql.StatusError _ -> raise exn
 266             | _ -> ())
 267         stats
 268 ;;
 269
 270 main ()