Parse uri

cl-mongo.asd

@@ -13,8 +13,10 @@
   :depends-on (:uuid
 	       :babel
 	       :bordeaux-threads
+	       :cl-ppcre
 	       :documentation-template
 	       :lisp-unit
+	       :metabang-bind
 	       :parenscript
 	       :split-sequence
 	       :usocket)

src/mongo.lisp

@@ -53,6 +53,17 @@ Each connection is a added to a global registry."))
                      (db *mongo-default-db*) (name (gensym)))
   (make-instance 'mongo :host host :port port :db db :socket nil :name name))
 
+(defun parse-mongo-uri (uri &optional (name :default))
+  (bind (((:values _ results)
+          (ppcre:scan-to-strings "^mongo(db)?://(([^:]+):([^@]+)@)?([^:/]+)(:([0-9]+))?(/(.*)$)?" uri))
+         (#(_ auth? username password host _ port _ db) results))
+    (apply #'make-mongo (append
+                         (list :name name)
+                         (if host (list :host host))
+                         (if port (list :port (parse-integer port)))
+                         (if db (list :db db))))
+    (if auth? (db.auth username password))))
+
 (defmethod print-object ((mongo mongo) stream)
   (format stream "(type-of ~S) [name : ~A ] ~% {[id : ~A] [port : ~A] [host : ~A] [db : ~A]} ~%"
           (type-of mongo)

src/packages.lisp

@@ -1,7 +1,7 @@
 (in-package #:cl-user)
 
 (defpackage #:cl-mongo
-  (:use #:common-lisp #:babel #:uuid #:usocket)
+  (:use #:common-lisp #:babel #:uuid #:usocket #:bind)
   (:export
 
    ;;
@@ -20,6 +20,7 @@
    :get-keys
 
    ;;commands
+   :parse-mongo-uri
    :mongo
    :mongo-registered
    :mongo-show

test/regression.lisp

@@ -541,6 +541,28 @@
   (dolist (size (geometric-range 2 4))  
     (db.find-selector-regression :collection collection :size size)))
 
+;;--------------------------------------------------------------------------
+
+(defun test-uri-parsing (uri host port db)
+  (let ((name (gensym)))
+	(ignore-errors
+	  (parse-mongo-uri uri name))
+	(let ((connection (mongo :name name)))
+	  (assert-equal host (cl-mongo::host connection))
+	  (assert-equal port (cl-mongo::port connection))
+	  (assert-equal db (cl-mongo::db connection)))
+	(with-output-to-string (*standard-output*)
+	  (mongo-close name))))
+
+(define-test uri-parsing
+  "This tests a variety of URIs (but doesn't test username/password)"
+  (test-uri-parsing "mongodb://foo1.bar:123/baz1" "foo1.bar" 123 "baz1")
+  (test-uri-parsing "mongo://foo2.bar:234/baz2" "foo2.bar" 234 "baz2")
+  (test-uri-parsing "mongodb://foo3.bar/baz3" "foo3.bar" *mongo-default-port* "baz3")
+  (test-uri-parsing "mongodb://foo4.bar:345" "foo4.bar" 345 *mongo-default-db*)
+  (test-uri-parsing "mongodb://foo5.bar" "foo5.bar" *mongo-default-port* *mongo-default-db*)
+  (test-uri-parsing "mongodb://user6:pass6@foo6.bar:456/baz" "foo6.bar" 456 "baz"))
+
 ;;;;;;;;;;;;;