Changeset 3398

Show
Ignore:
Timestamp:
07/01/08 13:01:48 (6 months ago)
Author:
hans
Message:

Fixes to payment processing related stuff with new CXML and Hunchentoot.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • trunk/bknr/web/src/web/handlers.lisp

    r3352 r3398  
    181181 
    182182(defclass cachable-handler () 
    183   ((max-age :initform 60 :initarg :max-age :accessor handler-max-age))) 
     183  ((max-age :initform 5 
     184            :initarg :max-age 
     185            :accessor handler-max-age 
     186            :documentation "Default value to set for the Cache-Control max-age header."))) 
    184187 
    185188(defmethod initialize-instance :after ((handler cachable-handler) &rest initargs) 
  • trunk/bknr/web/src/web/web-utils.lisp

    r3271 r3398  
    7070 
    7171(defun query-param (param-name &key (get t) (post t)) 
    72   (let ((value (cdr (assoc param-name (query-params :get get :post post) :test #'equal)))) 
     72  (let ((value (cdr (assoc param-name (query-params :get get :post post) :test #'string-equal)))) 
    7373    (unless (equal value "") 
    7474      value))) 
  • trunk/projects/bos/m2-sample.rc

    r2954 r3398  
    1 :directory (merge-pathnames #p"datastore/" (user-homedir-pathname)) 
     1:directory (merge-pathnames #p"bos-store/" (user-homedir-pathname)) 
    22:website-url "http://createrainforest.org" 
    33:enable-mails nil 
  • trunk/projects/bos/m2/map.lisp

    r3074 r3398  
    8080    pixel-rgb-value)) 
    8181 
    82 (defun point-in-any-allocation-area-p (x-coord y-coord) 
     82(defvar *allocation-area-cache* nil 
     83  "Array of bits indicating whether a certain square meter is inside of an allocation area") 
     84 
     85(defvar *allocation-cache-x* nil 
     86  "Top left X coordinate of the allocation cache") 
     87(defvar *allocation-cache-y* nil 
     88  "Top left Y coordinate of the allocation cache") 
     89(defvar *allocation-cache-width* nil 
     90  "Width of the allocation cache") 
     91(defvar *allocation-cache-height* nil 
     92  "Height of the allocation cache") 
     93 
     94(defun point-in-any-allocation-area-p% (x-coord y-coord) 
    8395  (find-if #'(lambda (allocation-area) 
    8496               ;; first check whether point is in bounding box, then do full polygon check 
     
    8698                    (point-in-polygon-p x-coord y-coord (allocation-area-vertices allocation-area)))) 
    8799           (store-objects-with-class 'allocation-area))) 
     100 
     101(defun initialize-allocation-cache () 
     102  (destructuring-bind (top-left-x top-left-y width height) (allocation-areas-bounding-box) 
     103    (setf *allocation-area-cache* (make-array (list width height) :element-type '(unsigned-byte 1)) 
     104          *allocation-cache-x* top-left-x 
     105          *allocation-cache-y* top-left-y 
     106          *allocation-cache-width* width 
     107          *allocation-cache-height* height) 
     108    (dotimes (x width) 
     109      (dotimes (y height) 
     110        (when (point-in-any-allocation-area-p (+ x top-left-x) (+ y top-left-y)) 
     111          (setf (aref *allocation-area-cache* x y) 1)))))) 
     112 
     113(defun point-in-any-allocation-area-p (x-coord y-coord) 
     114  (and (< -1 (- x-coord *allocation-cache-x*) *allocation-cache-width*) 
     115       (< -1 (- y-coord *allocation-cache-y*) *allocation-cache-height*) 
     116       (plusp (aref *allocation-area-cache* 
     117                    (- x-coord *allocation-cache-x*) 
     118                    (- y-coord *allocation-cache-y*))))) 
    88119   
    89120(defclass image-tile (tile) 
  • trunk/projects/bos/web/tags.lisp

    r3393 r3398  
    55(defun emit-without-quoting (str) 
    66  ;; das ist fuer WPDISPLAY 
    7   (let ((s (cxml::chained-handler *html-sink*))) 
    8     (cxml::maybe-close-tag s) 
    9     (map nil (lambda (c) (cxml::write-rune c s)) str))) 
     7  (cxml::maybe-close-tag *html-sink*) 
     8  (map nil (lambda (c) (cxml::sink-write-rune c *html-sink*)) str)) 
    109 
    1110(defun language-options-1 (current-language) 
  • trunk/projects/bos/web/webserver.lisp

    r3374 r3398  
    2323;; and change the template name according to the outcome. 
    2424 
    25 (defmethod find-template-pathname ((Handler worldpay-template-handler) template-name) 
     25(defmethod find-template-pathname ((handler worldpay-template-handler) template-name) 
    2626  (cond 
    2727    ((scan #?r"(^|.*/)handle-sale" template-name)