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)