July 2008 - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] hans changed trunk/projects/bos/payment-website/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3563 Author: hans URL: http://bknr.net/trac/changeset/3563 Formulardaten nur ein mal abschicken. U trunk/projects/bos/payment-website/static/bos.js U trunk/projects/bos/payment-website/templates/da/ueberweisung.xml U trunk/projects/bos/payment-website/templates/de/ueberweisung.xml Modified: trunk/projects/bos/payment-website/static/bos.js =================================================================== --- trunk/projects/bos/payment-website/static/bos.js 2008-07-22 16:37:55 UTC (rev 3562) +++ trunk/projects/bos/payment-website/static/bos.js 2008-07-22 17:03:24 UTC (rev 3563) @@ -96,6 +96,8 @@ alert("Den Geschenkservice können wir nur bei Online-Überweisungen anbieten"); return false; } + + return true; } function check_online() { @@ -224,3 +226,38 @@ if (s!=''){alert('Die benötigten Informationen sind unvollständig oder fehlerhaft:\t\t\t\t\t\n\n'+s)} document.MM_returnValue = (s==''); } + +function check_ueberweisung_da() +{ + YY_checkform('mailtransfer', + 'vorname','#q','0','Anuller venligst dette felt \'Fornavn\'.', + 'name','#q','0','Anuller venligst dette felt \'Efternavn\'.', + 'strasse','#q','0','Anuller venligst dette felt \'Gade/Nr.\'.', + 'plz','#q','0','Anuller venligst dette felt \'Postnummer\'.', + 'ort','#q','0','Anuller venligst dette felt \'Kommune\'.'); + document.getElementById('submit_button').disabled = true; + if (document.MM_returnValue) { + document.getElementById('submit_button').disabled = true; + document.getElementById('submit_button').value = "Data is being transmitted..."; + return true; + } else { + return false; + } +} + +function check_ueberweisung_de() +{ + YY_checkform('mailtransfer', + 'vorname','#q','0','Bitte das Feld \'Vorname\' ausfuellen.', + 'name','#q','0','Bitte das Feld \'Name\' ausfuellen.', + 'strasse','#q','0','Bitte das Feld \'Strasse\' ausfuellen.', + 'plz','#q','0','Bitte das Feld \'PLZ\' ausfuellen.', + 'ort','#q','0','Bitte das Feld \'Ort\' ausfuellen.'); + if (document.MM_returnValue) { + document.getElementById('submit_button').disabled = true; + document.getElementById('submit_button').value = "Daten werden verschickt..."; + return true; + } else { + return false; + } +} \ No newline at end of file Modified: trunk/projects/bos/payment-website/templates/da/ueberweisung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/ueberweisung.xml 2008-07-22 16:37:55 UTC (rev 3562) +++ trunk/projects/bos/payment-website/templates/da/ueberweisung.xml 2008-07-22 17:03:24 UTC (rev 3563) @@ -40,7 +40,7 @@ enctype="application/x-www-form-urlencoded" name="mailtransfer" id="mailtransfer" - onsubmit="YY_checkform('mailtransfer','vorname','#q','0','Anuller venligst dette felt \'Fornavn\'.','name','#q','0','Anuller venligst dette felt \'Efternavn\'.','strasse','#q','0','Anuller venligst dette felt \'Gade/Nr.\'.','plz','#q','0','Anuller venligst dette felt \'Postnummer\'.','ort','#q','0','Anuller venligst dette felt \'Kommune\'.');return document.MM_returnValue"> + onsubmit="check_ueberweisung_da()"> <input type="hidden" name="country" value="DK" /> <input type="hidden" name="contract-id" value="$(contract-id)" /> <input type="hidden" name="sponsor-id" value="$(sponsor-id)" /> @@ -112,7 +112,7 @@ </tr> <tr> <td align="right" colspan="3"> - <input type="submit" class="form_big" name="action" value="Oplysninger til BOS" /> + <input type="submit" class="form_big" id="submit_button" name="action" value="Oplysninger til BOS" /> </td> </tr> </table> Modified: trunk/projects/bos/payment-website/templates/de/ueberweisung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/ueberweisung.xml 2008-07-22 16:37:55 UTC (rev 3562) +++ trunk/projects/bos/payment-website/templates/de/ueberweisung.xml 2008-07-22 17:03:24 UTC (rev 3563) @@ -40,7 +40,7 @@ enctype="application/x-www-form-urlencoded" name="mailtransfer" id="mailtransfer" - onsubmit="YY_checkform('mailtransfer','vorname','#q','0','Bitte das Feld \'Vorname\' ausfuellen.','name','#q','0','Bitte das Feld \'Name\' ausfuellen.','strasse','#q','0','Bitte das Feld \'Strasse\' ausfuellen.','plz','#q','0','Bitte das Feld \'PLZ\' ausfuellen.','ort','#q','0','Bitte das Feld \'Ort\' ausfuellen.');return document.MM_returnValue"> + onsubmit="return check_ueberweisung_de()"> <input type="hidden" name="contract-id" value="$(contract-id)" /> <input type="hidden" name="sponsor-id" value="$(sponsor-id)" /> <input type="hidden" name="amount" value="$(amount)" /> @@ -117,7 +117,7 @@ </tr> <tr> <td align="right" colspan="3"> - <input type="submit" class="form_big" name="action" value="Angaben an BOS mailen" /> + <input type="submit" id="submit_button" class="form_big" name="action" value="Angaben an BOS mailen" /> </td> </tr> </table>

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3562 Author: ksprotte URL: http://bknr.net/trac/changeset/3562 added kml-upload facility - no handler yetz U trunk/projects/bos/web/kml-handlers.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-07-22 16:37:36 UTC (rev 3561) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-07-22 16:37:55 UTC (rev 3562) @@ -1,6 +1,64 @@ ;;; -*- coding: utf-8 -*- (in-package :bos.web) +(defpersistent-class kml-root-data () + ((language :initarg :language :reader language :type string + :index-type string-unique-index + :index-reader kml-root-data-with-language) + (kml-string :accessor kml-string))) + +(defun ensure-kml-root-data-for-language (language) + (or (kml-root-data-with-language language) + (make-object 'kml-root-data :language language))) + +(defun kml-root-data-validate-file-upload (file-upload) + (cxml:parse-file (upload-pathname file-upload) + (cxml-dom:make-dom-builder))) + +(defclass kml-upload-handler (admin-only-handler form-handler) + ()) + +(defmethod handle-form ((handler kml-upload-handler) action) + (dolist (language (class-instances 'website-language)) + (ensure-kml-root-data-for-language (website-language-code language))) + (labels ((xml-parse-error-context (xml-parse-error) + (ppcre:register-groups-bind (line column) + ("Line +(\\d+).*column +(\\d+)" + (princ-to-string xml-parse-error)) + (when (and line column) + (values (parse-integer line) (parse-integer column)))))) + (with-bos-cms-page (:title "KML Upload") + (html ((:form + :method "POST" :enctype "multipart/form-data") + (dolist (kml-root-data (class-instances 'kml-root-data)) + (let ((language (language kml-root-data))) + (html (:h2 (:princ language)) + (:p ((:input :type "file" :name language)) + " " + (let ((file-upload (request-uploaded-file language))) + (when file-upload + (handler-case + (progn + (kml-root-data-validate-file-upload file-upload) + (with-transaction ("update kml-string") + (setf (kml-string kml-root-data) + (arnesi:read-string-from-file (upload-pathname file-upload) + :external-format :utf-8))) + (html (:princ "updated successfully"))) + (cxml:xml-parse-error (c) + (multiple-value-bind (line column) + (xml-parse-error-context c) + (print (list line column)) + (html ((:span :class "error") + (:format "there was a xml parse error ~:[~;near line ~D, column ~D~]" + (and line column) + line column))))))))) + ;; we want this after the processing + (:p (:format "last-change: ~A" + (format-date-time (store-object-last-change kml-root-data 0))))))) + (submit-button "upload" "upload")))))) + +;;; kml-format utils (defun kml-format-points (points stream) (mapc #'(lambda (point) (kml-format-point point stream)) points)) Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-07-22 16:37:36 UTC (rev 3561) +++ trunk/projects/bos/web/webserver.lisp 2008-07-22 16:37:55 UTC (rev 3562) @@ -199,6 +199,7 @@ :handler-definitions `(("/edit-poi" edit-poi-handler) ("/edit-poi-image" edit-poi-image-handler) ("/edit-sponsor" edit-sponsor-handler) + ("/kml-upload" kml-upload-handler) ("/kml-root" kml-root-handler) ("/country-stats" country-stats-handler) ("/contract-tree-kml" contract-tree-kml-handler) @@ -255,7 +256,8 @@ :admin-navigation '(("user" . "user/") ("languages" . "languages") ("allocation area" . "allocation-area/") - ("allocation cache" . "allocation-cache")) + ("allocation cache" . "allocation-cache") + ("kml-upload" . "kml-upload")) :authorizer (make-instance 'bos-authorizer) :site-logo-url "/images/bos-logo.gif" :style-sheet-urls '("/static/cms.css")

1 0

[bknr-cvs] hans changed trunk/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3561 Author: hans URL: http://bknr.net/trac/changeset/3561 Improve redirection mechanism so that robots will see a real page under / and browser users will be properly redirected. U trunk/bknr/web/src/web/template-handler.lisp U trunk/projects/bos/payment-website/templates/de/toplevel_main.xml U trunk/projects/bos/web/tags.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/bknr/web/src/web/template-handler.lisp =================================================================== --- trunk/bknr/web/src/web/template-handler.lisp 2008-07-22 16:07:52 UTC (rev 3560) +++ trunk/bknr/web/src/web/template-handler.lisp 2008-07-22 16:37:36 UTC (rev 3561) @@ -306,7 +306,7 @@ (defmethod handler-matches-p ((handler template-handler)) (handler-case - (find-template-pathname handler (script-name*)) + (find-template-pathname handler (subseq (script-name*) 1)) (template-not-found (c) (declare (ignore c)) nil))) Modified: trunk/projects/bos/payment-website/templates/de/toplevel_main.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_main.xml 2008-07-22 16:07:52 UTC (rev 3560) +++ trunk/projects/bos/payment-website/templates/de/toplevel_main.xml 2008-07-22 16:37:36 UTC (rev 3561) @@ -11,10 +11,9 @@ <link rel="stylesheet" href="/static/content_style.css" /> <link rel="alternate" type="application/rss+xml" title="RSS Feed" href="/rss/news" /> - <script src="/static/bos.js" type="text/javascript"> - </script> -  + <script src="/static/bos.js" type="text/javascript"> </script> <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> + <bos:maybe-redirect/> <title>$(title)</title> </head> <body bos:lang="$(language)"> Modified: trunk/projects/bos/web/tags.lisp =================================================================== --- trunk/projects/bos/web/tags.lisp 2008-07-22 16:07:52 UTC (rev 3560) +++ trunk/projects/bos/web/tags.lisp 2008-07-22 16:37:36 UTC (rev 3561) @@ -194,4 +194,8 @@ (:princ #?"if (_gat) { var pageTracker = _gat._getTracker('$(*google-analytics-account*)'); pageTracker._initData(); pageTracker._trackPageview(); }")))) (define-bknr-tag set-cachable () - (setf (hunchentoot:header-out :cache-control) "max-age=300")) \ No newline at end of file + (setf (hunchentoot:header-out :cache-control) "max-age=300")) + +(define-bknr-tag maybe-redirect () + (when (equal (hunchentoot:script-name*) "/") + (html (:head ((:meta :http-equiv "refresh" :content "0; url=/index")))))) \ No newline at end of file Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-07-22 16:07:52 UTC (rev 3560) +++ trunk/projects/bos/web/webserver.lisp 2008-07-22 16:37:36 UTC (rev 3561) @@ -23,35 +23,34 @@ ;; and change the template name according to the outcome. (defmethod find-template-pathname ((handler worldpay-template-handler) template-name) - (cond - ((scan #?r"(^|.*/)handle-sale" template-name) - (with-query-params (cartId name address country transStatus lang MC_gift) - (unless (website-supports-language lang) - (setf lang *default-language*)) - (bos.m2::remember-worldpay-params cartId (all-request-params)) - (let ((contract (get-contract (parse-integer cartId)))) - (sponsor-set-language (contract-sponsor contract) lang) - (cond - ((not (typep contract 'contract)) - (user-error "Error: Invalid transaction ID.")) - ((contract-paidp contract) - (user-error "Error: Transaction already processed.")) - ((equal "C" transStatus) - (setf template-name #?"/$(lang)/sponsor_canceled")) - ((< (contract-price contract) *mail-certificate-threshold*) - (setf template-name #?"/$(lang)/quittung")) - (t - (when (<= *mail-fiscal-certificate-threshold* (contract-price contract)) - (mail-fiscal-certificate-to-office contract name address country)) - (setf template-name (if (and MC_gift (equal MC_gift "1")) #?"/$(lang)/versand_geschenk" #?"/$(lang)/versand_info"))))))) - ((and (not (scan "/" template-name)) - (not (probe-file (merge-pathnames (make-pathname :name template-name :type "xml") - (bknr.web::template-expander-destination handler))))) - (setf template-name (format nil "~A/~A" (or (find-browser-prefered-language) - *default-language*) - (if (equal "" template-name) - "index" template-name))))) - (call-next-method handler template-name)) + (call-next-method handler + (cond + ((scan #?r"(^|.*/)handle-sale" template-name) + (with-query-params (cartId name address country transStatus lang MC_gift) + (unless (website-supports-language lang) + (setf lang *default-language*)) + (bos.m2::remember-worldpay-params cartId (all-request-params)) + (let ((contract (get-contract (parse-integer cartId)))) + (sponsor-set-language (contract-sponsor contract) lang) + (cond + ((not (typep contract 'contract)) + (user-error "Error: Invalid transaction ID.")) + ((contract-paidp contract) + (user-error "Error: Transaction already processed.")) + ((equal "C" transStatus) + #?"/$(lang)/sponsor_canceled") + ((< (contract-price contract) *mail-certificate-threshold*) + #?"/$(lang)/quittung") + (t + (when (<= *mail-fiscal-certificate-threshold* (contract-price contract)) + (mail-fiscal-certificate-to-office contract name address country)) + (if (and MC_gift (equal MC_gift "1")) + #?"/$(lang)/versand_geschenk" + #?"/$(lang)/versand_info")))))) + ((equal "" template-name) + "de/index") + (t + template-name)))) (defmethod initial-template-environment ((expander worldpay-template-handler)) (append (list (cons :website-url *website-url*) @@ -240,8 +239,6 @@ file-handler :destination ,(merge-pathnames #p"static/favicon.ico" website-directory) :content-type "image/x-icon") - ("/" redirect-handler - :to "/index") ("/index" index-handler) user images

1 0

[bknr-cvs] hans changed trunk/projects/bos/web/startup.lisp
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3560 Author: hans URL: http://bknr.net/trac/changeset/3560 repair hunchentoot startup arguments U trunk/projects/bos/web/startup.lisp Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-07-22 14:56:17 UTC (rev 3559) +++ trunk/projects/bos/web/startup.lisp 2008-07-22 16:07:52 UTC (rev 3560) @@ -45,8 +45,8 @@ (hunchentoot:stop-server *webserver*)) (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 debug) - :persistent-connections-p nil)) + (setq *webserver* (hunchentoot:start-server :port *port* :threaded (not debug) + :persistent-connections-p (not debug))) (if start-frontend (start-frontend :host host :backend-port port :port frontend-port) (warn "frontend not started - to achieve this specify :start-frontend t"))

1 0

[bknr-cvs] ksprotte changed trunk/xhtmlgen/xhtmlgen.lisp
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3559 Author: ksprotte URL: http://bknr.net/trac/changeset/3559 xhtmlgen: added 2 new special-html tags. :format and :format-safe U trunk/xhtmlgen/xhtmlgen.lisp Modified: trunk/xhtmlgen/xhtmlgen.lisp =================================================================== --- trunk/xhtmlgen/xhtmlgen.lisp 2008-07-22 14:41:01 UTC (rev 3558) +++ trunk/xhtmlgen/xhtmlgen.lisp 2008-07-22 14:56:17 UTC (rev 3559) @@ -225,6 +225,18 @@ `(prin1-safe-http ,bod)) body)))) +(def-special-html :format + ;; example: + ;; (html (:p (:format "hi ~A!" "paul"))) + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp)) + `(princ-http (format nil ,@body)))) + +(def-special-html :format-safe + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp)) + `(princ-safe-http (format nil ,@body)))) + (def-special-html :comment #'(lambda (ent args argsp body) (declare (ignore ent args argsp body))

1 0

[bknr-cvs] hans changed trunk/projects/bos/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3558 Author: hans URL: http://bknr.net/trac/changeset/3558 Language related fixes. U trunk/projects/bos/payment-website/infosystem/javascript.js U trunk/projects/bos/payment-website/static/bos.js U trunk/projects/bos/payment-website/templates/da/infosystem.xml U trunk/projects/bos/payment-website/templates/da/quittung.xml U trunk/projects/bos/payment-website/templates/da/ring-detail.xml U trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml U trunk/projects/bos/payment-website/templates/da/toplevel.xml U trunk/projects/bos/payment-website/templates/da/toplevel_extra.xml U trunk/projects/bos/payment-website/templates/da/toplevel_main.xml U trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml U trunk/projects/bos/payment-website/templates/da/versand_info.xml U trunk/projects/bos/payment-website/templates/de/infosystem.xml U trunk/projects/bos/payment-website/templates/de/quittung.xml U trunk/projects/bos/payment-website/templates/de/ring-detail.xml U trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml U trunk/projects/bos/payment-website/templates/de/toplevel.xml U trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml U trunk/projects/bos/payment-website/templates/de/toplevel_main.xml U trunk/projects/bos/payment-website/templates/de/toplevel_news.xml U trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml U trunk/projects/bos/payment-website/templates/en/infosystem.xml U trunk/projects/bos/payment-website/templates/en/quittung.xml U trunk/projects/bos/payment-website/templates/en/ring-detail.xml U trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml U trunk/projects/bos/payment-website/templates/en/toplevel.xml U trunk/projects/bos/payment-website/templates/en/toplevel_extra.xml U trunk/projects/bos/payment-website/templates/en/toplevel_main.xml U trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml U trunk/projects/bos/payment-website/templates/en/versand_info.xml U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/payment-website/infosystem/javascript.js =================================================================== --- trunk/projects/bos/payment-website/infosystem/javascript.js 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/infosystem/javascript.js 2008-07-22 14:41:01 UTC (rev 3558) @@ -158,7 +158,7 @@ dbg("<br/> -> lade POI"); poicomplete = false; - window.frames['data'].window.location.replace(http_pfad + "/poi-javascript"); + window.frames['data'].window.location.replace(http_pfad + "/poi-javascript?lang=" + document.language); poi_warten(); // starten der Wartenfunktion return true; Modified: trunk/projects/bos/payment-website/static/bos.js =================================================================== --- trunk/projects/bos/payment-website/static/bos.js 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/static/bos.js 2008-07-22 14:41:01 UTC (rev 3558) @@ -22,7 +22,7 @@ // *** extrafenster fuer satellitenkarte *** // function window_infosys() { - var url = "/infosystem"; + var url = "/infosystem/" + document.body.lang + "/satellitenkarte.htm"; var sponsorid_input = document.getElementById('sponsorid-input'); var password_input = document.getElementById('password-input'); Modified: trunk/projects/bos/payment-website/templates/da/infosystem.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/infosystem.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/infosystem.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -11,7 +11,7 @@ <title>Regnskov i SAMBOJA LESTARI - Infosystem</title> </head> -<body> +<body bos:lang="$(language)"> <div id="header_infosystem"> </div> <div id="content_infosystem"> Modified: trunk/projects/bos/payment-website/templates/da/quittung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/quittung.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/quittung.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -10,7 +10,7 @@  <title>Regnskov i SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/da/ring-detail.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/ring-detail.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/ring-detail.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -13,7 +13,7 @@ </script> <title>Scheme for the "ring"</title> </head> - <body> + <body bos:lang="$(language)"> <div id="content_extra"> <h1 class="ringschema">Scheme for the "ring"</h1> <img src="/images/ring_detail_en.jpg" /> Modified: trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -10,7 +10,7 @@  <title>Regnskov i SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/da/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/toplevel.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/toplevel.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -12,7 +12,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(titel)</title> </head> -<body> +<body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/da/toplevel_extra.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/toplevel_extra.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/toplevel_extra.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -11,7 +11,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(titel)</title> </head> - <body> + <body bos:lang="$(language)"> <div id="header_extra"> </div> <div id="content_extra"> Modified: trunk/projects/bos/payment-website/templates/da/toplevel_main.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/toplevel_main.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/toplevel_main.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -10,7 +10,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(title)</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>REGENWALD für SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/da/versand_info.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/versand_info.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/da/versand_info.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -10,7 +10,7 @@  <title>Regnskov i SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/de/infosystem.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/infosystem.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/infosystem.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -12,7 +12,7 @@ <title>REGENWALD für SAMBOJA LESTARI - Infosystem</title> </head> -<body> +<body bos:lang="$(language)"> <div id="header_infosystem"> </div> <div id="content_infosystem"> Modified: trunk/projects/bos/payment-website/templates/de/quittung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/quittung.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/quittung.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>REGENWALD für SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/de/ring-detail.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/ring-detail.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/ring-detail.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -13,7 +13,7 @@ </script> <title>Ringschema</title> </head> - <body> + <body bos:lang="$(language)"> <div id="content_extra"> <h1 class="ringschema">Ringschema</h1> <img src="/images/ring_detail.jpg" /> Modified: trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>REGENWALD für SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/de/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/toplevel.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -15,7 +15,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(title)</title> </head> -<body> +<body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/toplevel_extra.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(title)</title> </head> - <body> + <body bos:lang="$(language)"> <div id="header_extra"> </div> <div id="content_extra"> Modified: trunk/projects/bos/payment-website/templates/de/toplevel_main.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_main.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/toplevel_main.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -17,7 +17,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(title)</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/de/toplevel_news.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_news.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/toplevel_news.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -14,7 +14,7 @@  <title>$(title)</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>REGENWALD für SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/en/infosystem.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/infosystem.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/infosystem.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -12,7 +12,7 @@ <title>RAINFOREST for SAMBOJA LESTARI - Infosystem</title> </head> -<body> +<body bos:lang="$(language)"> <div id="header_infosystem"> </div> <div id="content_infosystem"> Modified: trunk/projects/bos/payment-website/templates/en/quittung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/quittung.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/quittung.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>RAINFOREST for SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/en/ring-detail.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/ring-detail.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/ring-detail.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -13,7 +13,7 @@ </script> <title>Scheme for the "ring"</title> </head> - <body> + <body bos:lang="$(language)"> <div id="content_extra"> <h1 class="ringschema">Scheme for the "ring"</h1> <img src="/images/ring_detail_en.jpg" /> Modified: trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>RAINFOREST for SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/en/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/toplevel.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/toplevel.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -17,7 +17,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(title)</title> </head> -<body> +<body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/en/toplevel_extra.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/toplevel_extra.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/toplevel_extra.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(title)</title> </head> - <body> + <body bos:lang="$(language)"> <div id="header_extra"> </div> <div id="content_extra"> Modified: trunk/projects/bos/payment-website/templates/en/toplevel_main.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/toplevel_main.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/toplevel_main.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -15,7 +15,7 @@ <link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" /> <title>$(title)</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>REGENWALD für SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/payment-website/templates/en/versand_info.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/versand_info.xml 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/payment-website/templates/en/versand_info.xml 2008-07-22 14:41:01 UTC (rev 3558) @@ -16,7 +16,7 @@  <title>RAINFOREST for SAMBOJA LESTARI</title> </head> - <body> + <body bos:lang="$(language)">  <div id="header"> Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-07-22 14:08:27 UTC (rev 3557) +++ trunk/projects/bos/web/webserver.lisp 2008-07-22 14:41:01 UTC (rev 3558) @@ -54,7 +54,8 @@ (call-next-method handler template-name)) (defmethod initial-template-environment ((expander worldpay-template-handler)) - (append (list (cons :website-url *website-url*)) + (append (list (cons :website-url *website-url*) + (cons :language (request-language))) (call-next-method))) (define-persistent-class website-language () @@ -104,17 +105,6 @@ *default-language*)) :code hunchentoot:+http-moved-permanently+)) -(defclass infosystem-handler (page-handler) - ()) - -(defmethod handle ((handler infosystem-handler)) - ;; XXX hier logout-parameter implementieren - (with-query-params (logout) - (when logout - (hunchentoot:remove-session hunchentoot:*session*))) - (let ((language (request-language))) - (redirect #?"/infosystem/$(language)/satellitenkarte.htm"))) - (defclass certificate-handler (object-handler) () (:default-initargs :class 'contract)) @@ -182,7 +172,7 @@ (or (hunchentoot:aux-request-value :language) *default-language*)) -(defmethod handle :before ((handler page-handler)) +(defmethod handle :before ((handler page-handler)) (setf (hunchentoot:aux-request-value :language) (or (query-param "language") (query-param "lang") @@ -238,7 +228,6 @@ ("/cert-regen" cert-regen-handler) ("/admin" admin-handler) ("/languages" languages-handler) - ("/infosystem" infosystem-handler) ("/overview" image-tile-handler) ("/enlarge-overview" enlarge-tile-handler) ("/create-contract" create-contract-handler)

1 0

[bknr-cvs] hans changed trunk/projects/bos/web/
by BKNR Commits 22 Jul '08

22 Jul '08

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)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3556 Author: ksprotte URL: http://bknr.net/trac/changeset/3556 content of root kml document in GE is now opened by default U trunk/projects/bos/payment-website/static/kml-root-da.kml U trunk/projects/bos/payment-website/static/kml-root-de.kml U trunk/projects/bos/payment-website/static/kml-root-en.kml U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/payment-website/static/kml-root-da.kml =================================================================== --- trunk/projects/bos/payment-website/static/kml-root-da.kml 2008-07-22 12:03:12 UTC (rev 3555) +++ trunk/projects/bos/payment-website/static/kml-root-da.kml 2008-07-22 12:39:27 UTC (rev 3556) @@ -1,7 +1,8 @@ <?xml version="1.0" encoding="UTF-8"?> <kml> <Document> - <name>BOS [da]</name> + <name>BOS</name> + <open>1</open> <LookAt> <longitude>116.988156014724</longitude> <latitude>-1.045791509671129</latitude> Modified: trunk/projects/bos/payment-website/static/kml-root-de.kml =================================================================== --- trunk/projects/bos/payment-website/static/kml-root-de.kml 2008-07-22 12:03:12 UTC (rev 3555) +++ trunk/projects/bos/payment-website/static/kml-root-de.kml 2008-07-22 12:39:27 UTC (rev 3556) @@ -1,7 +1,8 @@ <?xml version="1.0" encoding="UTF-8"?> <kml> <Document> - <name>BOS [de]</name> + <name>BOS</name> + <open>1</open> <LookAt> <longitude>116.988156014724</longitude> <latitude>-1.045791509671129</latitude> Modified: trunk/projects/bos/payment-website/static/kml-root-en.kml =================================================================== --- trunk/projects/bos/payment-website/static/kml-root-en.kml 2008-07-22 12:03:12 UTC (rev 3555) +++ trunk/projects/bos/payment-website/static/kml-root-en.kml 2008-07-22 12:39:27 UTC (rev 3556) @@ -1,7 +1,8 @@ <?xml version="1.0" encoding="UTF-8"?> <kml> <Document> - <name>BOS [en]</name> + <name>BOS</name> + <open>1</open> <LookAt> <longitude>116.988156014724</longitude> <latitude>-1.045791509671129</latitude> Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-07-22 12:03:12 UTC (rev 3555) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-07-22 12:39:27 UTC (rev 3556) @@ -66,7 +66,8 @@ (hunchentoot:rfc-1123-date (timestamp handler))) (with-query-params ((lang "en")) (with-element "Document" - (with-element "name" (text (format nil "BOS [~A]" lang))) + (with-element "name" (text "BOS")) + (with-element "open" (text "1")) (when contract (with-element "Style" (attribute "id" "contractPlacemarkIcon")

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/templates/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3555 Author: ksprotte URL: http://bknr.net/trac/changeset/3555 although satmap does only exist in german, changed GE links to be language dependent U trunk/projects/bos/payment-website/templates/da/satmap.xml U trunk/projects/bos/payment-website/templates/en/satmap.xml Modified: trunk/projects/bos/payment-website/templates/da/satmap.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/satmap.xml 2008-07-22 12:02:48 UTC (rev 3554) +++ trunk/projects/bos/payment-website/templates/da/satmap.xml 2008-07-22 12:03:12 UTC (rev 3555) @@ -77,7 +77,7 @@ <tr> <td colspan="3"> <img alt="" height="9" width="10" src="/images/pfeil_link_on.gif"/> - <a shape="rect" class="more" href="/static/kml-root-de.kml"> + <a shape="rect" class="more" href="/static/kml-root-da.kml"> zu Google Earth </a> </td> Modified: trunk/projects/bos/payment-website/templates/en/satmap.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/satmap.xml 2008-07-22 12:02:48 UTC (rev 3554) +++ trunk/projects/bos/payment-website/templates/en/satmap.xml 2008-07-22 12:03:12 UTC (rev 3555) @@ -77,7 +77,7 @@ <tr> <td colspan="3"> <img alt="" height="9" width="10" src="/images/pfeil_link_on.gif"/> - <a shape="rect" class="more" href="/static/kml-root-de.kml"> + <a shape="rect" class="more" href="/static/kml-root-en.kml"> zu Google Earth </a> </td>

1 0

[bknr-cvs] hans changed trunk/
by BKNR Commits 22 Jul '08

22 Jul '08

Revision: 3554 Author: hans URL: http://bknr.net/trac/changeset/3554 Never block in contract-issue-cert. In the frontend, the user will always spend enough time on the following pages so that the certificate will be generated. In order to support the CMS workflow, the /certificate handler now waits until the certificates have been generated before serving the PDF. U trunk/bknr/datastore/src/data/object.lisp U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/web/contract-handlers.lisp U trunk/projects/bos/web/kml-handlers.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/bknr/datastore/src/data/object.lisp =================================================================== --- trunk/bknr/datastore/src/data/object.lisp 2008-07-22 11:48:19 UTC (rev 3553) +++ trunk/bknr/datastore/src/data/object.lisp 2008-07-22 12:02:48 UTC (rev 3554) @@ -41,7 +41,7 @@ (let ((instance-count (length (class-instances class)))) (when (plusp instance-count) (unless *suppress-schema-warnings* - (warn "updating ~A instances of ~A for class changes" instance-count class)) + (format *trace-output* "~&; updating ~A instances of ~A for class changes~%" instance-count class)) (mapc #'reinitialize-instance (class-instances class))))) (defmethod instance :after ((class persistent-class) &rest args) Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-22 11:48:19 UTC (rev 3553) +++ trunk/projects/bos/m2/m2.lisp 2008-07-22 12:02:48 UTC (rev 3554) @@ -342,15 +342,6 @@ (delete-file (contract-pdf-pathname contract)) (delete-file (contract-pdf-pathname contract :print t)))) -(defun wait-for-certificates (contract) - "Wait until the PDF generating process has generated the certificates" - (dotimes (i 10) - (when (contract-certificates-generated-p contract) - (return)) - (sleep 1)) - (unless (contract-certificates-generated-p contract) - (error "Cannot generate certificate"))) - (defmethod contract-issue-cert ((contract contract) name &key address language) (when (contract-cert-issued contract) (warn "re-issuing cert for ~A" contract)) @@ -358,7 +349,6 @@ (make-certificate contract name :address address :language language) (unless (contract-download-only-p contract) (make-certificate contract name :address address :language language :print t)) - (wait-for-certificates contract) (change-slot-values contract 'cert-issued t)) (defmethod contract-image-tiles ((contract contract)) Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-07-22 11:48:19 UTC (rev 3553) +++ trunk/projects/bos/m2/packages.lisp 2008-07-22 12:02:48 UTC (rev 3554) @@ -161,6 +161,7 @@ #:contract-set-download-only-p #:contract-price #:contract-issue-cert + #:contract-certificates-generated-p #:contract-worldpay-trans-id #:contract-pdf-pathname #:contract-pdf-url Modified: trunk/projects/bos/web/contract-handlers.lisp =================================================================== --- trunk/projects/bos/web/contract-handlers.lisp 2008-07-22 11:48:19 UTC (rev 3553) +++ trunk/projects/bos/web/contract-handlers.lisp 2008-07-22 12:02:48 UTC (rev 3554) @@ -32,4 +32,5 @@ (:td (:princ-safe (contract-color contract)))) #+(or) (:tr (:td "cert issued?") - (:td (:princ-safe (if (contract-cert-issued contract) "yes" "no"))))))) \ No newline at end of file + (:td (:princ-safe (if (contract-cert-issued contract) "yes" "no"))))))) + Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-07-22 11:48:19 UTC (rev 3553) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-07-22 12:02:48 UTC (rev 3554) @@ -138,7 +138,7 @@ (hunchentoot:handle-if-modified-since timestamp) (setf (hunchentoot:header-out :last-modified) (hunchentoot:rfc-1123-date timestamp)) - (with-xml-response (:content-type #+nil "text/xml" "application/vnd.google-earth.kml+xml; charset=utf-8" + (with-xml-response (:content-type "application/vnd.google-earth.kml+xml; charset=utf-8" :root-element "kml") (with-query-params ((lang "en")) (with-element "Document" Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-07-22 11:48:19 UTC (rev 3553) +++ trunk/projects/bos/web/webserver.lisp 2008-07-22 12:02:48 UTC (rev 3554) @@ -122,7 +122,17 @@ (defmethod handle-object ((handler certificate-handler) contract) (unless contract (setf contract (find-if #'contract-pdf-pathname (sponsor-contracts (bknr.web:bknr-session-user))))) - (redirect (format nil "/certificates/~D.pdf" (store-object-id contract)))) + (if (contract-certificates-generated-p contract) + (redirect (format nil "/certificates/~D.pdf" (store-object-id contract))) + (with-http-response (:content-type "text/html; charset=UTF-8") + (with-http-body () + (html + (:html + (:head + (:title "Waiting for certificate generation...") + ((:meta :http-equiv "Refresh" :content (format nil "3; ~A" (hunchentoot:script-name*))))) + (:body + "Please wait, certificate is being generated"))))))) (defclass statistics-handler (editor-only-handler prefix-handler) ())

1 0