]> matita.cs.unibo.it Git - helm.git/blob - helm/software/components/binaries/extractor/extractor_manager.ml
Initial implementation of statuses using objects in place of nested records.
[helm.git] / helm / software / components / binaries / extractor / extractor_manager.ml
1 (* Copyright (C) 2004-2005, HELM Team.
2  * 
3  * This file is part of HELM, an Hypertextual, Electronic
4  * Library of Mathematics, developed at the Computer Science
5  * Department, University of Bologna, Italy.
6  * 
7  * HELM is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  * 
12  * HELM is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with HELM; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://helm.cs.unibo.it/
24  *)
25
26 (* HELPERS *)
27
28 let create_all dbd =
29   let obj_tbl = MetadataTypes.obj_tbl () in
30   let sort_tbl = MetadataTypes.sort_tbl () in
31   let rel_tbl = MetadataTypes.rel_tbl () in
32   let name_tbl =  MetadataTypes.name_tbl () in
33   let count_tbl = MetadataTypes.count_tbl () in
34   let tbls = [ 
35     (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
36     (name_tbl,`ObjectName) ; (count_tbl,`Count) ] 
37   in
38   let statements = 
39     (SqlStatements.create_tables tbls) @ 
40     (SqlStatements.create_indexes tbls)
41   in
42   List.iter (fun statement -> 
43     try
44       ignore (HSql.exec HSql.Library dbd statement)
45     with
46       HSql.Error _ as exn -> 
47          match HSql.errno HSql.Library dbd with 
48          | HSql.Table_exists_error -> ()
49          | HSql.OK -> ()
50          | _ -> raise exn
51       ) statements
52
53 let drop_all dbd =
54   let obj_tbl = MetadataTypes.obj_tbl () in
55   let sort_tbl = MetadataTypes.sort_tbl () in
56   let rel_tbl = MetadataTypes.rel_tbl () in
57   let name_tbl =  MetadataTypes.name_tbl () in
58   let count_tbl = MetadataTypes.count_tbl () in
59   let tbls = [ 
60     (obj_tbl,`RefObj) ; (sort_tbl,`RefSort) ; (rel_tbl,`RefRel) ;
61     (name_tbl,`ObjectName) ; (count_tbl,`Count) ] 
62   in
63   let statements = 
64     (SqlStatements.drop_tables tbls) @ 
65     (SqlStatements.drop_indexes tbls HSql.Library dbd)
66   in
67   List.iter (fun statement -> 
68     try
69       ignore (HSql.exec HSql.Library dbd statement)
70     with HSql.Error _ as exn ->
71       match HSql.errno HSql.Library dbd with 
72       | HSql.Bad_table_error 
73       | HSql.No_such_index | HSql.No_such_table -> () 
74       | _ -> raise exn
75     ) statements
76   
77 let slash_RE = Str.regexp "/"
78     
79 let partition l = 
80   let l = List.fast_sort Pervasives.compare l in
81   let matches s1 s2 =
82     let l1,l2 = Str.split slash_RE s1, Str.split slash_RE s2 in
83     match l1,l2 with
84     | _::x::_,_::y::_ -> x = y 
85     | _ -> false
86   in
87   let rec chunk l =
88     match l with
89     | [] -> [],[]
90     | h::(h1::tl as rest) when matches h h1 -> 
91         let ch,todo = chunk rest in
92         (h::ch),todo
93     | h::(h1::tl as rest)-> [h],rest
94     | h::_ -> [h],[]
95   in
96   let rec split l = 
97     let ch, todo = chunk l in
98     match todo with
99     | [] -> [ch]
100     | _ -> ch :: split todo
101   in
102   split l
103   
104     
105 (* ARGV PARSING *)
106
107 let _ = 
108   try
109   if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
110     begin
111     prerr_endline "
112 usage: ./extractor_manager[.opt] [processes] [owner]
113
114 defaults:
115   processes = 2
116   owner = NEW
117
118 "; 
119     exit 1
120     end
121   with Invalid_argument _ -> ()
122
123 let processes = 
124   try
125     int_of_string (Sys.argv.(1))
126   with 
127     Invalid_argument _ -> 2
128
129 let owner =
130   try
131     Sys.argv.(2)
132   with Invalid_argument _ -> "NEW"
133
134 let create_peons i =
135   let rec aux = function
136     | 0 -> []
137     | n -> (n,0) :: aux (n-1)
138   in
139   ref (aux i)
140
141 let is_a_peon_idle peons =
142   List.exists (fun (_,x) -> x = 0) !peons
143
144 let get_ide_peon peons =
145   let p = fst(List.find (fun (_,x) -> x = 0) !peons) in
146   peons := List.filter (fun (x,_) -> x <> p) !peons;
147   p
148  
149 let assign_peon peon pid peons =
150   peons := (peon,pid) :: !peons
151   
152 let wait_a_peon peons =
153   let pid,status = Unix.wait () in
154   (match status with
155   | Unix.WEXITED 0 -> ()
156   | Unix.WEXITED s ->
157       prerr_endline (Printf.sprintf "PEON %d EXIT STATUS %d" pid s)
158   | Unix.WSIGNALED s -> 
159       prerr_endline 
160        (Printf.sprintf "PEON %d HAD A PROBLEM, KILLED BY SIGNAL %d" pid s)
161   | Unix.WSTOPPED s -> 
162       prerr_endline 
163        (Printf.sprintf "PEON %d HAD A PROBLEM, STOPPED BY %d" pid s));
164   let p = fst(List.find (fun (_,x) -> x = pid) !peons) in
165   peons := List.filter (fun (x,_) -> x <> p) !peons;
166   peons := (p,0) :: !peons
167  
168 let is_a_peon_busy peons =
169   List.exists (fun (_,x) -> x <> 0) !peons
170   
171 (* MAIN *)
172 let main () =
173       Helm_registry.load_from "extractor.conf.xml";
174       Http_getter.init ();
175       print_endline "Updating the getter....";
176       let base = (Helm_registry.get "tmp.dir") ^ "/maps" in
177       let formats i = 
178         (Helm_registry.get "tmp.dir") ^ "/"^(string_of_int i)^"/maps" 
179       in
180       for i = 1 to processes do
181         let fmt = formats i in
182         ignore(Unix.system ("rm -rf " ^ fmt));
183         ignore(Unix.system ("mkdir -p " ^ fmt));
184         ignore(Unix.system ("cp -r " ^ base ^ " " ^ fmt ^ "/../"));
185       done;
186       let dbspec = LibraryDb.parse_dbd_conf () in
187       let dbd = HSql.quick_connect dbspec in
188       MetadataTypes.ownerize_tables owner;
189       let uri_RE = Str.regexp ".*\\(ind\\|var\\|con\\)$" in
190       drop_all dbd;
191       create_all dbd;
192       let uris = Http_getter.getalluris () in
193       let uris = List.filter (fun u -> Str.string_match uri_RE u 0) uris in
194       let todo = partition uris in
195       let cur = ref 0 in
196       let tot = List.length todo in
197       let peons = create_peons processes in
198       print_string "START "; flush stdout;
199       ignore(Unix.system "date");
200       while !cur < tot do
201         if is_a_peon_idle peons then
202           let peon = get_ide_peon peons in
203           let fmt = formats peon in
204           let oc = open_out (fmt ^ "/../todo") in
205           List.iter (fun s -> output_string oc (s^"\n")) (List.nth todo !cur);
206           close_out oc;
207           let pid = Unix.fork () in
208           if pid = 0 then
209             Unix.execv 
210               "./extractor.opt" [| "./extractor.opt" ; fmt ^ "/../" ; owner|]
211           else
212             begin
213               assign_peon peon pid peons;
214               incr cur
215             end
216         else
217           wait_a_peon peons
218       done;
219       while is_a_peon_busy peons do wait_a_peon peons done;
220       print_string "END "; flush stdout; 
221       ignore(Unix.system "date"); 
222       (* and now the rename table stuff *)
223       let obj_tbl = MetadataTypes.library_obj_tbl in
224       let sort_tbl = MetadataTypes.library_sort_tbl in
225       let rel_tbl = MetadataTypes.library_rel_tbl in
226       let name_tbl =  MetadataTypes.library_name_tbl in
227       let count_tbl = MetadataTypes.library_count_tbl in
228       let hits_tbl = MetadataTypes.library_hits_tbl in
229       let obj_tbl_b = obj_tbl ^ "_BACKUP" in     
230       let sort_tbl_b = sort_tbl ^ "_BACKUP" in     
231       let rel_tbl_b = rel_tbl ^ "_BACKUP" in
232       let name_tbl_b = name_tbl ^ "_BACKUP" in    
233       let count_tbl_b = count_tbl ^ "_BACKUP" in    
234       let obj_tbl_c = MetadataTypes.obj_tbl () in
235       let sort_tbl_c = MetadataTypes.sort_tbl () in
236       let rel_tbl_c = MetadataTypes.rel_tbl () in
237       let name_tbl_c =  MetadataTypes.name_tbl () in
238       let count_tbl_c = MetadataTypes.count_tbl () in
239       let stats = 
240         SqlStatements.drop_tables [
241           (obj_tbl_b,`RefObj);
242           (sort_tbl_b,`RefSort);
243           (rel_tbl_b,`RefRel);
244           (name_tbl_b,`ObjectName);
245           (count_tbl_b,`Count);
246           (hits_tbl,`Hits) ] @
247         SqlStatements.drop_indexes [
248           (obj_tbl,`RefObj);
249           (sort_tbl,`RefSort);
250           (rel_tbl,`RefRel);
251           (name_tbl,`ObjectName);
252           (count_tbl,`Count);
253           (obj_tbl_c,`RefObj);
254           (sort_tbl_c,`RefSort);
255           (rel_tbl_c,`RefRel);
256           (name_tbl_c,`ObjectName);
257           (count_tbl_c,`Count);
258           (hits_tbl,`Hits) ] HSql.Library dbd @
259         SqlStatements.rename_tables [
260           (obj_tbl,obj_tbl_b);
261           (sort_tbl,sort_tbl_b);
262           (rel_tbl,rel_tbl_b);
263           (name_tbl,name_tbl_b);
264           (count_tbl,count_tbl_b) ] @
265         SqlStatements.rename_tables [
266           (obj_tbl_c,obj_tbl);
267           (sort_tbl_c,sort_tbl);
268           (rel_tbl_c,rel_tbl);
269           (name_tbl_c,name_tbl);
270           (count_tbl_c,count_tbl) ] @
271         SqlStatements.create_tables [
272           (hits_tbl,`Hits) ] @
273         SqlStatements.fill_hits obj_tbl hits_tbl @
274         SqlStatements.create_indexes [
275           (obj_tbl,`RefObj);
276           (sort_tbl,`RefSort);
277           (rel_tbl,`RefRel);
278           (name_tbl,`ObjectName);
279           (count_tbl,`Count);
280           (hits_tbl,`Hits) ]
281       in
282         List.iter (fun statement -> 
283           try
284             ignore (HSql.exec HSql.Library dbd statement)
285           with HSql.Error _ as exn -> 
286             match HSql.errno HSql.Library dbd with 
287             | HSql.Table_exists_error
288             | HSql.Bad_table_error -> ()
289             | _ ->
290                 prerr_endline (Printexc.to_string exn);
291                 raise exn)
292         stats
293 ;;
294
295 main ()