[bknr-cvs] hans changed trunk/projects/quickhoney/src/pa

[BKNR Commits]

Revision: 3650
Author: hans
URL: http://bknr.net/trac/changeset/3650

Add beginnings of round-trip test environment for Paypal
Express Checkout.

U   trunk/projects/quickhoney/src/packages.lisp
A   trunk/projects/quickhoney/src/paypal-test.lisp
U   trunk/projects/quickhoney/src/paypal.lisp

Modified: trunk/projects/quickhoney/src/packages.lisp
===================================================================
--- trunk/projects/quickhoney/src/packages.lisp	2008-07-26 22:06:44 UTC (rev 3649)
+++ trunk/projects/quickhoney/src/packages.lisp	2008-07-27 10:07:06 UTC (rev 3650)
@@ -54,4 +54,9 @@
   (:export #:client-selectbox))
 
 (defpackage :paypal
+  (:use :cl)
+  (:export #:request
+           #:make-express-checkout-url))
+
+(defpackage :paypal-test
   (:use :cl))
\ No newline at end of file

Added: trunk/projects/quickhoney/src/paypal-test.lisp
===================================================================
--- trunk/projects/quickhoney/src/paypal-test.lisp	                        (rev 0)
+++ trunk/projects/quickhoney/src/paypal-test.lisp	2008-07-27 10:07:06 UTC (rev 3650)
@@ -0,0 +1,43 @@
+(in-package :paypal-test)
+
+(defgeneric dispatch-request (request-type request)
+  (:documentation "dispatch incoming http request"))
+
+(defmethod no-applicable-method ((function (eql #'dispatch-request)) &rest args)
+  (declare (ignore args))
+  nil)
+
+(defmacro define-handler (type (request) &body body)
+  (let ((request-type-var (gensym)))
+    `(defmethod dispatch-request ((,request-type-var (eql ,type)) ,request)
+       (declare (ignore ,request-type-var))
+       (lambda () , at body))))
+
+(defvar *response-host* nil)
+(defvar *response-port* nil)
+
+(define-handler :checkout (request)
+  (tbnl:redirect (paypal:make-express-checkout-url 10 :eur
+                                                   :returnurl (format nil "http://~A:~A/return-paypal" response-host response-port)
+                                                   :cancelurl (format nil "http://~A:~A/cancel-paypal" response-host response-port))))
+
+(define-handler :stop (request)
+  (throw 'stop-server nil))
+
+(define-handler :return-paypal (request)
+  "Returned from paypal")
+
+(define-handler :cancel-paypal (request)
+  "Cancelled")
+
+(defun dispatch-request% (request)
+  (let* ((type-string (cl-ppcre:scan-to-strings "[^/]+" (tbnl:script-name request)))
+         (request-type (and type-string (find-symbol (string-upcase type-string) :keyword))))
+    (dispatch-request request-type request)))
+
+(defun test-express-checkout (&key (response-port 2993) (response-host "127.0.0.1"))
+  (setf *response-host* response-host
+        *response-port* response-port)
+  (catch 'stop-server
+    (tbnl:start-server :port response-port
+                       :dispatch-table (list #'dispatch-request%))))

Modified: trunk/projects/quickhoney/src/paypal.lisp
===================================================================
--- trunk/projects/quickhoney/src/paypal.lisp	2008-07-26 22:06:44 UTC (rev 3649)
+++ trunk/projects/quickhoney/src/paypal.lisp	2008-07-27 10:07:06 UTC (rev 3650)
@@ -57,21 +57,20 @@
         (error 'request-error :response response))
       response)))
 
-(defun test-express-checkout ()
-  (let* ((amt "50.00")
-         (currencycode "EUR")
-         (returnurl "http://test.createrainforest.org/return-paypal")
-         (cancelurl "http://test.createrainforest.org/cancel-paypal")
+(defun make-express-checkout-url (amount currencycode returnurl cancelurl)
+  (let* ((amt (format nil "~,2F" amount))
+         (currencycode (symbol-name currencycode))
          (token (getf (request "SetExpressCheckout"
-                              :amt amt
-                              :currencycode currencycode
-                              :returnurl returnurl
-                              :cancelurl cancelurl
-                              :paymentaction "Sale")
-                     :token)))
-    (format *trace-output* "url: https://www.sandbox.paypal.com/webscr?cmd=_express-checkout&token=~A~
-                                 &AMT=~A&CURRENCYCODE=~A&RETURNURL=~A&CANCELURL=~A"
+                               :amt amt
+                               :currencycode currencycode
+                               :returnurl returnurl
+                               :cancelurl cancelurl
+                               :paymentaction "Sale")
+                      :token)))
+    (format nil "https://www.sandbox.paypal.com/webscr?cmd=_express-checkout&token=~A~
+                                    &AMT=~A&CURRENCYCODE=~A&RETURNURL=~A&CANCELURL=~A"
             (hunchentoot:url-encode token)
             amt currencycode
             (hunchentoot:url-encode returnurl)
-            (hunchentoot:url-encode cancelurl))))
\ No newline at end of file
+            (hunchentoot:url-encode cancelurl))))
+