(* Driver for dbtool *)
+fun badArgs () =
+ print "Invalid command-line arguments. See documentation at:\n\thttp://wiki.hcoop.net/MemberManual/Databases\n"
+
val _ =
case CommandLine.arguments () of
- [] => print "Invalid command-line arguments\n"
+ [] => badArgs ()
| dbtype :: rest =>
case Dbms.lookup dbtype of
NONE => print ("Unknown database type " ^ dbtype ^ ".\n")
- | _ =>
+ | SOME {getpass, ...} =>
case rest of
- ["adduser"] => Main.requestDbUser dbtype
+ ["adduser"] =>
+ let
+ val pass = case getpass of
+ NONE => SOME NONE
+ | SOME f =>
+ case f () of
+ Client.Passwd pass => SOME (SOME pass)
+ | Client.Aborted => SOME NONE
+ | Client.Error => NONE
+ in
+ case pass of
+ NONE => ()
+ | SOME pass => Main.requestDbUser {dbtype = dbtype, passwd = pass}
+ end
+ | ["passwd"] =>
+ let
+ val pass = case getpass of
+ NONE => NONE
+ | SOME f =>
+ case f () of
+ Client.Passwd pass => SOME pass
+ | _ => NONE
+ in
+ case pass of
+ NONE => ()
+ | SOME pass => Main.requestDbPasswd {dbtype = dbtype, passwd = pass}
+ end
| ["createdb", dbname] =>
if Dbms.validDbname dbname then
- Main.requestDbTable {dbtype = dbtype, dbname = dbname}
+ Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = NONE}
+ else
+ print ("Invalid database name " ^ dbname ^ ".\n")
+ | ["createdb", dbname, encoding] =>
+ if not (Dbms.validDbname dbname) then
+ print ("Invalid database name " ^ dbname ^ ".\n")
+ else if not (Dbms.validEncoding (SOME encoding)) then
+ print ("Invalid encoding name " ^ encoding ^ ".\n")
+ else
+ Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = SOME encoding}
+ | ["dropdb", dbname] =>
+ if Dbms.validDbname dbname then
+ Main.requestDbDrop {dbtype = dbtype, dbname = dbname}
+ else
+ print ("Invalid database name " ^ dbname ^ ".\n")
+ | ["grant", dbname] =>
+ if Dbms.validDbname dbname then
+ Main.requestDbGrant {dbtype = dbtype, dbname = dbname}
else
print ("Invalid database name " ^ dbname ^ ".\n")
- | _ => print "Invalid command-line arguments\n"
+ | _ => badArgs ()