diff --git a/cl-mongo.asd b/cl-mongo.asd index 06e70dc..e0055d1 100644 --- a/cl-mongo.asd +++ b/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) diff --git a/src/mongo.lisp b/src/mongo.lisp index 1ca2164..bab755b 100644 --- a/src/mongo.lisp +++ b/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) diff --git a/src/packages.lisp b/src/packages.lisp index 82ade25..2b9bb81 100644 --- a/src/packages.lisp +++ b/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 diff --git a/test/regression.lisp b/test/regression.lisp index c54aea5..26579d2 100644 --- a/test/regression.lisp +++ b/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")) + ;;;;;;;;;;;;;