]> matita.cs.unibo.it Git - helm.git/blob - components/binaries/extractor/extractor.ml
tagged 0.5.0-rc1
[helm.git] / components / binaries / extractor / extractor.ml
1 let _ = Helm_registry.load_from "extractor.conf.xml"
2
3 let usage () =
4   prerr_endline "
5
6 !! This binary should not be called by hand, use the extractor_manager. !!
7
8 usage: ./extractor[.opt] path owner
9
10 path: the path for the getter maps
11 owner: the owner of the tables to update
12
13 "
14
15 let _ = 
16   try
17     let _ = Sys.argv.(2), Sys.argv.(1) in
18     if Sys.argv.(1) = "-h"||Sys.argv.(1) = "-help"||Sys.argv.(1) = "--help" then
19       begin
20       usage ();
21       exit 1
22       end
23   with 
24     Invalid_argument _ -> usage (); exit 1
25
26 let owner = Sys.argv.(2)
27 let path = Sys.argv.(1)
28
29 let main () =
30   print_endline (Printf.sprintf "%d alive on path:%s owner:%s" 
31     (Unix.getpid()) path owner);
32   Helm_registry.load_from "extractor.conf.xml";
33   Helm_registry.set "tmp.dir" path;
34   Http_getter.init ();
35   let dbspec = LibraryDb.parse_dbd_conf () in
36   let dbd = HSql.quick_connect dbspec in
37   MetadataTypes.ownerize_tables owner;
38   let uris =
39     let ic = open_in (path ^ "/todo") in
40     let acc = ref [] in
41     (try
42       while true do
43         let l = input_line ic in
44         acc := l :: !acc
45       done
46     with
47       End_of_file -> ());
48     close_in ic;
49     !acc
50   in
51   let len = float_of_int (List.length uris) in
52   let i = ref 0 in
53   let magic = 45 in
54   List.iter (fun u ->
55     incr i;
56     let perc = ((float_of_int !i)  /. len *. 100.0) in
57     let l = String.length u in
58     let short = 
59       if l < magic then 
60         u ^ String.make (magic + 3 - l) ' ' 
61       else 
62         "..." ^  String.sub u (l - magic) magic
63     in
64     Printf.printf "%d (%d of %.0f = %3.1f%%): %s\n" 
65      (Unix.getpid ()) !i len perc short;
66     flush stdout;
67     let uri = UriManager.uri_of_string u in
68     MetadataDb.index_obj ~dbd ~uri;
69     CicEnvironment.empty ())
70   uris;
71   print_string "END "; Unix.system "date"
72 ;;
73
74 main ()
75