[bknr-cvs] hans changed trunk/projects/bos/web/
BKNR Commits
bknr at bknr.net
Tue Jul 22 14:08:27 UTC 2008
Revision: 3557
Author: hans
URL: http://bknr.net/trac/changeset/3557
Sessionless request language handling.
U trunk/projects/bos/web/contract-rss.lisp
U trunk/projects/bos/web/news-handlers.lisp
U trunk/projects/bos/web/news-rss.lisp
U trunk/projects/bos/web/news-tags.lisp
U trunk/projects/bos/web/poi-handlers.lisp
U trunk/projects/bos/web/rss.lisp
U trunk/projects/bos/web/startup.lisp
U trunk/projects/bos/web/tags.lisp
U trunk/projects/bos/web/web-utils.lisp
U trunk/projects/bos/web/webserver.lisp
Modified: trunk/projects/bos/web/contract-rss.lisp
===================================================================
--- trunk/projects/bos/web/contract-rss.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/contract-rss.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -7,7 +7,7 @@
(contract-paidp contract))
(defmethod rss-item-title ((contract contract))
- (format nil (case (intern (bos.web::current-website-language))
+ (format nil (case (intern (bos.web::request-language))
(de "~A Quadratmeter wurden ~@[von ~A ~]gekauft")
(t "~A square meters bought~@[ by ~A~]"))
(length (contract-m2s contract))
@@ -18,11 +18,11 @@
(defmethod rss-item-link ((contract contract))
#+(or)
- (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::current-website-language) (store-object-id item)))
+ (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item)))
(defmethod rss-item-guid ((item contract))
#+(or)
- (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::current-website-language) (store-object-id item)))
+ (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item)))
(defmethod rss-item-pub-date ((contract contract))
(contract-date contract))
Modified: trunk/projects/bos/web/news-handlers.lisp
===================================================================
--- trunk/projects/bos/web/news-handlers.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/news-handlers.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -10,7 +10,7 @@
())
(defmethod handle-object-form ((handler edit-news-handler) action (news-item (eql nil)))
- (let ((language (hunchentoot:session-value :language)))
+ (let ((language (request-language)))
(with-bos-cms-page (:title "Edit news items")
(content-language-chooser)
(:h2 "Create new item")
@@ -33,7 +33,7 @@
(redirect (format nil "/edit-news/~D" (store-object-id (make-news-item)))))
(defmethod handle-object-form ((handler edit-news-handler) action news-item)
- (let ((language (hunchentoot:session-value :language)))
+ (let ((language (request-language)))
(with-bos-cms-page (:title "Edit news item")
(content-language-chooser)
((:script :type "text/javascript")
@@ -49,7 +49,7 @@
(:tr (:td (submit-button "save" "save") (submit-button "delete" "delete" :confirm "Really delete the news item?"))))))))
(defmethod handle-object-form ((handler edit-news-handler) (action (eql :save)) news-item)
- (let ((language (hunchentoot:session-value :language)))
+ (let ((language (request-language)))
(with-query-params (title text)
(update-news-item news-item language :title title :text text)
(with-bos-cms-page (:title "News item updated")
Modified: trunk/projects/bos/web/news-rss.lisp
===================================================================
--- trunk/projects/bos/web/news-rss.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/news-rss.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -4,19 +4,19 @@
"news")
(defmethod rss-item-published ((item news-item))
- (news-item-published item (bos.web::current-website-language)))
+ (news-item-published item (bos.web::request-language)))
(defmethod rss-item-title ((item news-item))
- (news-item-title item (bos.web::current-website-language)))
+ (news-item-title item (bos.web::request-language)))
(defmethod rss-item-description ((item news-item))
- (news-item-text item (bos.web::current-website-language)))
+ (news-item-text item (bos.web::request-language)))
(defmethod rss-item-link ((item news-item))
- (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::current-website-language) (store-object-id item)))
+ (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item)))
(defmethod rss-item-guid ((item news-item))
- (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::current-website-language) (store-object-id item)))
+ (format nil "http://createrainforest.org/~A/news-extern/~A" (bos.web::request-language) (store-object-id item)))
(defmethod rss-item-pub-date ((item news-item))
(news-item-time item))
Modified: trunk/projects/bos/web/news-tags.lisp
===================================================================
--- trunk/projects/bos/web/news-tags.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/news-tags.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -7,7 +7,7 @@
do (html (:princ-safe line) :br)))
(define-bknr-tag news-headlines (&key archive)
- (let ((language (hunchentoot:session-value :language)))
+ (let ((language (request-language)))
(let* ((now (get-universal-time))
(news-items (if archive
(all-news-items language)
@@ -34,7 +34,7 @@
(define-bknr-tag news-item ()
(let ((news-item (find-store-object (parse-integer (nth-value 1 (parse-url)))))
- (language (hunchentoot:session-value :language)))
+ (language (request-language)))
(html ((:h1 :class "extra")
(:princ-safe (format-date-time (news-item-time news-item) :show-time nil))
", "
Modified: trunk/projects/bos/web/poi-handlers.lisp
===================================================================
--- trunk/projects/bos/web/poi-handlers.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/poi-handlers.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -18,7 +18,7 @@
(html (:h2 "Bad technical name")
"Please use only alphanumerical characters, - and _ for technical POI names")))
(t
- (redirect (edit-object-url (make-poi (hunchentoot:session-value :language) name)))))))
+ (redirect (edit-object-url (make-poi (request-language) name)))))))
(defclass edit-poi-handler (editor-only-handler edit-object-handler)
()
@@ -34,7 +34,7 @@
do (html (:li (cmslink (edit-object-url poi)
(:princ-safe (poi-name poi))
" - "
- (:princ-safe (slot-string poi 'title (hunchentoot:session-value :language)))))))))
+ (:princ-safe (slot-string poi 'title (request-language)))))))))
(html (:h2 "No POIs created yet")))
((:form :method "post" :action "/make-poi")
"Make new POI named "
@@ -52,7 +52,7 @@
(defmethod handle-object-form ((handler edit-poi-handler)
action (poi poi))
(with-query-params (language shift shift-by)
- (unless language (setq language (hunchentoot:session-value :language)))
+ (unless language (setq language (request-language)))
(when shift
;; change image order
(setq shift (find-store-object (parse-integer shift)))
@@ -65,7 +65,6 @@
(setf (nth old-position new-images) (nth (+ shift-by old-position) new-images))
(setf (nth (+ shift-by old-position) new-images) tmp)
(change-slot-values poi 'bos.m2::images new-images)))
- (setf (hunchentoot:session-value :language) language)
(with-bos-cms-page (:title "Edit POI")
(content-language-chooser)
(unless (poi-complete poi language)
@@ -169,7 +168,7 @@
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :save)) (poi poi))
(with-query-params (published title subtitle description language x y icon movie)
- (unless language (setq language (hunchentoot:session-value :language)))
+ (unless language (setq language (request-language)))
(let ((args (list :title title
:published published
:subtitle subtitle
@@ -301,7 +300,7 @@
(defmethod handle-object-form ((handler edit-poi-image-handler) action poi-image)
(with-query-params (language poi)
- (unless language (setq language (hunchentoot:session-value :language)))
+ (unless language (setq language (request-language)))
(with-bos-cms-page (:title "Edit POI Image")
(html
(cmslink (edit-object-url (poi-image-poi poi-image)) "Back to POI")
@@ -331,7 +330,7 @@
(defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :save)) poi-image)
(with-query-params (title subtitle description language)
- (unless language (setq language (hunchentoot:session-value :language)))
+ (unless language (setq language (request-language)))
(update-poi-image poi-image language
:title title
:subtitle subtitle
@@ -371,7 +370,7 @@
(with-http-body ()
(html
((:script :language "JavaScript")
- (:princ (make-poi-javascript (or (hunchentoot:session-value :language) *default-language*)))
+ (:princ (make-poi-javascript (request-language)))
(:princ "parent.poi_fertig(pois, anzahlSponsoren, anzahlVerkauft);")
(:princ (format nil "parent.last_sponsors([~{~A~^,~%~}]);" (mapcar #'contract-js last-paid-contracts)))))))))
Modified: trunk/projects/bos/web/rss.lisp
===================================================================
--- trunk/projects/bos/web/rss.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/rss.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -6,18 +6,18 @@
"news")
(defmethod rss-item-published ((item news-item))
- (format t "Language: ~A~%" (current-website-language))
+ (format t "Language: ~A~%" (request-language))
t)
(defmethod rss-item-title ((item news-item))
- (news-item-title item (current-website-language)))
+ (news-item-title item (request-language)))
(defmethod rss-item-description ((item news-item))
- (news-item-text item (current-website-language)))
+ (news-item-text item (request-language)))
(defmethod rss-item-link ((item news-item))
- (format nil "http://createrainforest.org/~A/news-extern/~A" (current-website-language) (store-object-id item)))
+ (format nil "http://createrainforest.org/~A/news-extern/~A" (request-language) (store-object-id item)))
(defmethod rss-item-guid ((item news-item))
- (format nil "http://createrainforest.org/~A/news-extern/~A" (current-website-language) (store-object-id item)))
+ (format nil "http://createrainforest.org/~A/news-extern/~A" (request-language) (store-object-id item)))
Modified: trunk/projects/bos/web/startup.lisp
===================================================================
--- trunk/projects/bos/web/startup.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/startup.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -41,12 +41,11 @@
:worldpay-test-mode *worldpay-test-mode*)
(format t "~&; Starting hunchentoot~@[ in debug mode~].~%" debug)
(force-output)
- (setq hunchentoot:*catch-errors-p* (not debug))
(when *webserver*
(hunchentoot:stop-server *webserver*))
- (setf *hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf)
+ (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf)
hunchentoot:*rewrite-for-session-urls* nil)
- (setq *webserver* (hunchentoot:start-server :port *port* #+not-yet :threaded #+not-yet (not debug)
+ (setq *webserver* (hunchentoot:start-server :port *port* (not debug)
:persistent-connections-p nil))
(if start-frontend
(start-frontend :host host :backend-port port :port frontend-port)
Modified: trunk/projects/bos/web/tags.lisp
===================================================================
--- trunk/projects/bos/web/tags.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/tags.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -15,10 +15,10 @@
(define-bknr-tag language-chooser (name)
(html ((:select :name name)
- (language-options-1 (current-website-language)))))
+ (language-options-1 (request-language)))))
(define-bknr-tag language-options ()
- (language-options-1 (current-website-language)))
+ (language-options-1 (request-language)))
(define-bknr-tag worldpay-receipt ()
(emit-without-quoting "<WPDISPLAY ITEM=banner>"))
@@ -41,7 +41,7 @@
(let ((contract (find-store-object (parse-integer (get-template-var :contract-id)))))
(when (equal want-print "no")
(contract-set-download-only-p contract t))
- (contract-issue-cert contract name :address address :language (hunchentoot:session-value :language))
+ (contract-issue-cert contract name :address address :language (request-language))
(mail-worldpay-sponsor-data)
(bknr.web::redirect-request :target (if gift "index"
(format nil "profil_setup?name=~A&email=~A&sponsor-id=~A"
@@ -78,7 +78,7 @@
(manual-transfer (or (scan #?r"rweisen" action)
(scan #?r"rweisung" action)
(scan #?r"verf" action)))
- (language (hunchentoot:session-value :language))
+ (language (request-language))
(sponsor (make-sponsor :language language))
(contract (make-contract sponsor numsqm
:download-only download-only
@@ -133,7 +133,7 @@
vorname name
strasse
plz ort)
- :language (hunchentoot:session-value :language))
+ :language (request-language))
(mail-manual-sponsor-data))))
(define-bknr-tag when-certificate ()
Modified: trunk/projects/bos/web/web-utils.lisp
===================================================================
--- trunk/projects/bos/web/web-utils.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/web-utils.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -30,19 +30,14 @@
(html "not logged in"))
" - current content language is "
(cmslink "change-language"
- (:princ-safe (current-website-language))
+ (:princ-safe (request-language))
" ("
- (:princ-safe (language-name (current-website-language)))
+ (:princ-safe (language-name (request-language)))
")"))))
(defun language-name (language-short-name)
(cadr (assoc language-short-name (website-languages) :test #'equal)))
-(defun current-website-language ()
- (unless (hunchentoot:session-value :language)
- (setf (hunchentoot:session-value :language) *default-language*))
- (hunchentoot:session-value :language))
-
(defun content-language-chooser ()
(html
((:p :class "languages")
@@ -51,7 +46,7 @@
do (labels ((show-language-link ()
(html (cmslink (format nil "~A?language=~A" (hunchentoot:request-uri*) language-symbol)
(:princ-safe language-name)))))
- (if (equal (hunchentoot:session-value :language) language-symbol)
+ (if (equal (request-language) language-symbol)
(html "[" (show-language-link) "]")
(html (show-language-link)))
(html " "))))))
Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp 2008-07-22 12:39:27 UTC (rev 3556)
+++ trunk/projects/bos/web/webserver.lisp 2008-07-22 14:08:27 UTC (rev 3557)
@@ -112,7 +112,7 @@
(with-query-params (logout)
(when logout
(hunchentoot:remove-session hunchentoot:*session*)))
- (let ((language (hunchentoot:session-value :language)))
+ (let ((language (request-language)))
(redirect #?"/infosystem/$(language)/satellitenkarte.htm")))
(defclass certificate-handler (object-handler)
@@ -178,18 +178,19 @@
(call-next-method)))
(call-next-method))))
-(defmethod authorize :after ((authorizer bos-authorizer))
- (let ((new-language (or (language-from-url (hunchentoot:request-uri*))
- (query-param "language")))
- (current-language (hunchentoot:session-value :language)))
- (when (or (not current-language)
- (and new-language
- (not (equal new-language current-language))))
- (setf (hunchentoot:session-value :language)
- (or new-language
- (find-browser-prefered-language)
- *default-language*)))))
+(defun request-language ()
+ (or (hunchentoot:aux-request-value :language)
+ *default-language*))
+(defmethod handle :before ((handler page-handler))
+ (setf (hunchentoot:aux-request-value :language)
+ (or (query-param "language")
+ (query-param "lang")
+ (language-from-url (hunchentoot:request-uri*))
+ (hunchentoot:session-value :language)
+ (find-browser-prefered-language)
+ *default-language*)))
+
;;; TODOreorg
(defun publish-directory (&key prefix destination)
(push (hunchentoot:create-folder-dispatcher-and-handler prefix destination) hunchentoot:*dispatch-table*))
@@ -212,7 +213,7 @@
("/kml-root" kml-root-handler)
("/country-stats" country-stats-handler)
("/contract-tree-kml" contract-tree-kml-handler)
- ("/contract-tree-image" contract-tree-image-handler)
+ ("/contract-tree-image" contract-tree-image-handler)
("/contract-image" contract-image-handler)
("/contract" contract-handler)
("/sat-tree-kml" sat-tree-kml-handler)
More information about the Bknr-cvs
mailing list