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
9 (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
10 (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
13 (SqlStatements.create_tables tbls) @ (SqlStatements.create_indexes tbls)
15 List.iter (fun statement ->
17 ignore (Mysql.exec dbd statement)
20 let status = Mysql.status dbd in
22 | Mysql.StatusError Mysql.Table_exists_error -> ()
23 | Mysql.StatusError _ -> raise exn
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
34 (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
35 (name_tbl,`ObjectName) ; (count_tbl,`Count) ]
38 (SqlStatements.drop_tables tbls) @ (SqlStatements.drop_indexes tbls)
40 List.iter (fun statement ->
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 -> ()
50 let slash_RE = Str.regexp "/"
53 let l = List.fast_sort Pervasives.compare l in
55 let l1,l2 = Str.split slash_RE s1, Str.split slash_RE s2 in
57 | _::x::_,_::y::_ -> x = y
63 | h::(h1::tl as rest) when matches h h1 ->
64 let ch,todo = chunk rest in
66 | h::(h1::tl as rest)-> [h],rest
70 let ch, todo = chunk l in
73 | _ -> ch :: split todo
82 if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
85 usage: ./extractor_manager[.opt] [processes] [owner]
94 with Invalid_argument _ -> ()
98 int_of_string (Sys.argv.(1))
100 Invalid_argument _ -> 2
105 with Invalid_argument _ -> "NEW"
108 let rec aux = function
110 | n -> (n,0) :: aux (n-1)
114 let is_a_peon_idle peons =
115 List.exists (fun (_,x) -> x = 0) !peons
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;
122 let assign_peon peon pid peons =
123 peons := (peon,pid) :: !peons
125 let wait_a_peon peons =
126 let pid,status = Unix.wait () in
128 | Unix.WEXITED 0 -> ()
130 prerr_endline (Printf.sprintf "PEON %d EXIT STATUS %d" pid s)
131 | Unix.WSIGNALED s ->
133 (Printf.sprintf "PEON %d HAD A PROBLEM, KILLED BY SIGNAL %d" pid s)
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
141 let is_a_peon_busy peons =
142 List.exists (fun (_,x) -> x <> 0) !peons
146 Helm_registry.load_from "extractor.conf.xml";
148 print_endline "Updating the getter....";
149 Http_getter.update ();
150 let base = (Helm_registry.get "tmp.dir") ^ "/maps" in
152 (Helm_registry.get "tmp.dir") ^ "/"^(string_of_int i)^"/maps"
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 ^ "/../"));
162 ~host:(Helm_registry.get "db.host")
163 ~user:(Helm_registry.get "db.user")
164 ~database:(Helm_registry.get "db.database") ()
166 MetadataTypes.ownerize_tables owner;
167 let uri_RE = Str.regexp ".*\\(ind\\|var\\|con\\)$" in
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
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");
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);
185 let pid = Unix.fork () in
188 "./extractor.opt" [| "./extractor.opt" ; fmt ^ "/../" ; owner|]
191 assign_peon peon pid peons;
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
218 SqlStatements.drop_tables [
220 (sort_tbl_b,`RefSort);
222 (name_tbl_b,`ObjectName);
223 (count_tbl_b,`Count) ] @
224 SqlStatements.drop_indexes [
228 (name_tbl,`ObjectName);
231 (sort_tbl_c,`RefSort);
233 (name_tbl_c,`ObjectName);
234 (count_tbl_c,`Count) ] @
235 SqlStatements.rename_tables [
237 (sort_tbl,sort_tbl_b);
239 (name_tbl,name_tbl_b);
240 (count_tbl,count_tbl_b) ] @
241 SqlStatements.rename_tables [
243 (sort_tbl_c,sort_tbl);
245 (name_tbl_c,name_tbl);
246 (count_tbl_c,count_tbl) ] @
247 SqlStatements.create_tables [
249 SqlStatements.fill_hits obj_tbl hits_tbl @
250 SqlStatements.create_indexes [
254 (name_tbl,`ObjectName);
258 List.iter (fun statement ->
260 ignore (Mysql.exec dbd statement)
262 let status = Mysql.status dbd in
264 | Mysql.StatusError Mysql.Table_exists_error -> ()
265 | Mysql.StatusError _ -> raise exn