Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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

…ons)
  • Loading branch information...
commit 42a5f0bd8e2df5ee82bfa3718e58ada6197cbb38 1 parent 4c8ab4c
Quentin Bourgerie BourgerieQuentin authored
35 libruntime/serverArg.ml
View
@@ -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
(* ------------------------------------------------------------ *)
4 libruntime/serverArg.mli
View
@@ -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). *)
44 opabsl/mlbsl/badop_engine.ml
View
@@ -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
7 stdlib/apis/mongo/mongo.opa
View
@@ -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
35 stdlib/core/db/db.opa
View
@@ -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.`<-`
7 stdlib/database/db3/db.opa
View
@@ -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")
56 stdlib/database/mongo/db.opa
View
@@ -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,7 +486,7 @@ 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
@@ -486,35 +494,47 @@ Then use option --db-remote instead of --db-local.
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
Please sign in to comment.
Something went wrong with that request. Please try again.