Author: hhubner Date: 2006-03-12 15:22:19 -0500 (Sun, 12 Mar 2006) New Revision: 1923
Modified: branches/xml-class-rework/projects/bos/m2/m2.lisp branches/xml-class-rework/projects/bos/payment-website/templates/en/bestellung.xml branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp Log: All non-german donors get a download version of their donor certificate, no hardcopy will be mailed.
Modified: branches/xml-class-rework/projects/bos/m2/m2.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-03-12 20:07:24 UTC (rev 1922) +++ branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-03-12 20:22:19 UTC (rev 1923) @@ -269,7 +269,7 @@ (warn "Old tx-make-contract transaction used, contract dates may be wrong") (tx-do-make-contract sponsor m2-count :date date :paidp paidp :expires expires))
-(deftransaction do-make-contract (sponsor m2-count &key date paidp expires) +(deftransaction do-make-contract (sponsor m2-count &key date paidp expires download-only) (let ((m2s (find-free-m2s m2-count))) (if m2s (make-object 'contract @@ -277,14 +277,19 @@ :date date :paidp paidp :m2s m2s - :expires expires) + :expires expires + :download-only download-only) (warn "can't create contract, ~A square meters for ~A could not be allocated" m2-count sponsor))))
-(defun make-contract (sponsor m2-count &key (date (get-universal-time)) paidp (expires (+ (get-universal-time) *manual-contract-expiry-time*))) +(defun make-contract (sponsor m2-count + &key (date (get-universal-time)) + paidp + (expires (+ (get-universal-time) *manual-contract-expiry-time*)) + download-only) (unless (and (integerp m2-count) (plusp m2-count)) (error "number of square meters must be a positive integer")) - (let ((contract (do-make-contract sponsor m2-count :date date :paidp paidp :expires expires))) + (let ((contract (do-make-contract sponsor m2-count :date date :paidp paidp :expires expires :download-only download-only))) (unless contract (send-system-mail :subject "Contact creation failed - Allocation areas exhaused" :text (format nil "A contract for ~A square meters could not be created, presumably because no
Modified: branches/xml-class-rework/projects/bos/payment-website/templates/en/bestellung.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/en/bestellung.xml 2006-03-12 20:07:24 UTC (rev 1922) +++ branches/xml-class-rework/projects/bos/payment-website/templates/en/bestellung.xml 2006-03-12 20:22:19 UTC (rev 1923) @@ -63,6 +63,7 @@ <div id="content_main"> <div id="textbox_content_big" > <form name="bestellformular" method="post" action="buy-sqm"> + <input type="hidden" name="download-only" value="1" /> <table id="formTable" width="100%" border="0" cellspacing="0" cellpadding="0"> <tr> <td colspan="3">
Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-12 20:07:24 UTC (rev 1922) +++ branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-12 20:22:19 UTC (rev 1923) @@ -55,7 +55,7 @@ (html ((:base "href" href)))))
(define-bknr-tag buy-sqm (&key children) - (with-template-vars (numsqm numsqm1 action gift donationcert-yearly) + (with-template-vars (numsqm numsqm1 action gift donationcert-yearly download-only) (let* ((numsqm (parse-integer (or numsqm numsqm1))) ;; Wer ueber dieses Formular bestellt, ist ein neuer Sponsor, ;; also ein neues Sponsorenobjekt anlegen. Eine Profil-ID @@ -69,10 +69,12 @@ (scan #?r"rweisung" action))) (sponsor (make-sponsor)) (price (* numsqm 3)) - (contract (make-contract sponsor numsqm :expires (+ (if manual-transfer - bos.m2::*manual-contract-expiry-time* - bos.m2::*online-contract-expiry-time*) - (get-universal-time)))) + (contract (make-contract sponsor numsqm + :download-only download-only + :expires (+ (if manual-transfer + bos.m2::*manual-contract-expiry-time* + bos.m2::*online-contract-expiry-time*) + (get-universal-time)))) (language (session-variable :language))) (setf (get-template-var :worldpay-url) (if manual-transfer