diff of 9d6713a6d8d393acbc64e42bc0fe3d2e7b11d254
9d6713a6d8d393acbc64e42bc0fe3d2e7b11d254
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 0b2d47f..3075e73 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -50,6 +50,7 @@
(:file "log")
(:file "settings")))
(:file "setting-definitions")
+ (:file "genurl")
(:module "middleware"
:components ((:file "json")
(:file "auth")))
@@ -114,7 +115,8 @@
(:file "literal-test")
(:file "tests")
(:file "rss-tests")
- (:file "session-tests"))))
+ (:file "session-tests")
+ (:file "genurl-tests"))))
:perform (test-op (op c)
(eval (read-from-string "(fiveam:run! 'murja.tests:main-suite)"))))
diff --git a/src/genurl.lisp b/src/genurl.lisp
new file mode 100644
index 0000000..b1e6f1e
--- /dev/null
+++ b/src/genurl.lisp
@@ -0,0 +1,17 @@
+(defpackage murja.genurl
+ (:use :cl)
+ (:export :route->url)
+ (:documentation "Provides functions for transforming murja.view.components.tabs:deftab'bed and easy-routes:defroute'd url symbols into correctly prefixed url strings")
+ (:local-nicknames (:settings :murja.setting-definitions)))
+
+(in-package :murja.genurl)
+
+(defun route->url (symbol &rest params)
+ (format nil "~a~a"
+ (settings:prefix)
+ (apply #'easy-routes:genurl symbol params)))
+
+
+;; (route->url 'murja.view.rss::rss-single-item :feed-id "ffffeed-id" :item-id "itemiiii-id")
+;; "/feeds/ffffeed-id/item/itemiiii-id"
+;; "/feeds/feed-id/item/item-id"
diff --git a/src/setting-definitions.lisp b/src/setting-definitions.lisp
index 39327a2..42cf805 100644
--- a/src/setting-definitions.lisp
+++ b/src/setting-definitions.lisp
@@ -1,6 +1,6 @@
(defpackage murja.setting-definitions
(:use :cl :murja.model.settings)
- (:export :page-size :rss-email :rss-lang :rss-description :rss-link :rss-title
+ (:export :page-size :rss-email :rss-lang :rss-description :rss-link :rss-title :prefix
:blog-title :domain :previously_label :recent-post-count :time-format))
(in-package :murja.setting-definitions)
@@ -18,5 +18,8 @@
(rss-description "MURJA DEV")
(rss-lang "fi")
(rss-email "-")
- (page-size 23456))
+ (page-size 23456)
+
+ ;; for example, "/blog" on feuerx.net
+ (prefix ""))
diff --git a/src/view/components/tabs.lisp b/src/view/components/tabs.lisp
index 1846cb5..e511b15 100644
--- a/src/view/components/tabs.lisp
+++ b/src/view/components/tabs.lisp
@@ -29,7 +29,6 @@
(defvar *tabs* (make-hash-table :test 'equal)
"A list of tabs, keyed by symbol and valued by instances of tab class"))
-
(defmacro deftab (sym (&key
url
(title "")
@@ -42,7 +41,7 @@
&body rst)
`(progn
(setf (gethash (quote ,sym) *tabs*)
- (make-instance 'tab :url ,(format nil "/blog~A" url)
+ (make-instance 'tab :url ,url
:abilities (list ,@needed-abilities)
:require-login ,require-login
:subtab (quote ,subtab)
@@ -52,10 +51,7 @@
(murja.middleware.db:with-db
(with-html
,@rst))))))
- (defroute ,sym (,(if lisp-fixup:*dev?*
- ;; we handle /blog prefix on our own only on dev
- (format nil "/blog~A" url)
- url)
+ (defroute ,sym (,url
:method :get
:decorators (@transaction
(@ssr-authenticated :require-authentication ,require-login )
diff --git a/test/genurl-tests.lisp b/test/genurl-tests.lisp
new file mode 100644
index 0000000..bb64426
--- /dev/null
+++ b/test/genurl-tests.lisp
@@ -0,0 +1,32 @@
+(defpackage murja.tests.genurl
+ (:use :cl :fiveam :murja.genurl)
+ (:import-from :murja.tests :prepare-db-and-server :drakma->string :url :main-suite :prepare-db-and-server)
+ (:local-nicknames (:settings :murja.setting-definitions)
+ (:tabs :murja.view.components.tabs)
+ (:feed :murja.view.rss)))
+
+(in-package :murja.tests.genurl)
+
+(in-suite main-suite)
+
+(def-test genurl-test (:fixture prepare-db-and-server)
+ (let ((old-prefix (settings:prefix)))
+ (unwind-protect
+ (progn
+ ;; initial state is as expected
+ (is (string= (settings:prefix) ""))
+ (is (string=
+ (route->url 'feed::rss-single-item :feed-id "auto-testing" :item-id "lololo")
+ "/feeds/auto-testing/item/lololo"))
+
+ ;; changing setting works as expected
+ (settings:prefix "/a-random-test-murja-instance")
+ (is (string=
+ (route->url 'feed::rss-single-item :feed-id "auto-testing" :item-id "lololo")
+ "/a-random-test-murja-instance/feeds/auto-testing/item/lololo"))
+
+ ;; instances of tab class keep their inner url prefix-less
+ (is (string= "/"
+ (tabs::tab-url
+ (gethash 'murja.view.blog-root:root murja.view.components.tabs::*tabs*)))))
+ (settings:prefix old-prefix))))