]> matita.cs.unibo.it Git - helm.git/blob - helm/ocaml/metadata/table_creator/table_creator.ml
ocaml 3.09 transition
[helm.git] / helm / ocaml / metadata / table_creator / table_creator.ml
1
2 open Printf
3
4 let map =
5   (MetadataTypes.library_obj_tbl,`RefObj) ::
6   (MetadataTypes.library_sort_tbl,`RefSort) ::
7   (MetadataTypes.library_rel_tbl,`RefRel) ::
8   (MetadataTypes.library_name_tbl,`ObjectName) ::
9   (MetadataTypes.library_hits_tbl,`Hits) ::
10   (MetadataTypes.library_count_tbl,`Count) :: []
11
12 let usage argv_o =
13   prerr_string "\nusage:";
14   prerr_string ("\t" ^ argv_o ^ " what tablename[=rename]\n");
15   prerr_string ("\t" ^ argv_o ^ " what all\n\n");
16   prerr_endline "what:";
17   prerr_endline "\tlist\tlist table names";
18   prerr_endline "\ttable\toutput SQL regarding tables";
19   prerr_endline "\tindex\toutput SQL regarding indexes";
20   prerr_endline "\tfill\toutput SQL filling tables (only \"hits\" supported)\n";
21   prerr_string "known tables:\n\t";
22   List.iter (fun (n,_) -> prerr_string (" " ^ n)) map;
23   prerr_endline "\n"
24
25 let eq_RE = Str.regexp "="
26   
27 let parse_args l =
28   List.map (fun s -> 
29     let parts = Str.split eq_RE s in
30     let len = List.length parts in
31     assert (len = 1 || len = 2);
32     if len = 1 then (s,s) else (List.nth parts 0, List.nth parts 1)) 
33   l
34
35 let destructor_RE = Str.regexp "table_destructor\\(\\|\\.opt\\)$"
36   
37 let am_i_destructor () = 
38   try 
39     let _ = Str.search_forward destructor_RE Sys.argv.(0) 0 in true
40   with Not_found -> false
41   
42 let main () =
43   let len = Array.length Sys.argv in
44   if len < 3 then 
45     begin
46     usage Sys.argv.(0);
47     exit 1
48     end
49   else
50     begin
51       let tab,idx,fill =
52         if am_i_destructor () then
53           (SqlStatements.drop_tables,SqlStatements.drop_indexes,
54            fun _ t -> [sprintf "DELETE * FROM %s;" t])
55         else
56           (SqlStatements.create_tables,SqlStatements.create_indexes,
57            SqlStatements.fill_hits)
58       in
59       let from = 2 in
60       let what =
61         match Sys.argv.(1) with
62         | "list" -> `List
63         | "index" -> `Index
64         | "table" -> `Table
65         | "fill" -> `Fill
66         | _ -> failwith "what must be one of \"index\", \"table\", \"fill\""
67       in
68       let todo = Array.to_list (Array.sub Sys.argv from (len - from)) in
69       let todo = match todo with ["all"] -> List.map fst map | todo -> todo in
70       let todo = parse_args todo in
71       let todo = List.map (fun (x,name) -> name, (List.assoc x map)) todo in
72       match what with
73       | `Index -> print_endline (String.concat "\n" (idx todo))
74       | `Table -> print_endline (String.concat "\n" (tab todo))
75       | `Fill ->
76           print_endline (String.concat "\n"
77             (fill MetadataTypes.library_obj_tbl MetadataTypes.library_hits_tbl))
78       | `List -> print_endline (String.concat " " (List.map fst map))
79     end
80
81 let _ = main ()
82
83