open Dbf_sql.SQL_db
open Dbf_sql
type mode = Gencode | Convert of Dbf_old.dbms
let indexes_of_table = fun t ->
List.filter (fun i -> (table_of_index i) == t)
let indexes_of_vtable = fun t ->
List.filter
(fun i ->
((table_of_index i) == t.vt_ftable ||
(List.exists (fun (t, _) -> (table_of_index i) == t) t.vt_join)))
let remove_prefix pref s =
let lenp = String.length pref in
let len = String.length s in
if len <= lenp then
s
else
(if String.lowercase (String.sub s 0 lenp) =
String.lowercase pref
then
String.sub s lenp (len - lenp)
else
s
)
let usage = Printf.sprintf "Usage: %s [options] <file>\n" Sys.argv.(0)
let in_file = ref None
let out_file = ref None
let mode = ref Gencode
let remove_table_prefix = ref None
let conversions =
[ "mysql", Dbf_old.Mysql ;
"postgres", Dbf_old.Postgres ;
"odbc", Dbf_old.Odbc ;
]
let convert_options = List.map
(fun (s,t) ->
Printf.sprintf "--conv-%s" s, Arg.Unit (fun () -> mode := Convert t),
Printf.sprintf "\tconvert Cameleon1-DBForge file to new format using %s information" s;
)
conversions
let options = [
"--version",
Arg.Unit (fun () -> print_endline Dbf_installation.software_version; exit 0),
"\tprint version and exit" ;
"-o", Arg.String (fun s -> out_file := Some s),
"file\twrite to file instead of standard output" ;
"--remove-table-prefix", Arg.String (fun s -> remove_table_prefix := Some s),
"<prefix>\n\t\tremove this prefix from table names to get (simpler) module names" ;
] @ convert_options
let convert_from_old file t =
let old = Dbf_old.read file in
Dbf_old.convert_to_db old t
let main () =
Arg.parse options
(fun s ->
match !in_file with
None -> in_file := Some s;
| Some f -> failwith usage
)
(usage^"where options are:");
let in_file =
match !in_file with
None -> failwith usage
| Some f -> f
in
let out =
match !out_file with
None -> stdout
| Some file -> open_out file
in
begin
match !mode with
Gencode ->
let db = Dbf_sql_io.db_of_file in_file in
flush stdout;
if List.exists (fun t -> t.ta_logged) db.db_tables then
Printf.fprintf out "\nlet log_who : (unit -> Dbf_sql_misc.log_who) ref = ref (fun () -> 0)\n\n";
List.iter
(fun table ->
let idxes = indexes_of_table table db.db_indexes in
let module_name =
match !remove_table_prefix with
None -> String.capitalize table.ta_name
| Some s ->
String.capitalize
(remove_prefix s table.ta_name)
in
Dbf_sql_gen.print (table, module_name, idxes) out)
db.db_tables;
List.iter
(fun vtable ->
let idxes = indexes_of_vtable vtable db.db_indexes in
Dbf_sql_vgen.print (vtable, idxes) out)
db.db_vtables;
Printf.fprintf out
"\nmodule Queries = functor (Sql : Dbf_sql_driver.SqlDriver) -> struct\n";
List.iter
(fun query ->
Dbf_sql_qgen.print query out)
db.db_queries;
Printf.fprintf out "end\n"
| Convert t ->
let db = convert_from_old in_file t in
output_string out (Xml.to_string_fmt (Dbf_sql_io.xml_of_db db))
end;
close_out out
let safe_main main =
try main ()
with
Failure s
| Sys_error s ->
prerr_endline s;
exit 1
let _ = safe_main main