[bknr-cvs] r1923 - in branches/xml-class-rework/projects/bos: m2 payment-website/templates/en worldpay-test

[bknr at bknr.net]

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