Author: hhubner Date: 2006-12-03 08:26:32 -0500 (Sun, 03 Dec 2006) New Revision: 2104
Modified: trunk/projects/bos/m2/mail-generator.lisp trunk/projects/bos/m2/packages.lisp trunk/projects/bos/worldpay-test/sponsor-handlers.lisp Log: Send sponsor data mail for manually entered sponsors.
Modified: trunk/projects/bos/m2/mail-generator.lisp =================================================================== --- trunk/projects/bos/m2/mail-generator.lisp 2006-12-03 12:17:00 UTC (rev 2103) +++ trunk/projects/bos/m2/mail-generator.lisp 2006-12-03 13:26:32 UTC (rev 2104) @@ -150,6 +150,40 @@ :email (param 'email) :tel (param 'tel)))))
+(defun make-html-part (string) + (make-instance 'text-mime + :type "text" + :subtype "html" + :charset "utf-8" + :encoding :quoted-printable + :content string)) + +(defun make-contract-xml-part (id params) + (make-instance 'text-mime + :type "text" + :subtype (format nil "xml; name="contract-~A.xml"" id) + :charset "utf-8" + :encoding :quoted-printable + :content (format nil " +<sponsor> + ~{<~A>~A</~A>~} +</sponsor> +" + (apply #'append (mapcar #'(lambda (cons) + (list (car cons) + (if (find #\Newline (cdr cons)) + (format nil "<![CDATA[~A]]>" (cdr cons)) + (cdr cons)) + (car cons))) + params))))) + +(defun make-vcard-part (id vcard) + (make-instance 'text-mime + :type "text" + :subtype (format nil "x-vcard; name="contract-~A.vcf"" id) + :charset "utf-8" + :content vcard)) + (defun mail-contract-data (contract type mime-parts) (let ((parts mime-parts)) (unless (contract-download-only-p contract) @@ -175,16 +209,49 @@ (unless (contract-download-only-p contract) (delete-file (contract-pdf-pathname contract :print t))))
+(defun mail-backoffice-sponsor-data (contract req) + (with-query-params (req numsqm country email name address date language) + (let ((parts (list (make-html-part (format nil " +<html> + <body> + <h1>Manuell erfasste Sponsordate:</h1> + <table border="1"> + <tr><td>Contract-ID</td><td>~@[~A~]</td></tr> + <tr><td>Anzahl sqm</td><td>~A</td></tr> + <tr><td>Name</td><td>~@[~A~]</td></tr> + <tr><td>Adresse</td><td>~@[~A~]</td></tr> + <tr><td>Email</td><td>~@[~A~]</td></tr> + </table> + </body> +</html>" + (store-object-id contract) + numsqm + name + address + email)) + (make-contract-xml-part (store-object-id contract) (all-request-params req)) + (make-vcard-part (store-object-id contract) + (make-vcard :sponsor-id (store-object-id (contract-sponsor contract)) + :note (format nil "Paid-by: Back office +Contract ID: ~A +Sponsor ID: ~A +Number of sqms: ~A +Amount: EUR~A.00 +" + (store-object-id contract) + (store-object-id (contract-sponsor contract)) + numsqm + (* 3 (parse-integer numsqm))) + :name name + :address address + :email email))))) + (mail-contract-data contract "Manuell erfasster Sponsor" parts)))) + (defun mail-manual-sponsor-data (req) (with-query-params (req contract-id vorname name strasse plz ort email telefon donationcert-yearly) (let* ((contract (store-object-with-id (parse-integer contract-id))) (sponsor-id (store-object-id (contract-sponsor contract))) - (parts (list (make-instance 'text-mime - :type "text" - :subtype "html" - :charset "utf-8" - :encoding :quoted-printable - :content (format nil " + (parts (list (make-html-part (format nil " <html> <body> <h1>Ueberweisungsformulardaten:</h1> @@ -205,52 +272,32 @@ </body> </html> " - contract-id - (length (contract-m2s contract)) - vorname name strasse plz ort email telefon - (if donationcert-yearly "ja" "nein") - *website-url* contract-id email)) - (make-instance 'text-mime - :type "text" - :subtype (format nil "xml; name="contract-~A.xml"" contract-id) - :charset "utf-8" - :encoding :quoted-printable - :content (format nil " -<sponsor> - ~{<~A>~A</~A>~} -</sponsor> -" - (apply #'append (mapcar #'(lambda (cons) - (list (car cons) - (if (find #\Newline (cdr cons)) - (format nil "<![CDATA[~A]]>" (cdr cons)) - (cdr cons)) - (car cons))) - (all-request-params req))))) - (make-instance 'text-mime - :type "text" - :subtype (format nil "x-vcard; name="contract-~A.vcf"" contract-id) - :charset "utf-8" - :content (make-vcard :sponsor-id sponsor-id - :note (format nil "Paid-by: Manual money transfer + contract-id + (length (contract-m2s contract)) + vorname name strasse plz ort email telefon + (if donationcert-yearly "ja" "nein") + *website-url* contract-id email)) + (make-contract-xml-part contract-id (all-request-params req)) + (make-vcard-part contract-id (make-vcard :sponsor-id sponsor-id + :note (format nil "Paid-by: Manual money transfer Contract ID: ~A Sponsor ID: ~A Number of sqms: ~A Amount: EUR~A.00 Donationcert yearly: ~A " - contract-id - sponsor-id - (length (contract-m2s contract)) - (* 3 (length (contract-m2s contract))) - (if donationcert-yearly "Yes" "No")) - :vorname vorname - :nachname name - :strasse strasse - :postcode plz - :ort ort - :email email - :tel telefon))))) + contract-id + sponsor-id + (length (contract-m2s contract)) + (* 3 (length (contract-m2s contract))) + (if donationcert-yearly "Yes" "No")) + :vorname vorname + :nachname name + :strasse strasse + :postcode plz + :ort ort + :email email + :tel telefon))))) (mail-contract-data contract "Ueberweisungsformular" parts))))
(defvar *worldpay-params-hash* (make-hash-table :test #'equal)) @@ -269,12 +316,7 @@ (with-query-params (req contract-id) (let* ((contract (store-object-with-id (parse-integer contract-id))) (params (get-worldpay-params contract-id)) - (parts (list (make-instance 'text-mime - :type "text" - :subtype "html" - :charset "utf-8" - :encoding :quoted-printable - :content (format nil " + (parts (list (make-html-part (format nil " <table border="1"> <tr> <th>Parameter</th> @@ -283,30 +325,10 @@ ~{<tr><td>~A</td><td>~A</td></tr>~} </table> " - (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons))) - (sort (copy-list params) - #'string-lessp - :key #'car))))) - (make-instance 'text-mime - :type "text" - :subtype (format nil "xml; name="contract-~A.xml"" (store-object-id contract)) - :charset "utf-8" - :encoding :quoted-printable - :content (format nil " -<sponsor> - ~{<~A>~A</~A>~} -</sponsor> -" - (apply #'append (mapcar #'(lambda (cons) - (list (car cons) - (if (find #\Newline (cdr cons)) - (format nil "<![CDATA[~A]]>" (cdr cons)) - (cdr cons)) - (car cons))) - params)))) - (make-instance 'text-mime - :type "text" - :subtype (format nil "x-vcard; name="contract-~A.vcf"" (store-object-id contract)) - :charset "utf-8" - :content (worldpay-callback-params-to-vcard params))))) + (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons))) + (sort (copy-list params) + #'string-lessp + :key #'car))))) + (make-contract-xml-part contract-id params) + (make-vcard-part contract-id (worldpay-callback-params-to-vcard params))))) (mail-contract-data contract "WorldPay" parts))))
Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2006-12-03 12:17:00 UTC (rev 2103) +++ trunk/projects/bos/m2/packages.lisp 2006-12-03 13:26:32 UTC (rev 2104) @@ -184,6 +184,7 @@ #:mail-instructions-to-sponsor #:mail-info-request #:mail-manual-sponsor-data + #:mail-backoffice-sponsor-data #:mail-worldpay-sponsor-data
#:*cert-download-directory*))
Modified: trunk/projects/bos/worldpay-test/sponsor-handlers.lisp =================================================================== --- trunk/projects/bos/worldpay-test/sponsor-handlers.lisp 2006-12-03 12:17:00 UTC (rev 2103) +++ trunk/projects/bos/worldpay-test/sponsor-handlers.lisp 2006-12-03 13:26:32 UTC (rev 2104) @@ -84,17 +84,18 @@ (:tr (:td "Name for certificate") (:td (text-field "name" :size 20))) (:tr (:td "Postal address for certificate" - (:td (textarea-field "postaladdress" :rows 5 :cols 40)))) + (:td (textarea-field "address" :rows 5 :cols 40)))) (:tr (:td (submit-button "create" "create" :formcheck "javascript:return check_complete_sale()"))))))))
(defun date-to-universal (date-string) (apply #'encode-universal-time 0 0 0 (mapcar #'parse-integer (split #?r"." date-string))))
(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :create)) (sponsor (eql nil)) req) - (with-query-params (req numsqm country email name postaladdress date language) + (with-query-params (req numsqm country email name address date language) (let* ((sponsor (make-sponsor :email email :country country)) (contract (make-contract sponsor (parse-integer numsqm) :paidp t :date (date-to-universal date)))) - (contract-issue-cert contract name :address postaladdress :language language) + (contract-issue-cert contract name :address address :language language) + (mail-backoffice-sponsor-data contract req) (redirect (format nil "/edit-sponsor/~D" (store-object-id sponsor)) req))))
(defun contract-checkbox-name (contract)