[bknr-cvs] r2367 - branches/bos/projects/bos/web

[hhubner at common-lisp.net]

Author: hhubner
Date: Sat Jan 19 04:41:54 2008
New Revision: 2367

Modified:
   branches/bos/projects/bos/web/webserver.lisp
Log:
Experiment to stop redirection on / - Instead, default the template
pathname to the index page.  This may screw up language detection,
which used to work by parsing the URL.


Modified: branches/bos/projects/bos/web/webserver.lisp
==============================================================================
--- branches/bos/projects/bos/web/webserver.lisp	(original)
+++ branches/bos/projects/bos/web/webserver.lisp	Sat Jan 19 04:41:54 2008
@@ -23,26 +23,32 @@
 ;; and change the template name according to the outcome.
 
 (defmethod find-template-pathname ((handler worldpay-template-handler) template-name &key request)
-  (when (scan #?r"(^|.*/)handle-sale" template-name)
-    (with-query-params (request 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 request))
-      (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")))))))
+  (cond
+    ((not (scan "/" template-name))
+     (setf template-name (format nil "~A/~A" (or (find-browser-prefered-language request)
+						 *default-language*)
+				 (if (equal "" template-name)
+				     "index" template-name))))
+    ((scan #?r"(^|.*/)handle-sale" template-name)
+     (with-query-params (request 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 request))
+       (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"))))))))
   (call-next-method handler template-name))
 
 (defmethod initial-template-environment ((expander worldpay-template-handler) req)
@@ -215,6 +221,7 @@
 					("/cancel-contract" cancel-contract-handler)
 					("/statistics" statistics-handler)
 					("/rss" rss-handler)
+					#+(or)
 					("/" redirect-handler
 					 :to "/index")
 					("/index" index-handler)