[bknr-cvs] r2014 - in branches/xml-class-rework/projects/bos: m2 worldpay-test

[bknr at bknr.net]

Author: hhubner
Date: 2006-10-20 16:02:19 -0400 (Fri, 20 Oct 2006)
New Revision: 2014

Modified:
   branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
   branches/xml-class-rework/projects/bos/worldpay-test/poi-handlers.lisp
Log:
Mail VCF file with sponsor data in WorldPay callback


Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-20 13:13:48 UTC (rev 2013)
+++ branches/xml-class-rework/projects/bos/m2/mail-generator.lisp	2006-10-20 20:02:19 UTC (rev 2014)
@@ -2,25 +2,17 @@
 
 (enable-interpol-syntax)
 
-(defun make-mail-header (&key from to subject (date (format-date-time (get-universal-time) :mail-style t)) (content-type "text/plain; charset=utf-8"))
-  (format nil "X-Mailer: BKNR-BOS-mailer
-Date: ~a
-From: ~a
-To: ~a
-Subject: ~a
-Content-Type: ~a
-
-"
-	  date from to subject content-type))
-
-(defun send-system-mail (&key (to *office-mail-address*) (subject "(no subject") (text "(no text)") (content-type "text/plain; charset=UTF-8"))
+(defun send-system-mail (&key (to *office-mail-address*) (subject "(no subject") (text "(no text)") (content-type "text/plain; charset=UTF-8") more-headers)
   (send-smtp "localhost" *mail-sender* to
-	     (make-mail-header :from *mail-sender*
-			       :to to
-			       :subject subject
-			       :content-type content-type)
-	     text))
-
+	     (format nil "X-Mailer: BKNR-BOS-mailer
+Date: ~A
+From: ~A
+To: ~A
+Subject: ~A
+Content-Type: ~A
+~@[~%~]~A"
+		     (format-date-time (get-universal-time) :mail-style t) *mail-sender* to subject content-type (not more-headers) text)))
+  
 (defun mail-info-request (email)
   (send-system-mail :subject "Mailinglisten-Eintrag"
 		    :text #?"Bitte in die Info-Mailingliste aufnehmen:
@@ -126,23 +118,41 @@
 				    contract-id))))
 
 (defun worldpay-callback-request-to-vcard (request)
-  (with-query-params (request
-		      cartId
-		      transId
-		      MC_sponsorid
-		      MC_donationcert-yearly
-		      MC_gift
-		      address
-		      postcode
-		      country
-		      email
-		      tel)))
+  (with-query-params (request cartId
+			      transId
+			      MC_sponsorid
+			      MC_donationcert-yearly
+			      MC_gift
+			      name
+			      address
+			      postcode
+			      country
+			      email
+			      tel)
+    (with-output-to-string (s)
+      (format s "BEGIN:VCARD~%")
+      (format s "REV:~A~%" (format-date-time (get-universal-time) :xml-style t))
+      (format s "VERSION:2.1~%")
+      (format s "FN:~A~%" name)
+      (format s "ADR;DOM;HOME;ENCODING=QUOTED-PRINTABLE:;;~A;;;~A;~A~%" (regex-replace-all #?r"\r?\n" address "=0D=0A") postcode country)
+      (format s "TEL;WORK;HOME:~A~%" tel)
+      (format s "EMAIL;PREF;INTERNET:~A~%" email)
+      (format s "URL;WORK:~A/edit-sponsor/~A~%" worldpay-test::*website-url* MC_sponsorid)
+      (format s "NOTE:Contract ID: ~A  Sponsor ID: ~A  WorldPay Transaction ID: ~A  Donationcert yearly: ~A  Gift: ~A~%"
+	      cartId
+	      MC_sponsorid
+	      transId
+	      (if MC_donationcert-yearly "Yes" "No")
+	      (if MC_gift "Yes" "No"))
+      (format s "END:VCARD~%"))))
 
-
 (defun mail-request-parameters (req subject)
-  (send-system-mail :subject subject
-		    :content-type "text/html; charset=UTF-8"
-		    :text (format nil "
+  (let ((mime (make-instance 'cl-mime:multipart-mime
+			     :subtype "mixed"
+			     :content (list (make-instance 'cl-mime:text-mime
+							   :type "text"
+							   :subtype "html"
+							   :content (format nil "
 <table border=\"1\">
  <tr>
   <th>Parameter</th>
@@ -151,4 +161,13 @@
  ~{<tr><td>~A</td><td>~A</td></tr>~}
 </table>
 "
-				  (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons))) (all-request-params req))))))
+									    (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons)))
+												    (all-request-params req)))))
+					    (make-instance 'cl-mime:text-mime
+							   :type "text"
+							   :subtype "x-vcard"
+							   :content (worldpay-callback-request-to-vcard req))))))
+    (send-system-mail :subject subject
+		      :content-type "multipart/mixed"
+		      :more-headers t
+		      :text (with-output-to-string (s) (cl-mime:print-mime s mime t t)))))

Modified: branches/xml-class-rework/projects/bos/worldpay-test/poi-handlers.lisp
===================================================================
--- branches/xml-class-rework/projects/bos/worldpay-test/poi-handlers.lisp	2006-10-20 13:13:48 UTC (rev 2013)
+++ branches/xml-class-rework/projects/bos/worldpay-test/poi-handlers.lisp	2006-10-20 20:02:19 UTC (rev 2014)
@@ -213,7 +213,7 @@
       ; just open the image to make sure that gd can process it
       )
     (change-slot-values poi 'panoramas (list (import-image uploaded-file
-							:class-name 'store-image))))
+							   :class-name 'store-image))))
   (redirect (format nil "/edit-poi/~D"
 		    (store-object-id poi)) req))