[bknr-cvs] hans changed trunk/

BKNR Commits bknr at bknr.net
Tue Jul 22 16:37:36 UTC 2008


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"><!-- x -->	
-		</script> 
-             <!--<meta http-equiv="content-type" content="text/html; charset=UTF-8" />-->
+		<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




More information about the Bknr-cvs mailing list