diff options
| -rw-r--r-- | Makefile | 11 | ||||
| -rw-r--r-- | routes.asd | 14 | ||||
| -rw-r--r-- | scgi-routes.asd | 28 | ||||
| -rw-r--r-- | src/package.lisp | 3 | ||||
| -rw-r--r-- | src/routes.lisp | 13 | ||||
| -rw-r--r-- | tests/package.lisp | 3 | ||||
| -rw-r--r-- | tests/test-routes.lisp | 25 |
7 files changed, 76 insertions, 21 deletions
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..7b47ee8 --- /dev/null +++ b/Makefile @@ -0,0 +1,11 @@ +TESTOPTS=--noinform --non-interactive --eval "(require 'asdf)"\ + --eval "(setf sb-impl::*default-external-format* :utf-8)"\ + --eval "(asdf:load-asd (merge-pathnames \"scgi-routes.asd\"))"\ + --eval "(asdf:load-system :scgi-routes/tests)"\ + --eval "(if (5am:run-all-tests) (uiop:quit 0) (uiop:quit 1))" + +all : + +.PHONY : test +test : + @sbcl $(TESTOPTS) diff --git a/routes.asd b/routes.asd deleted file mode 100644 index e131634..0000000 --- a/routes.asd +++ /dev/null @@ -1,14 +0,0 @@ -(asdf:defsystem #:routes - :description "A library for handling routing of SCGI requests." - :author "Thomas Albers Raviola <thomas@thomaslabs.org>" - :maintainer "Thomas Albers Raviola <thomas@thomaslabs.org>" - :license "GPL-3" - :version "1.0.0" - :serial t - :depends-on (:alexandria - :quri - :split-sequence - :usocket-server) - :pathname "src" - :components ((:file "package") - (:file "routes"))) diff --git a/scgi-routes.asd b/scgi-routes.asd new file mode 100644 index 0000000..76f885d --- /dev/null +++ b/scgi-routes.asd @@ -0,0 +1,28 @@ +(asdf:defsystem #:scgi-routes + :name "scgi-routes" + :description "A library for handling routing of SCGI requests." + :author "Thomas Albers Raviola <thomas@thomaslabs.org>" + :maintainer "Thomas Albers Raviola <thomas@thomaslabs.org>" + :license "GPL-3" + :version "1.0.0" + :serial t + :depends-on (:alexandria + :quri + :split-sequence + :usocket-server) + :pathname "src" + :components ((:file "package") + (:file "routes")) + :in-order-to ((test-op (test-op "scgi-routes/tests")))) + +(asdf:defsystem #:scgi-routes/tests + :name "scgi-routes tests" + :serial t + :depends-on (:scgi-routes + :fiveam) + :pathname "tests" + :components ((:file "package") + (:file "test-routes")) + ;; :perform (test-op (o c) + ;; (uiop/package:symbol-call "FIASCO" "RUN-TESTS" 'stumpwm-tests)) + ) diff --git a/src/package.lisp b/src/package.lisp index c2ea5b2..016f438 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,4 +1,5 @@ -(defpackage #:routes +(defpackage #:scgi-routes + (:nicknames #:routes) (:use #:cl #:alexandria #:split-sequence) diff --git a/src/routes.lisp b/src/routes.lisp index 272d579..0de0307 100644 --- a/src/routes.lisp +++ b/src/routes.lisp @@ -1,14 +1,14 @@ -(in-package #:routes) +(in-package #:scgi-routes) ;; Source: https://developer.mozilla.org/en-US/docs/Web/HTTP/Methods ;; Note: Not all http methods are yet implemented ;; Missing: :head :put :delete :connect :options :trace :patch -(defparameter *http-methods* - '(:get :post)) +(define-constant +http-methods+ + '(:get :post) :test 'equal) (deftype http-method () - `(member ,@*http-methods*)) + `(member ,@+http-methods+)) (defun route-method-p (object) (or (typep object 'http-method) @@ -239,11 +239,12 @@ route. If no route matches, then ERROR-HANDLER is called." (let* ((method (assoc-value headers :request-uri)) (uri (assoc-value headers :request-uri)) (query-bindings (quri:uri-query-params uri)) - (route (uri-route uri))) + (route (uri-route uri)) + (fragment (quri:uri-fragment uri))) (multiple-value-bind (entry path-bindings) (find-route route method *routes-table*) (if entry - (funcall (first entry) headers path-bindings query-bindings + (funcall (route-name entry) headers path-bindings query-bindings fragment) (funcall error-handler headers))))) (t (e) diff --git a/tests/package.lisp b/tests/package.lisp new file mode 100644 index 0000000..eb337ea --- /dev/null +++ b/tests/package.lisp @@ -0,0 +1,3 @@ +(defpackage #:scgi-routes/tests + (:use #:cl + #:scgi-routes)) diff --git a/tests/test-routes.lisp b/tests/test-routes.lisp new file mode 100644 index 0000000..45f75cc --- /dev/null +++ b/tests/test-routes.lisp @@ -0,0 +1,25 @@ +(in-package #:scgi-routes/tests) + +(5am:def-suite* scgi-routes-tests) + +(5am:test test1 + (5am:finishes + (routes:define-route index (:path (p1 p2 "index.cgi") + :method :get + :query (q1 + (q2 :init-form "2") + (q3 :name "named") + (q4 :name "all" :init-form "4" + :suppliedp q4p) + (q5 :suppliedp q5p)) + :fragment f + :content-type "text/plain") + (list p1 p2 q1 q2 q3 q4 q4p q5 q5p f))) + (5am:is + (equal + (let (ret + (uri "http://localhost:8080/foo/blah/index.cgi?b=1&c=2&q5")) + (with-output-to-string (*standard-output*) + (setf ret (test-route :get uri))) + ret) + (list "foo" "blah" nil "2" nil "4" t nil t nil)))) |