(* CLI *)
(* $Id: cli.ml,v 1.1 2004/10/26 09:44:54 berke Exp $ *)

open Ast
open Util
open Opt

(*** Make *)
module Make(Dpkg : Dpkg.DB) =
  struct
    module Ara = Ara.Make(Dpkg)
    module Dump = Dump.Make(Dpkg)
    open Dpkg
    open Dump
    open Ara

    exception Quit;;

    let database = new Publication.magazine;;
    let database_subscription = database#subscribe ();;

    (*** memory *)
    let memory () =
      let (miw,prw,maw) = Gc.counters () in
      (miw +. maw -. prw) /. 1000000.0
    ;;
    (* ***)
    (*** load_database, reload_database *)
    let load_database ?(after = fun _ -> ()) paths =
       try
         let dbfns = Dpkg.find_database_files paths in
         if !Opt.progress then Printf.printf "Loading...";
         let progress =
           if !Opt.progress then
             let last = ref 0.0 in
             fun fn count ->
               let t = Unix.gettimeofday () in
               if t > !last +. 0.5 then
                 begin
                   Printf.printf "\rLoaded %d packages (processing %-40s)%!"
                    count
                    ("\""^(limit 38 (String.escaped (Filename.basename fn)))^"\"");
                   last := t
                 end
               else
                 ()
           else
             fun _ _ -> ()
         in
         let db' = Dpkg.load ~fast:!Opt.fast ~progress dbfns in
         if !Opt.progress then Printf.printf "\nTotal %d packages...\n%!" (Dpkg.get_count db');
         database#publish `Everyone db';
         after db'
       with
       | x -> Printf.printf "\nCould not load database: %s. Try: apt-get update\n" (Printexc.to_string x)
    ;;

    let database_paths () =
      let k = "ara.database.paths" in
      Configfile.to_list
        (Configfile.to_pair Configfile.to_string Configfile.to_string)
        ~k
        (Config.current#get k)
    ;;

    let reload_database () =
      Printf.printf "Reloading database...\n%!";
      load_database (database_paths ())
    ;;
    (* ***)
    (*** error display *)
    let put_arrows i j =
      for h = 1 to i do
        print_char ' '
      done;
      for h = i to j do
        print_char '^';
      done;
      print_char '\n'
    ;;

    let heap_compaction() = 
      let (rsz1,vsz1) = Util.proc_get_rsz_vsz () in
        Printf.printf "Starting heap compaction...\n%!";
        Gc.compact ();
        let (rsz2,vsz2) = Util.proc_get_rsz_vsz () in
        Printf.printf "Compaction saved %d resident and %d virtual pages.\n"
        (rsz1 - rsz2) (vsz1 - vsz2)
    ;;    

    let show_highlighted out w i j n =
      let m = String.length w in
      let j = max 0 (min (m - 1) j) in
      let b = min (n / 3) (j - i + 1) in
      let ps = min (m - b) (n - b) in
      let s = min (m - j - 1) ((ps + 1) / 2) in
      let p = min i (ps - s) in
      let s = min (m - j - 1) (ps - p) in
      let p_i = i - p in
      let hi_i =
        if p_i > 0 then
          begin
            out "...";
            out (String.sub w p_i p);
            p + 3
          end
        else
          begin
            out (String.sub w 0 p);
            p
          end
      in
      if b < j - i + 1 then
        begin
          let b' = b - 3 in
          let bl = b' / 2 in
          let br = b' - bl
          in
          out (String.sub w i bl);
          out "...";
          out (String.sub w (j - br) br)
        end
      else
        out (String.sub w i b);
      if j + 1 + s < m then
        begin
          out (String.sub w (j + 1) s);
          out "..."
        end
      else
        out (String.sub w (j + 1) s);
      out "\n";
      put_arrows hi_i (hi_i + b - 1)
    ;;

    let escape_and_record_indexes w l =
      let m = String.length w in
      let b = Buffer.create m in
      let r = ref [] in
      for i = 0 to m - 1 do
        if List.mem i l then
          r := (i,Buffer.length b)::!r;
        Buffer.add_string b (String.escaped (String.make 1 w.[i]))
      done;
      if List.mem m l then
        r := (m,Buffer.length b)::!r;
      (Buffer.contents b,!r)
    ;;

    let lower_half x = x / 2
    let upper_half x = x - (x / 2)

    let show_parse_error i j x w =
      let m = String.length w in
      if m = 0 then
        Printf.printf "Error: Syntax error -- Empty query.\n"
      else
        begin
            Printf.printf "Error: Syntax error %s of query --- %s:\n"
              (if i = j then 
                if i >= m - 1 then
                  "end"
                else
                  sf "at character %d" (i + 1)
               else "between "^
               (if i = 0 then "beginning" else sf "character %d" (i + 1))^
               " and "^
               (if j >= m - 1 then "end" else sf "character %d" (j + 1)))
              x;
            let (w',z) = escape_and_record_indexes w [i;j] in
            let m = String.length w'
            and i' = List.assoc i z
            and j' = List.assoc j z
            in
            (* show string w' highlighting i' to j' on columns columns *)
            let w' = if j' >= m - 1 then w'^" " else w' in
            show_highlighted print_string w' i' j' !Opt.columns
          end
    ;;
    (* Error display ***)

    module SM = Map.Make(String);;
    exception Variable_not_found of string;;

    (*** compute_interactive_command *)
    let compute_interactive_command cmd =
      let runi = Config.current#get_string "ara.commands.run_interactive_command" in
      Util.substitute_variables ["COMMAND",cmd] runi
    ;;
    (* ***)
    (*** eval *)
    let eval db env q w =
      let pl = Ara.compute_query db
        ~get:(fun id ->
          try
            let (_,r,_) = SM.find id !env in r
          with
          | Not_found -> raise (Variable_not_found id))
        ~set:(fun id r s1 s2 q ->
          let w' =
            try
              String.sub w s1 (s2 - s1)
            with
            | _ -> sf "??? %d,%d" s1 s2
          in
          env := SM.add id (w',r,q) !env)
      q
      in
      pl
    ;;
    (* ***)
    (*** yes_no *)
    let yes_no msg =
      flush stdout;
      let p = Ledit.get_prompt () in
      Ledit.set_prompt msg;
      let rec loop () =
        let u = Ledit.read_line () in
        match String.lowercase u with
        | "y"|"yes" -> `Yes
        | "n"|"no" -> `No
        | _ ->
            Printf.printf "Please answer YES or NO.\n";
            loop ()
      in
      let ans = loop () in
      Ledit.set_prompt p;
      ans
    ;;
    (* ***)
    (*** process *)
    exception Sorry of string;;

    let process db env ?(output=`Stdout) ?(interactive=false) (style,fields,q,w) =
      let count = ref 0 in
      let show_count = ref true in
      let with_result f =
        let rec once db =
          let xl = eval db env q w in
          let xl = if !Opt.coalesce then Ara.filter_old_versions db xl else xl in
          count := List.length xl;
          match q with
          | Ast.Assign(id,_,_,_) ->
              Printf.printf "%s: %d packages.\n" id !count;
              show_count := false
          | _ ->
            let xl = List.sort (fun i j -> compare (name_of db i) (name_of db j)) xl in
            if xl = [] then
              Printf.printf "(No packages).\n"
            else
              f db xl
        in
        try
          database_subscription#with_last_issue once
        with
        | Virtual_strings.File_out_of_date(fn) ->
            Printf.printf "File %S changed.\n" fn;
            reload_database ();
            database_subscription#with_last_issue once
      in
        try
          let oc =
            match output with
            | `Print ->
                 let cmd = Config.current#get_string "ara.commands.print" in
                 Unix.open_process_out cmd
            | `Stdout -> stdout
            | `New f ->
              begin
                try
                  let st = Unix.stat f in
                  match st.Unix.st_kind with
                  | Unix.S_REG -> raise (Sorry(sf "File %S already exists. (Try >> or >|)." f))
                  | _ -> open_out f
                with
                | Unix.Unix_error(Unix.ENOENT,_,_) -> open_out f
                | x -> raise x
              end
            | `Overwrite f -> open_out f
            | `Append f -> open_out_gen [Open_append;Open_creat] 0o644 f
          in
          let wrapper w =
            if !Opt.wrap then
              new Wrap.word_wrapper ~columns:!Opt.columns w
            else
              new Wrap.word_non_wrapper ~columns:!Opt.columns w
          in
          let dont_page f = f (wrapper (new Wrap.writer_of_output_channel oc)) in
          let page_if_necessary f =
            if output = `Stdout & !Opt.use_pager & interactive then
              begin
                let w = new Wrap.counter in
                f (wrapper w);
                if w#row >= !Opt.rows then
                  Pager.call (fun oc -> f (wrapper (new Wrap.writer_of_output_channel oc)))
                else
                  dont_page f
              end
            else
              dont_page f
          in
          try
            begin
              match style with
              | `Install|`Remove -> with_result (fun db xl ->
                  let remove = style = `Remove in
                  show_count := false;
                  let xl = if !Opt.coalesce then xl else Ara.filter_old_versions db xl in
                  let m = List.length xl in
                  let w = new Wrap.counter in
                  let ww = new Wrap.word_wrapper ~columns:!Opt.columns w in
                  Dump.bourbaki_dump ww ~versions:true db xl;
                  if w#row + 1 > !Opt.rows then
                    begin
                      Printf.printf "You have asked to %s %d package%s.\n"
                        (if remove then "remove" else "install")
                        m
                        (if m = 1 then "" else "s");
                      if `Yes = yes_no
                         "Would you like to view a list of these packages ? (yes/no) " then
                         begin
                           Pager.call (fun oc ->
                             let w = new Wrap.writer_of_output_channel oc in
                             let ww = new Wrap.word_wrapper ~columns:!Opt.columns w in
                             bourbaki_dump ww ~versions:true db xl)
                         end
                      else
                        ()
                    end
                  else
                    begin
                      Printf.printf "Are you sure you want to %s the following package%s ?\n"
                        (if remove then "remove" else "install")
                        (if m = 1 then "" else "s");
                      let w = new Wrap.writer_of_output_channel stdout in
                      let ww = new Wrap.word_wrapper ~columns:!Opt.columns w in
                      bourbaki_dump ww ~versions:true db xl
                    end;
                  if `No = yes_no (sf "%s packages ? (yes/no) "
                    (if remove then "Remove" else "Install")) then
                    Printf.printf "Very well.\n"
                  else
                    List.iter (fun i ->
                      let pn = Dpkg.name_of db i
                      and pv = Dpkg.version_of db i
                      in
                      let cmd = Util.substitute_variables
                        ["PACKAGE",pn; "VERSION",pv]
                        (if remove then
                          Config.current#get_string "ara.commands.remove"
                        else
                          Config.current#get_string "ara.commands.install")
                      in
                      let icmd = compute_interactive_command cmd in
                      let rc = Sys.command icmd in
                      if rc <> 0 then
                        Printf.printf "%s of %S (%S) failed with code %d.\n"
                          (if remove then "Removal" else "Installation")
                          pn pv rc
                      else
                        Printf.printf "%s of %S (%S) succeeded.\n"
                          (if remove then "Removal" else "Installation")
                          pn pv) xl)
              | `Bourbaki ->
                  with_result (fun db xl ->
                    page_if_necessary (fun ww ->
                      Dump.bourbaki_dump ww ~versions:(not !Opt.coalesce) db xl))
              | `List ->
                  with_result (fun db xl ->
                    page_if_necessary (fun ww ->
                      Dump.list_dump ww ~versions:(not !Opt.coalesce) db xl))
              | `Raw ->
                  with_result (fun db xl ->
                    page_if_necessary (fun ww ->
                      Dump.raw_dump ww db fields xl))
              | `Table -> with_result (fun db xl ->
                  if output = `Stdout & !Opt.use_pager & interactive then
                    begin
                      let w = new Wrap.counter in
                      table_dump w db fields ~borders:!Opt.borders xl;
                      if w#row + 1 >= !Opt.rows then
                        Pager.call (fun oc ->
                          let w = new Wrap.writer_of_output_channel oc in
                          table_dump w db fields ~borders:!Opt.borders xl)
                      else
                        let w = new Wrap.writer_of_output_channel stdout in
                        table_dump w db fields ~borders:!Opt.borders xl
                    end
                  else
                    let w = new Wrap.writer_of_output_channel oc in
                    table_dump w db fields ~borders:!Opt.borders xl)
              | `Count -> with_result (fun db xl ->
                  show_count := false;
                  Printf.fprintf oc "%d\n" (List.length xl))
              | `Ast ->
                Ast.dump Format.err_formatter q;
                Format.fprintf Format.err_formatter "@?"
            end;
            match output with
            | `Stdout -> ()
            | `Print ->
               begin
                 match Util.string_of_process_status "Printing" (Unix.close_process_out oc)
                 with
                 | None -> ()
                 | Some x -> Printf.printf "%s\n" x
               end
            | _ -> close_out oc
          with
          | x ->
              if output <> `Stdout then close_out oc;
              raise x
        with
        | Sorry(x) -> Printf.printf "Sorry: %s\n" x
        | Virtual_strings.File_out_of_date(fn) ->
            Printf.printf "The database file %S has changed.  Please type #reload.\n" fn
        | Unix.Unix_error(ue,x,y) ->
           Printf.printf "Error: %s (%S, %S).\n"
             (Unix.error_message ue) x y
        (*| x -> Printf.printf "Error: %s\n" (Printexc.to_string x)*)
    ;;
    (* ***)
    (*** toplevel *)
    let toplevel ?(catcher=(fun x -> raise x)) f =
      Ledit.init ();
      if !Opt.save_history then 
        begin
          Config.current#ensure_directory_presence;
          Ledit.open_histfile false (Config.current#path "history");
        end;
      Ledit.set_max_len !Opt.columns;
      Ledit.set_prompt "& ";
      Printf.printf "Welcome to ara version %s released on %s.\n" Version.version Version.date;
      Printf.printf "Type ? for help and Ctrl-D or #quit to exit.\n";
      let bye () = if !Opt.save_history then Ledit.close_histfile ()
      in
      let rec loop () =
        try
          while true do
            flush stdout;
            let w = Ledit.read_line () in
            if w <> "" then f w
          else
            ()
          done
        with
        | End_of_file -> Printf.printf "\nEOF.\n%!"; bye ()
        | Quit -> bye ()
        | x -> if catcher x then loop () else bye ()
      in
      loop ()
    ;;
    (* ***)
    (*** Interactive *)

    exception Bad_field of string;;

    let parse_fieldspec db w =
      let fd = Opt.initial_parse_fieldspec w in
      match fd with
      | All -> fd
      | These l ->
          List.iter (fun (f,_) ->
            try
              ignore (Dpkg.field_of_string db (String.lowercase f))
            with
            | Not_found -> raise (Bad_field f)) l;
          fd
    ;;

    (* Command parsing is not elegant and sucks. *)
    module Interactive =
      struct
        let style : Opt.style ref = ref `Bourbaki
        let fields = Opt.fields

        let type_help_for_help () =
          Printf.printf "Type #help for help.\n"

        let bad_syntax = once type_help_for_help;;
        let unknown_directive = once type_help_for_help;;

        let option_keywords =
          List.map (fun (x,y,z) ->
            if x <> "" && x.[0] = '-' then
              String.sub x 1 (String.length x - 1)
            else
              x) Opt.cli_specs
        ;;

        let catcher x =
          begin
            match x with
            | Bad_field(f) -> Printf.printf "Error: unknown field %S.\n" f
            | Unix.Unix_error(ue,x,y) ->
               Printf.printf "UNIX error: %s (%S, %S).\n"
                 (Unix.error_message ue) x y
            | x ->
                Printf.printf "Error: %s\n" (Printexc.to_string x);
                if !Opt.raise_exceptions then raise x
          end;
          true

        let do_command nm vr =
          let icmd = compute_interactive_command (Config.current#get_string vr) in
          let rc = Sys.command icmd in
          if rc <> 0 then
            Printf.printf "APT %s failed with code %d.\n" nm rc
          else
            Printf.printf "APT %s succeeded.\n" nm
        ;;

        let show_memory () =
          let pgsz = Config.current#get_int ~default:4096 "ara.misc.page_size" in
          let (rsz,vsz) = Util.proc_get_rsz_vsz () in
          Printf.printf "Memory usage is %d pages virtual, %d pages resident.\n\
                         With a page size of %d bytes this gives %.1fMiB virtual \
                         and %.1fMiB resident.\n\
                         Approximatively %.1f million words have been allocated.\n\
                         Current backend: %s\n"
                         rsz vsz
                         pgsz
                         ((float pgsz) *. (float rsz) /. 1048576.0)
                         ((float pgsz) *. (float vsz) /. 1048576.0)
                         (memory ())
                         Dpkg.backend
        ;;

        (*** directive *)
        let rec directive db env ?(output=`Stdout) w =
          let with_style st fd v =
            if v <> "" && not (Util.for_all_chars Util.is_space v) then
              let style',fields' = !style,!fields in
              Util.wind
                (fun () -> style := st; fields := fd; interactive env ~output v) ()
                (fun () -> style := style'; fields := fields') ()
            else
              begin
                style := st;
                fields := fd;
                Printf.printf "Default output style set to %s with %s.\n"
                  (match st with
                   | `Bourbaki -> "Bourbaki"
                   | `List -> "list"
                   | `Raw -> "raw"
                   | `Table -> "table"
                   | `Count -> "count"
                   | `Ast -> "ast"
                   | `Install -> "install"
                   | `Remove -> "install")
                  (match fd with
                  | All -> "all fields"
                  | These(l) ->
                      if l = [] then
                        "NO fields"
                      else
                        "these fields: "^(String.concat ","
                          (List.map (function
                            | (f,None) -> f
                            | (f,Some x) -> sf "%s:%d" f x) l)))
              end
          in
          let (u,v) = Util.split_once_at is_space w in
          match u with
          | "#syntax" -> Pager.page Help.syntax
          | "#help" -> Pager.page_if_necessary Help.cli_help
          | "#examples" -> Pager.page_if_necessary Help.cli_examples
          | "#shell" ->
              begin
                try
                  let v = Util.remove_leading_spaces v in
                  let v =
                    if v = "" then
                      try
                        Sys.getenv "SHELL"
                      with
                      | Not_found -> "/bin/sh"
                    else
                      v
                  in
                  let rc = Sys.command v in
                  if rc <> 0 then Printf.printf "Command returned code %d.\n" rc
                with
                | x -> Printf.printf "Command failed: %s.\n" (Printexc.to_string x)
              end
          | "#about" -> print_string Help.about
          | "#version" ->
              Printf.printf "This is ara version %s released on %s.\n"
                Version.version
                Version.date
          | "#reload" -> reload_database ()
          | "#short"|"#bourbaki" -> with_style `Bourbaki !fields v
          | "#list" -> with_style `List !fields v
          | "#raw"|"#show" -> with_style `Raw !fields v
          | "#memory" -> show_memory ()
          | "#memorystats" -> Gc.print_stat stdout
          | "#print" -> interactive env ~output:`Print v
          | "#compact" -> heap_compaction()
          | "#fields" ->
              begin
                let (v1,v2) = Util.split_once_at is_space v in
                let v1 = Util.remove_leading_spaces v1 in
                if v1 = "" then
                  with_style !style !fields v2
                else
                  let fd = parse_fieldspec db v1 in
                  with_style !style fd v2
              end
          | "#all" -> with_style `Raw All v
          | "#ast" -> with_style `Ast !fields v
          | "#table"|"#tabular" -> with_style `Table !fields v
          | "#count" -> with_style `Count !fields v
          | "#install" -> with_style `Install !fields v
          | "#remove" -> with_style `Remove !fields v
          | "#quit"|"#q"|"#bye" -> raise Quit
          | "#update" -> do_command "update" "ara.commands.update";
              reload_database();
              heap_compaction()
          | "#upgrade" -> do_command "upgrade" "ara.commands.upgrade"
          | "#dist-upgrade" -> do_command "dist-upgrade" "ara.commands.dist_upgrade"
          | "#set" ->
            let options = ref [] in
            let current = ref 0 in
            let a = Array.of_list ("CLI"::(Util.parse_strings v)) in
            let help_string =
              "Type #set [options].  The syntax is the same as when calling ara \
               from the shell.  Dashes preceding keywords may be omitted."
            in
            begin
              try
                let qb = Buffer.create 16 in
                Opt.queries := [];
                Arg.parse_argv
                  ~current a Opt.cli_specs
                  (fun w -> options := (if List.mem w option_keywords then "-"^w else w)::!options)
                  help_string;
                if !options <> [] then
                  begin
                    let a' = Array.of_list ("CLI"::(List.rev !options)) in
                    current := 0;
                    Arg.parse_argv
                      ~current
                      a'
                      Opt.cli_specs
                      (fun w ->
                        Buffer.add_char qb ' ';
                        Buffer.add_string qb w)
                      (* Printf.printf "Error: Unexpected option %S.\n" w) *)
                      help_string;
                  end
                else
                  ();
                let w = Buffer.contents qb in
                let q = !Opt.queries in
                if not (Util.for_all_chars Util.is_space w) then
                  interactive env ~output w
                else
                  ();
                List.iter (fun (style,fields,w) ->
                  interactive_statement db env ~output style fields w) !Opt.queries;
              with
              | Arg.Bad(x) -> print_string ((first_line x)^"\n"); (* hack *)
              | Arg.Help(x) -> print_string x
              | x -> raise x (* Printf.printf "Error: %s\n" (Printexc.to_string x) *)
            end
          | x ->
              Printf.printf "Unknown directive %S.\n" x;
              unknown_directive ()
        (* directive ***)
        (*** interactive *)
        and interactive env ?(output=`Stdout) (w : string) =
          database_subscription#with_last_issue (fun db ->
          let w = Util.remove_leading_spaces w in
          if w <> "" then
            if w.[0] = '>' then
              if String.length w > 1 then
                if is_space w.[1] or (w.[1] <> '|' && w.[1] <> '>') then
                  let w = Util.delete_first_chars 1 w in
                  let w = Util.remove_leading_spaces w in
                  let (u,v) = Util.split_once_at is_space w in
                  interactive env ~output:(`New u) v
                else
                  if w.[1] = '|' then
                    let w = Util.delete_first_chars 2 w in
                    let w = Util.remove_leading_spaces w in
                    let (u,v) = Util.split_once_at is_space w in
                    interactive env ~output:(`Overwrite u) v
                  else
                    if w.[1] = '>' then
                      let w = Util.delete_first_chars 2 w in
                      let w = Util.remove_leading_spaces w in
                      let (u,v) = Util.split_once_at is_space w in
                      interactive env ~output:(`Append u) v
                    else
                      Printf.printf "Bad redirection.\n"
              else
                Printf.printf "Bad redirection.\n"
            else
              if w.[0] = '#' then directive db env ~output w
              else
                if w.[0] = '?' then
                  Pager.page_if_necessary Help.cli_help
                else
                  interactive_statement db env ~output !style !fields w
          else
            ())
        (* ***)
        (*** interactive_statement *)
        and interactive_statement db env ?(output=`Stdout) style fields w =
          let q =
            try
              Some(statement_of_string w)
            with
            | Parse_error(i,j,x) ->
              show_parse_error i j x w;
              bad_syntax ();
              flush stdout;
              None
            | x -> Printf.printf "Error: %s.\n" (Printexc.to_string x); None
          in
          match q with
          | None -> ()
          | Some(q) ->
              try
                process db env ~output ~interactive:true (style,fields,q,w)
              with
              | Variable_not_found(x) -> Printf.printf "Error: variable %S not found.\n" x
              (*| x -> Printf.printf "An uncaught exception occurred: %s\n"
                       (Printexc.to_string x) XXX *)
        (* ***)
      end
    ;;
    (* ***)
          let main () =
              List.iter (fun (fn,ex) ->
                if fn <> !Opt.config_file or
                   (!Opt.user_specified_config_file & fn = !Opt.config_file) or
                   (match ex with Sys_error(_) -> false | _ -> true)
                then
                  Printf.printf "Error loading config file %S: %s.\n" fn (Printexc.to_string ex))
                (Config.load ());

              let queries' =
                List.map (fun (style,fields,w) ->
                  try
                    let q = statement_of_string w in
                    if !Opt.ast then
                      begin
                        Ast.dump Format.err_formatter q;
                        Format.fprintf Format.err_formatter "@.";
                      end;
                    (style,fields,q,w)
                  with
                  | Parse_error(i,j,x) ->
                      show_parse_error i j x w;
                      exit 1) !Opt.queries
              in
              if queries' = [] && not !Opt.interactive then
                begin
                  print_string "Error: No queries given and -interactive option not set; \
                                try -help or -examples.\n";
                  exit 1
                end
              else
                load_database (database_paths ());
                if !Opt.interactive then
		     heap_compaction();
                let env = ref SM.empty in
                database_subscription#with_last_issue (fun db' ->
                  List.iter (process db' env) queries';
                  if !Opt.interactive then Opt.parse_fieldspec := parse_fieldspec db');
                if !Opt.interactive then
                  toplevel
                    ~catcher:Interactive.catcher
                    (fun w -> Interactive.interactive env w)
                else
                  ()
          ;;
end
(* ***)
(*** Main *)
let _ =
  Arg.parse Opt.specs
    Opt.add_query
    (Printf.sprintf "Usage: %s <options or queries ...>" Sys.argv.(0));
  if !Opt.very_slow then
    let module M = Make(Dpkg.DBFS) in
    M.main ()
  else
    let module M = Make(Dpkg.DBRAM) in
    M.main ()
;;

(* Main ***)
