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))