[enhance] stdlib, database: Database command lines (look default opti…

…ons)

libruntime/serverArg.ml

@@ -1,5 +1,5 @@
 (*
-    Copyright © 2011 MLstate
+    Copyright © 2011, 2012 MLstate
 
     This file is part of OPA.
 
@@ -338,24 +338,23 @@ let extract_prefix pfx =
 (* ------------------------------------------------------------ *)
 (* Pre-defined parsers                                          *)
 (* ------------------------------------------------------------ *)
-let parse_addr =
-  let parse str =
-    let host,port = Base.String.split_char_last ':' str in
-    try
-      let portopt =
-        if port = "" then None
+let parse_addr_raw str =
+  let host,port = Base.String.split_char_last ':' str in
+  try
+    let portopt =
+      if port = "" then None
+      else
+        let p = int_of_string port in
+        if p < 0xffff then Some p
         else
-          let p = int_of_string port in
-          if p < 0xffff then Some p
-          else
-            failwith "Port number is too high: "
-      in
-      Some ((Unix.gethostbyname host).Unix.h_addr_list.(0), portopt)
-    with
-    | Failure s -> prerr_endline ("Error: invalid port. "^s^port); None
-    | Not_found -> prerr_endline ("Error: host not found: "^host); None
-  in
-  wrap_opt string parse
+          failwith "Port number is too high: "
+    in
+    Some ((Unix.gethostbyname host).Unix.h_addr_list.(0), portopt)
+  with
+  | Failure s -> prerr_endline ("Error: invalid port. "^s^port); None
+  | Not_found -> prerr_endline ("Error: host not found: "^host); None
+let parse_addr =
+  wrap_opt string parse_addr_raw
 
 
 (* ------------------------------------------------------------ *)

libruntime/serverArg.mli

@@ -1,5 +1,5 @@
 (*
-    Copyright © 2011 MLstate
+    Copyright © 2011, 2012 MLstate
 
     This file is part of OPA.
 
@@ -223,7 +223,9 @@ val extract_prefix: string -> args
   *)
 
 (** {6 A few useful pre-defined parsers} *)
+val parse_addr_raw: string -> (Unix.inet_addr * int option) option
 val parse_addr: (Unix.inet_addr * int option) param_parser
+
   (** Parses the syntax [host[:port]]. Resolves the host using the Unix module
       (fails if it is not found). *)
 

opabsl/mlbsl/badop_engine.ml

@@ -90,6 +90,27 @@ module A = ServerArg
 
 (* options parser *)
 
+##register set_default_local: string -> void
+let default_local = ref None
+let set_default_local (s:string) = default_local := Some s
+
+##register set_default_remote: string -> void
+let default_remote = ref None
+let set_default_remote (s:string) = default_remote := Some s
+
+let badop_default_local path = {
+  Badop.
+    path;
+  revision = None;
+  restore = None;
+  dot = false;
+  readonly = false;
+}
+
+let badop_default_client (host, port) =
+  let port = Option.default Badop_meta.default_port port in
+  Badop.Options_Client (Scheduler.default, (host, port), fun () -> `abort)
+
 let db_options =
   let arg_parser_dbgen = [
     ["--db-force-upgrade"],
@@ -106,10 +127,22 @@ let db_options =
     fun o -> A.wrap (parse o.engine_options) (fun bo -> { o with engine_options = bo })
   in
   let make_arg_parser ?name default =
-      arg_parser_dbgen @
-        List.map
-        (fun (arg,parse,params,help) -> arg, wrap_parser parse, params, help)
-        (Badop_meta.options_parser_with_default ?name default.engine_options)
+    let engine_options = match !default_local with
+      | Some s -> ((module Badop_client : Badop.S), Badop.Options_Local (badop_default_local s))
+      | None -> match !default_remote with
+        | Some s ->
+            begin match (ServerArg.parse_addr_raw s) with
+            | None ->
+                Logger.error "DbGen/Db3 Bad remote args %s" s;
+                exit 1
+            | Some x -> ((module Badop_local : Badop.S), badop_default_client x)
+            end
+        | None -> default.engine_options
+    in
+    arg_parser_dbgen @
+      List.map
+      (fun (arg,parse,params,help) -> arg, wrap_parser parse, params, help)
+      (Badop_meta.options_parser_with_default ?name engine_options)
   in
   (* association list (backend_opts -> db name) used to check for conflicts *)
   let parsed_engine_options = ref []
@@ -204,8 +237,7 @@ let client_options ident host_opt port_opt =
   let default_host = Unix.inet_addr_loopback in
   let host = match host_opt with None -> default_host | Some host ->
     try (Unix.gethostbyname host).Unix.h_addr_list.(0) with Not_found -> default_host in
-  let port = Option.default Badop_meta.default_port port_opt in
-  let o = Badop.Options_Client (Scheduler.default, (host, port), fun () -> `abort) in
+  let o = badop_default_client (host, port_opt) in
   db_options ident (m, o)
 
 ##register [restricted: dbgen; no-projection; opacapi] get: database_options -> t

stdlib/apis/mongo/mongo.opa

@@ -1,5 +1,5 @@
 /*
-    Copyright © 2011 MLstate
+    Copyright © 2011, 2012 MLstate
 
     This file is part of OPA.
 
@@ -393,6 +393,11 @@ MongoDriver = {{
     swe = send_with_error(m,mbuf,name,ns,slaveok)
     if Option.is_some(swe) && not(MongoCommon.reply_is_not_master(swe)) then {snderrresult=swe} else {reconnect}
 
+  check(m:Mongo.db) =
+    match SocketPool.get(m.pool) with
+    | ~{failure} -> ~{failure}
+    | {success=(_,c)} -> do SocketPool.release(m.pool, c) {success = m}
+
   @private
   srpool(m:Mongo.db,msg:Mongo.sr): Mongo.srr =
     match SocketPool.get(m.pool) with

stdlib/core/db/db.opa

@@ -1,5 +1,8 @@
 package stdlib.core.db
 
+import stdlib.core.args
+import stdlib.core.parser
+
 /**
  * {1 About this module}
  *
@@ -93,8 +96,40 @@ Db = {{
 
   get_engine(path:Db.path(_,_,'engine)):'engine = path.engine
 
+
+  /**
+   * {1 Private Utils}
+   */
+
   build(builder:Db.builder('a, 'b, 'c)):Db.path('a, 'b, 'c) = builder
 
+  default_cmdline =
+    CommandLine.filter({
+        title = "Default options for database"
+        init = none
+        anonymous = []
+        parsers = [
+          {CommandLine.default_parser with
+            names = ["--db-remote"]
+            description = "Use a remote database"
+            param_doc = "depending of backends"
+            on_param(_acc) =
+              parser l=(.*) -> {no_params = {some = {remote = some(Text.to_string(l))}}}
+          },
+          {CommandLine.default_parser with
+            names = ["--db-local"]
+            description = "Use a local database"
+            param_doc = "depending of backends"
+            on_encounter(_acc) =
+              {opt_params = { some ={local = none}} }
+            on_param(_acc) =
+              parser l=(.*) -> {no_params = {some = {local = some(Text.to_string(l))}}}
+          },
+        ]
+      })
+
+
+
 }}
 
 `<-` = Db.`<-`

stdlib/database/db3/db.opa

@@ -309,3 +309,10 @@ Transaction = {{
   }
   engine = db3path;
 }) : ref_path('a)
+
+@private _init_default_options = match Db.default_cmdline with
+  | {none} -> void
+  | {some = {local = {some = local}}} -> %%badop_engine.set_default_local%%(local)
+  | {some = {local = {none}}} -> %%badop_engine.set_default_local%%(%%BslFile.mlstate_dir%%(void))
+  | {some = {remote = {some = remote}}} -> %%badop_engine.set_default_remote%%(remote)
+  | {some = {remote = {none}}} -> %%badop_engine.set_default_remote%%("localhost")

stdlib/database/mongo/db.opa

@@ -401,11 +401,12 @@ Then use option --db-remote instead of --db-local.
         | seeds ->
           mdb = MongoReplicaSet.init(name, args.bufsize, args.poolsize, false/*allowslaveok*/, args.log, args.auth, seeds)
           match MongoReplicaSet.connect(mdb) with
-          | {success=(_/*slaveok*/,m)} -> {success=m}
+          | {success=(_/*slaveok*/,m)} -> MongoDriver.check(m)
           | {~failure} -> {~failure}
           end
       match connect() with
-      | {success = db} -> ~{db name cols=["default"]}
+      | {success = db} ->
+        ~{db name cols=["default"]}
       | ~{failure} ->
         do Log.error("DbGen/Mongo", "Error while opening database \"{name}\"\n{failure}")
         System.exit(1)
@@ -470,6 +471,13 @@ Then use option --db-remote instead of --db-local.
         )
         open_remote(name, default_remote, seed)
 
+    @private seeds_parser(name, f) =
+      auth_parser = parser user=((![:] .)+)[:] password=((![@] .)+) [@] ->
+       {user=Text.to_string(user); password=Text.to_string(password); dbname=name}
+      seed_parser = parser
+       | auth=auth_parser? host=((![:] .)*)[:] port={Rule.natural} ->
+         (auth, (Text.to_string(host), port))
+      parser seeds={Rule.parse_list(seed_parser, Rule.of_string(","))} -> f(seeds)
 
     open(name:string, host, port) =
       seed = (host ? "localhost", port ? 27017)
@@ -478,43 +486,55 @@ Then use option --db-remote instead of --db-local.
       | _ -> (":{name}", "\"{name}\"")
       args = CommandLine.filter({
         title = "Options for Mongo database {msg}"
-        init = { remote = default_remote }
+        init = none
         anonymous = []
         parsers = [
           {CommandLine.default_parser with
             names = ["--db-remote{suffix}"]
             description = "Use a remote mongo database(s), (default: {seed.f1}:{seed.f2})"
             param_doc = "[user:password@]host[:<port>][,[user:password@]host[:<port>]]*"
             on_param(acc) =
-              do jlog("Hello")
-              auth_parser = parser user=((![:] .)+)[:] password=((![@] .)+) [@] ->
-                {user=Text.to_string(user); password=Text.to_string(password); dbname=name}
-              seed_parser = parser
-                | auth=auth_parser? host=((![:] .)*)[:] port={Rule.natural} ->
-                  (auth, (Text.to_string(host), port))
-              parser seeds={Rule.parse_list(seed_parser, Rule.of_string(","))} ->
+              seeds_parser(name, (seeds ->
                 acc = match acc with
-                  | {remote = acc} -> acc
+                  | {some = {remote = acc}} -> acc
                   | _ -> default_remote
                 (auths,seeds) = List.unzip(seeds)
                 auths = List.filter_map((a -> a),auths)
-                do jlog("Parsing seeds {seeds} auths {auths}")
-                {no_params = {remote = {acc with seeds = List.append(acc.seeds, seeds); auth = List.append(acc.auth, auths)}}}
+                {no_params = {some = {remote = {acc with seeds = List.append(acc.seeds, seeds); auth = List.append(acc.auth, auths)}}}}
+              ))
           },
           {CommandLine.default_parser with
             names = ["--db-local{suffix}"]
             description = "Use a local mongo database, (default: {default_local()})"
             param_doc = "path"
             on_encounter(_acc) =
-              {opt_params = {local = {path = default_local()}}}
+              {opt_params = {some = {local = {path = default_local()}}}}
             on_param(_acc) =
-              parser path=(.*) -> {no_params = {local = {path = Text.to_string(path)}}}
+              parser path=(.*) -> {no_params = {some = {local = {path = Text.to_string(path)}}}}
           },
         ]
       })
-      match args with
-      | ~{remote} -> open_remote(name, remote, seed)
-      | ~{local} -> open_local(name, local, seed)
+      rec aux(args) =
+        match args with
+        | {some = ~{remote}} -> open_remote(name, remote, seed)
+        | {some = ~{local}} -> open_local(name, local, seed)
+        | {none} ->
+          match Db.default_cmdline with
+          | {none} -> open_remote(name, default_remote, seed)
+          | {some = {local = {none}}} -> open_local(name, {path = default_local()}, seed)
+          | {some = {local = {some = path}}} -> open_local(name, ~{path}, seed)
+          | {some = {remote = {some = remote}}} ->
+            Parser.try_parse(
+              seeds_parser(name, (seeds ->
+                  (auth,seeds) = List.unzip(seeds)
+                  auth = List.filter_map(x->x, auth)
+                  open_remote(name, {default_remote with ~seeds ~auth}, seed)))
+              , remote) ?
+              do Log.error("DbGen/Mongo", "Invalid --db-remote params for the database '{name}' (Mongo)")
+            System.exit(1)
+          | {some = {remote = {none}}} -> open_remote(name, default_remote, seed)
+      aux(args)
+
   }}
 
   open = Init.open