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   | _ -> prerr_endline (Printf.sprintf "PEON %d HAD A PROBLEM" pid));
 130   let p = fst(List.find (fun (_,x) -> x = pid) !peons) in
 131   peons := List.filter (fun (x,_) -> x <> p) !peons;
 132   peons := (p,0) :: !peons
 133
 134 let is_a_peon_busy peons =
 135   List.exists (fun (_,x) -> x <> 0) !peons
 136
 137 (* MAIN *)
 138 let main () =
 139       Helm_registry.load_from "extractor.conf.xml";
 140       Http_getter.init ();
 141       print_endline "Updating the getter....";
 142       Http_getter.update ();
 143       let base = (Helm_registry.get "tmp.dir") ^ "/maps" in
 144       let formats i =
 145         (Helm_registry.get "tmp.dir") ^ "/"^(string_of_int i)^"/maps"
 146       in
 147       for i = 1 to processes do
 148         let fmt = formats i in
 149         ignore(Unix.system ("rm -rf " ^ fmt));
 150         ignore(Unix.system ("mkdir -p " ^ fmt));
 151         ignore(Unix.system ("cp -r " ^ base ^ " " ^ fmt ^ "/../"));
 152       done;
 153       let dbd =
 154         Mysql.quick_connect
 155           ~host:(Helm_registry.get "db.host")
 156           ~user:(Helm_registry.get "db.user")
 157           ~database:(Helm_registry.get "db.database") ()
 158       in
 159       MetadataTypes.ownerize_tables owner;
 160       let uri_RE = Str.regexp ".*\\(ind\\|var\\|con\\)$" in
 161       drop_all dbd;
 162       create_all dbd;
 163       let uris = Http_getter.getalluris () in
 164       let uris = List.filter (fun u -> Str.string_match uri_RE u 0) uris in
 165       let todo = partition uris in
 166       let cur = ref 0 in
 167       let tot = List.length todo in
 168       let peons = create_peons processes in
 169       print_string "START "; flush stdout;
 170       ignore(Unix.system "date");
 171       while !cur < tot do
 172         if is_a_peon_idle peons then
 173           let peon = get_ide_peon peons in
 174           let fmt = formats peon in
 175           let oc = open_out (fmt ^ "/../todo") in
 176           List.iter (fun s -> output_string oc (s^"\n")) (List.nth todo !cur);
 177           close_out oc;
 178           let pid = Unix.fork () in
 179           if pid = 0 then
 180             Unix.execv
 181               "./extractor.opt" [| "./extractor.opt" ; fmt ^ "/../" ; owner|]
 182           else
 183             begin
 184               assign_peon peon pid peons;
 185               incr cur
 186             end
 187         else
 188           wait_a_peon peons
 189       done;
 190       while is_a_peon_busy peons do wait_a_peon peons done;
 191       print_string "END "; flush stdout;
 192       ignore(Unix.system "date")
 193 ;;
 194
 195 main ()