helm/ocaml/metadata/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) @ (SqlStatements.create_indexes tbls)
  40   in
  41   List.iter (fun statement ->
  42     try
  43       ignore (Mysql.exec dbd statement)
  44     with
  45       exn ->
  46          let status = Mysql.status dbd in
  47          match status with
  48          | Mysql.StatusError Mysql.Table_exists_error -> ()
  49          | Mysql.StatusError _ -> raise exn
  50          | _ -> ()
  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) @ (SqlStatements.drop_indexes tbls)
  65   in
  66   List.iter (fun statement ->
  67     try
  68       ignore (Mysql.exec dbd statement)
  69     with Mysql.Error _ as exn ->
  70       match Mysql.errno dbd with
  71       | Mysql.Bad_table_error
  72       | Mysql.No_such_index | Mysql.No_such_table -> ()
  73       | _ -> raise exn
  74     ) statements
  75
  76 let slash_RE = Str.regexp "/"
  77
  78 let partition l =
  79   let l = List.fast_sort Pervasives.compare l in
  80   let matches s1 s2 =
  81     let l1,l2 = Str.split slash_RE s1, Str.split slash_RE s2 in
  82     match l1,l2 with
  83     | _::x::_,_::y::_ -> x = y
  84     | _ -> false
  85   in
  86   let rec chunk l =
  87     match l with
  88     | [] -> [],[]
  89     | h::(h1::tl as rest) when matches h h1 ->
  90         let ch,todo = chunk rest in
  91         (h::ch),todo
  92     | h::(h1::tl as rest)-> [h],rest
  93     | h::_ -> [h],[]
  94   in
  95   let rec split l =
  96     let ch, todo = chunk l in
  97     match todo with
  98     | [] -> [ch]
  99     | _ -> ch :: split todo
 100   in
 101   split l
 102
 103
 104 (* ARGV PARSING *)
 105
 106 let _ =
 107   try
 108   if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
 109     begin
 110     prerr_endline "
 111 usage: ./extractor_manager[.opt] [processes] [owner]
 112
 113 defaults:
 114   processes = 2
 115   owner = NEW
 116
 117 ";
 118     exit 1
 119     end
 120   with Invalid_argument _ -> ()
 121
 122 let processes =
 123   try
 124     int_of_string (Sys.argv.(1))
 125   with
 126     Invalid_argument _ -> 2
 127
 128 let owner =
 129   try
 130     Sys.argv.(2)
 131   with Invalid_argument _ -> "NEW"
 132
 133 let create_peons i =
 134   let rec aux = function
 135     | 0 -> []
 136     | n -> (n,0) :: aux (n-1)
 137   in
 138   ref (aux i)
 139
 140 let is_a_peon_idle peons =
 141   List.exists (fun (_,x) -> x = 0) !peons
 142
 143 let get_ide_peon peons =
 144   let p = fst(List.find (fun (_,x) -> x = 0) !peons) in
 145   peons := List.filter (fun (x,_) -> x <> p) !peons;
 146   p
 147
 148 let assign_peon peon pid peons =
 149   peons := (peon,pid) :: !peons
 150
 151 let wait_a_peon peons =
 152   let pid,status = Unix.wait () in
 153   (match status with
 154   | Unix.WEXITED 0 -> ()
 155   | Unix.WEXITED s ->
 156       prerr_endline (Printf.sprintf "PEON %d EXIT STATUS %d" pid s)
 157   | Unix.WSIGNALED s ->
 158       prerr_endline
 159        (Printf.sprintf "PEON %d HAD A PROBLEM, KILLED BY SIGNAL %d" pid s)
 160   | Unix.WSTOPPED s ->
 161       prerr_endline
 162        (Printf.sprintf "PEON %d HAD A PROBLEM, STOPPED BY %d" pid s));
 163   let p = fst(List.find (fun (_,x) -> x = pid) !peons) in
 164   peons := List.filter (fun (x,_) -> x <> p) !peons;
 165   peons := (p,0) :: !peons
 166
 167 let is_a_peon_busy peons =
 168   List.exists (fun (_,x) -> x <> 0) !peons
 169
 170 (* MAIN *)
 171 let main () =
 172       Helm_registry.load_from "extractor.conf.xml";
 173       Http_getter.init ();
 174       print_endline "Updating the getter....";
 175       Http_getter.update ();
 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 dbd =
 187         Mysql.quick_connect
 188           ~host:(Helm_registry.get "db.host")
 189           ~user:(Helm_registry.get "db.user")
 190           ~database:(Helm_registry.get "db.database") ()
 191       in
 192       MetadataTypes.ownerize_tables owner;
 193       let uri_RE = Str.regexp ".*\\(ind\\|var\\|con\\)$" in
 194       drop_all dbd;
 195       create_all dbd;
 196       let uris = Http_getter.getalluris () in
 197       let uris = List.filter (fun u -> Str.string_match uri_RE u 0) uris in
 198       let todo = partition uris in
 199       let cur = ref 0 in
 200       let tot = List.length todo in
 201       let peons = create_peons processes in
 202       print_string "START "; flush stdout;
 203       ignore(Unix.system "date");
 204       while !cur < tot do
 205         if is_a_peon_idle peons then
 206           let peon = get_ide_peon peons in
 207           let fmt = formats peon in
 208           let oc = open_out (fmt ^ "/../todo") in
 209           List.iter (fun s -> output_string oc (s^"\n")) (List.nth todo !cur);
 210           close_out oc;
 211           let pid = Unix.fork () in
 212           if pid = 0 then
 213             Unix.execv
 214               "./extractor.opt" [| "./extractor.opt" ; fmt ^ "/../" ; owner|]
 215           else
 216             begin
 217               assign_peon peon pid peons;
 218               incr cur
 219             end
 220         else
 221           wait_a_peon peons
 222       done;
 223       while is_a_peon_busy peons do wait_a_peon peons done;
 224       print_string "END "; flush stdout;
 225       ignore(Unix.system "date");
 226       (* and now the rename table stuff *)
 227       let obj_tbl = MetadataTypes.library_obj_tbl in
 228       let sort_tbl = MetadataTypes.library_sort_tbl in
 229       let rel_tbl = MetadataTypes.library_rel_tbl in
 230       let name_tbl =  MetadataTypes.library_name_tbl in
 231       let count_tbl = MetadataTypes.library_count_tbl in
 232       let hits_tbl = MetadataTypes.library_hits_tbl in
 233       let obj_tbl_b = obj_tbl ^ "_BACKUP" in
 234       let sort_tbl_b = sort_tbl ^ "_BACKUP" in
 235       let rel_tbl_b = rel_tbl ^ "_BACKUP" in
 236       let name_tbl_b = name_tbl ^ "_BACKUP" in
 237       let count_tbl_b = count_tbl ^ "_BACKUP" in
 238       let obj_tbl_c = MetadataTypes.obj_tbl () in
 239       let sort_tbl_c = MetadataTypes.sort_tbl () in
 240       let rel_tbl_c = MetadataTypes.rel_tbl () in
 241       let name_tbl_c =  MetadataTypes.name_tbl () in
 242       let count_tbl_c = MetadataTypes.count_tbl () in
 243       let stats =
 244         SqlStatements.drop_tables [
 245           (obj_tbl_b,`RefObj);
 246           (sort_tbl_b,`RefSort);
 247           (rel_tbl_b,`RefRel);
 248           (name_tbl_b,`ObjectName);
 249           (count_tbl_b,`Count);
 250           (hits_tbl,`Hits) ] @
 251         SqlStatements.drop_indexes [
 252           (obj_tbl,`RefObj);
 253           (sort_tbl,`RefSort);
 254           (rel_tbl,`RefRel);
 255           (name_tbl,`ObjectName);
 256           (count_tbl,`Count);
 257           (obj_tbl_c,`RefObj);
 258           (sort_tbl_c,`RefSort);
 259           (rel_tbl_c,`RefRel);
 260           (name_tbl_c,`ObjectName);
 261           (count_tbl_c,`Count);
 262           (hits_tbl,`Hits) ] @
 263         SqlStatements.rename_tables [
 264           (obj_tbl,obj_tbl_b);
 265           (sort_tbl,sort_tbl_b);
 266           (rel_tbl,rel_tbl_b);
 267           (name_tbl,name_tbl_b);
 268           (count_tbl,count_tbl_b) ] @
 269         SqlStatements.rename_tables [
 270           (obj_tbl_c,obj_tbl);
 271           (sort_tbl_c,sort_tbl);
 272           (rel_tbl_c,rel_tbl);
 273           (name_tbl_c,name_tbl);
 274           (count_tbl_c,count_tbl) ] @
 275         SqlStatements.create_tables [
 276           (hits_tbl,`Hits) ] @
 277         SqlStatements.fill_hits obj_tbl hits_tbl @
 278         SqlStatements.create_indexes [
 279           (obj_tbl,`RefObj);
 280           (sort_tbl,`RefSort);
 281           (rel_tbl,`RefRel);
 282           (name_tbl,`ObjectName);
 283           (count_tbl,`Count);
 284           (hits_tbl,`Hits) ]
 285       in
 286         List.iter (fun statement ->
 287           try
 288 (*            prerr_endline statement;*)
 289             ignore (Mysql.exec dbd statement)
 290           with exn ->
 291             let status = Mysql.status dbd in
 292             match status with
 293             | Mysql.StatusError Mysql.Table_exists_error
 294             | Mysql.StatusError Mysql.Bad_table_error
 295             | Mysql.StatusError Mysql.Cant_drop_field_or_key
 296             | Mysql.StatusError Mysql.Unknown_table -> ()
 297             | Mysql.StatusError status ->
 298 (*                prerr_endline (string_of_int (Obj.magic status));*)
 299                 prerr_endline (Printexc.to_string exn);
 300                 raise exn
 301             | _ ->
 302                 prerr_endline (Printexc.to_string exn);
 303                 ())
 304         stats
 305 ;;
 306
 307 main ()