[bknr-cvs] r2241 - in branches/bos/projects/bos: m2 payment-website payment-website/templates/da payment-website/templates/de payment-website/templates/en worldpay-test

bknr at bknr.net bknr at bknr.net
Sat Oct 20 09:41:07 UTC 2007


Author: hhubner
Date: 2007-10-20 05:40:58 -0400 (Sat, 20 Oct 2007)
New Revision: 2241

Added:
   branches/bos/projects/bos/payment-website/Manual-Regnskov (forside).doc
   branches/bos/projects/bos/payment-website/Manual_Regnskov.doc
   branches/bos/projects/bos/payment-website/templates/da/welcome-email.template
   branches/bos/projects/bos/payment-website/templates/de/welcome-email.template
   branches/bos/projects/bos/payment-website/templates/en/welcome-email.template
Modified:
   branches/bos/projects/bos/m2/m2.lisp
   branches/bos/projects/bos/m2/mail-generator.lisp
   branches/bos/projects/bos/m2/packages.lisp
   branches/bos/projects/bos/payment-website/templates/da/contact.xml
   branches/bos/projects/bos/payment-website/templates/da/info-request.xml
   branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml
   branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml
   branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp
   branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp
   branches/bos/projects/bos/worldpay-test/tags.lisp
   branches/bos/projects/bos/worldpay-test/worldpay-test.lisp
Log:
Store preferred language with sponsor.
Send welcome email for "manual transfer" sponsors in correct language.
Decide where to send sponsor data based on the country chosen during
WorldPay payment.  This way, swedish sponsors will be handled by the
danish office.
Website updates made by the danish office.


Modified: branches/bos/projects/bos/m2/m2.lisp
===================================================================
--- branches/bos/projects/bos/m2/m2.lisp	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/m2/m2.lisp	2007-10-20 09:40:58 UTC (rev 2241)
@@ -112,15 +112,17 @@
 ;;; SPONSOR-PASSWORD-ANSWER (sponsor) => string
 ;;; SPONSOR-INFO-TEXT (sponsor) => string
 ;;; SPONSOR-COUNTRY (sponsor) => string
+;;; SPONSOR-LANGUAGE (sponsor) => string (preferred language)
 ;;; SPONSOR-CONTRACTS (sponsor) => list of contract
 ;;;
 ;;; Sowie Funktionen von USER.
 
 (define-persistent-class sponsor (user)
-  ((master-code :read          :initform nil)
-   (info-text :update	       :initform nil)
-   (country :update	       :initform nil)
-   (contracts :update          :initform nil))
+  ((master-code :read :initform nil)
+   (info-text :update :initform nil)
+   (country :update :initform nil)
+   (contracts :update :initform nil)
+   (language :update :initform nil))
   (:default-initargs :full-name nil :email nil))
 
 (defmethod user-editable-p ((sponsor sponsor))
@@ -135,6 +137,13 @@
 (deftransaction sponsor-set-country (sponsor newval)
   (setf (sponsor-country sponsor) newval))
 
+(deftransaction sponsor-set-language (sponsor newval)
+  (setf (sponsor-language sponsor) newval))
+
+(defmethod sponsor-language :around ((sponsor sponsor))
+  (or (call-next-method)
+      "en"))
+
 (defvar *sponsor-counter* 0)
 
 (defun make-sponsor (&rest initargs &key login &allow-other-keys)

Modified: branches/bos/projects/bos/m2/mail-generator.lisp
===================================================================
--- branches/bos/projects/bos/m2/mail-generator.lisp	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/m2/mail-generator.lisp	2007-10-20 09:40:58 UTC (rev 2241)
@@ -2,12 +2,16 @@
 
 (enable-interpol-syntax)
 
-(defvar *country->office-email* '(("DK" . "service at bosdanmark.dk")))
+(defvar *country->office-email* '(("DK" . "bosdanmark.regnskov at gmail.com")
+				  ("SE" . "bosdanmark.regnskov at gmail.com")))
 
+(defun country->office-email (country)
+  (or (cdr (assoc country *country->office-email* :test #'string-equal))
+      *office-mail-address*))
+
 (defun contract-office-email (contract)
   "Return the email address of the MXM office responsible for handling a contract"
-  (or (cdr (assoc (sponsor-country (contract-sponsor contract)) *country->office-email* :test #'string-equal))
-      *office-mail-address*))
+  (country->office-email (sponsor-country (contract-sponsor contract))))
 
 (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
@@ -26,8 +30,9 @@
 		     (not more-headers)
 		     text)))
   
-(defun mail-info-request (email)
+(defun mail-info-request (email country)
   (send-system-mail :subject "Mailing list request"
+		    :to (country->office-email country)
 		    :text #?"Please enter into the mailing list:
 
 
@@ -37,46 +42,35 @@
 (defun mail-fiscal-certificate-to-office (contract name address country)
   (format t "mail-fiscal-certificate-to-office: ~a name: ~a address: ~a country: ~a~%" contract name address country))
 
-(defun mail-instructions-to-sponsor (contract email)
-  (let* ((sponsor (contract-sponsor contract))
-	 (sponsor-id (sponsor-id sponsor))
-	 (master-code (sponsor-master-code sponsor)))
-    (send-system-mail :to email
-		      :subject "Willkommen zur Samboja Lestari Informations-Website"
-		      :text #?"Sehr geehrte(r) Sponsor(in),
+(defun mail-template-directory (language)
+  "Return the directory where the mail templates are stored"
+  (merge-pathnames (make-pathname :directory `(:relative "templates" ,(string-downcase language)))
+		   (symbol-value (find-symbol "*WEBSITE-DIRECTORY*" "WORLDPAY-TEST"))))
 
-wir haben Ihr Sponsoren-Profil fuer Sie eingerichtet.
+(defun rest-of-file (file)
+  (let ((result (make-array (- (file-length file)
+			       (file-position file))
+			    :element-type 'character)))
+    (read-sequence result file)
+    result))
 
-Ihre Sponsoren-ID lautet: $(sponsor-id)
-Ihr Master-Code lautet: $(master-code)
+(defun make-welcome-mail (sponsor)
+  "Return a plist containing the :subject and :text options to generate an email with send-system-mail"
+  (let ((vars (list :sponsor-id (sponsor-id sponsor)
+		    :master-code (sponsor-master-code sponsor))))
+    (labels
+	((get-var (var-name) (getf vars var-name)))
+      (with-open-file (template (merge-pathnames #p"welcome-email.template"
+						 (mail-template-directory (sponsor-language sponsor))))
+	(let ((subject (expand-variables (read-line template) #'get-var))
+	      (text (expand-variables (rest-of-file template) #'get-var)))
+	  (list :subject subject :text text))))))
 
-Besuchen Sie unsere Website http://create-rainforest.org/ regelmaessig,
-um sich ein Bild darueber zu verschaffen, was auf \"Ihren\" Quadratmetern
-passiert.
+(defun mail-instructions-to-sponsor (contract email)
+  (apply #'send-system-mail
+	 :to email
+	 (make-welcome-mail (contract-sponsor contract))))
 
-Bedienungsanleitung:
-
-Mit Hilfe Ihrer Sponsoren-ID und Ihrem Kennwort oder auch Mastercode
-koennen Sie sich auf der Webseite in Ihr persoenliches Profil einloggen
-und \"Ihre\" Quadratmeter lokalisieren.
-Die Zugangsdaten können in der linken unteren Ecke der Satellitenkarte unter
-Sponsoren ID und Kennwort (oder Mastercode) eingegeben werden.
-Sie gelangen in ihr Profil indem sie nach dem Eingeben der Daten  das an
-gleicher Stelle erscheinende \"Profil-Feld\" anklicken.
-Es besteht zusaetzlich die Moeglichkeit für Sie, einen Grusstext zu
-hinterlegen,
-welcher fuer jeden Besucher dieser Webseite sichtbar wird, sofern dieser
-Besucher auf Ihre Quadratmeter in dem Vergroesserungsfenster klickt.
-Waehlen Sie in Ihrem Profil, ob Sie anonym bleiben wollen oder nicht.
-
-Wir wuenschen Ihnen viel Spass beim Lesen der Texte und betrachten der
-Bilder vom immer groesser werdenden Regenwald in Samboja Lestari - Borneo!
-
-Nochmals danken wir Ihnen im Namen der Orang-Utans und Malaienbaeren, sowie
-aller Waldbewohner und natuerlich der lokalen Bevoelkerung Indonesiens.
-
-Das Team von BOS Deutschland e.V.")))
-
 (defun format-vcard (field-list)
   (with-output-to-string (s)
     (labels
@@ -159,12 +153,12 @@
 		 :content string))
 
 (defparameter *common-element-names*
-  '(("MC_donationcert-yearly" "donationcert-yearly")
-    ("MC_sponsorid" "sponsor-id")
-    ("countryString" "country")
-    ("postcode" "plz")
-    ("MC_gift" "gift")
-    ("cartId" "contract-id")))
+  '(("MC_donationcert-yearly" . "donationcert-yearly")
+    ("MC_sponsorid" . "sponsor-id")
+    ("countryString" . "country")
+    ("postcode" . "plz")
+    ("MC_gift" . "gift")
+    ("cartId" . "contract-id")))
 
 (defun lookup-element-name (element-name)
   "Given an ELEMENT-NAME (which may be either a form field name or a name of a post parameter from
@@ -180,9 +174,11 @@
 		 :encoding :quoted-printable
 		 :content (format nil "
 <sponsor>
+ <date>~A</date>
  ~{<~A>~A</~A>~}
 </sponsor>
 "
+				  (format-date-time (get-universal-time) :xml-style t)
 				  (apply #'append
 					 (mapcar #'(lambda (cons)
 						     (destructuring-bind (element-name . content) cons
@@ -238,6 +234,8 @@
    <tr><td>Name</td><td>~@[~A~]</td></tr>
    <tr><td>Adress</td><td>~@[~A~]</td></tr>
    <tr><td>Email</td><td>~@[~A~]</td></tr>
+   <tr><td>Country</td><td>~@[~A~]</td></tr>
+   <tr><td>Language</td><td>~@[~A~]</td></tr>
   </table>
  </body>
 </html>"
@@ -245,7 +243,9 @@
 					       numsqm
 					       name
 					       address
-					       email))
+					       email
+					       country
+					       language))
 		       (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))

Modified: branches/bos/projects/bos/m2/packages.lisp
===================================================================
--- branches/bos/projects/bos/m2/packages.lisp	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/m2/packages.lisp	2007-10-20 09:40:58 UTC (rev 2241)
@@ -85,11 +85,14 @@
            #:sponsor-info-text
            #:sponsor-country
            #:sponsor-contracts
+	   #:sponsor-id
+	   #:sponsor-language
            #:sponsor-set-info-text
            #:sponsor-set-country
-	   #:sponsor-id
+	   #:sponsor-set-language
 	   #:country
 	   #:info-text
+	   #:language
 
 	   #:editor-only-handler
 	   #:editor-p

Added: branches/bos/projects/bos/payment-website/Manual-Regnskov (forside).doc
===================================================================
(Binary files differ)


Property changes on: branches/bos/projects/bos/payment-website/Manual-Regnskov (forside).doc
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/bos/projects/bos/payment-website/Manual_Regnskov.doc
===================================================================
(Binary files differ)


Property changes on: branches/bos/projects/bos/payment-website/Manual_Regnskov.doc
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Modified: branches/bos/projects/bos/payment-website/templates/da/contact.xml
===================================================================
--- branches/bos/projects/bos/payment-website/templates/da/contact.xml	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/payment-website/templates/da/contact.xml	2007-10-20 09:40:58 UTC (rev 2241)
@@ -27,8 +27,8 @@
 						Fax:       3537 3636<br></br><br></br>
 						E-Mail:
 						<img src="/images/pfeil_link_on.gif" width="10" height="9" alt=""></img>
-						<a href="mailto:bos at orangutang.dk" class="more">
-							bos at orangutang.dk
+						<a href="mailto:regnskov at bosdanmark.dk" class="more">
+							regnskov at bosdanmark.dk
 						</a>
 						<br></br><br></br><br></br><br></br><br></br><br></br>
 						Vi besvarer alle henvendelser hurtigst muligt.

Modified: branches/bos/projects/bos/payment-website/templates/da/info-request.xml
===================================================================
--- branches/bos/projects/bos/payment-website/templates/da/info-request.xml	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/payment-website/templates/da/info-request.xml	2007-10-20 09:40:58 UTC (rev 2241)
@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" >
 <bknr:toplevel template="toplevel_extra" title="Regnskov i SAMBOJA LESTARI - Nyheder" xmlns="http://www.w3.org/1999/xhtml" xmlns:bknr="http://bknr.net" xmlns:bos="http://headcraft.de/bos">
-	<bos:send-info-request email="$(email)">
+	<bos:send-info-request email="$(email)" country="DK">
 		<p>
 			<span class="headline">
 				Vi takker for din interesse.

Modified: branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml
===================================================================
--- branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml	2007-10-20 09:40:58 UTC (rev 2241)
@@ -43,6 +43,7 @@
 						onsubmit="YY_checkform('mailtransfer','vorname','#q','0','Anuller venligst dette felt \'Fornavn\'.','name','#q','0','Anuller venligst dette felt \'Efternavn\'.','strasse','#q','0','Anuller venligst dette felt \'Gade/Nr.\'.','plz','#q','0','Anuller venligst dette felt \'Postnummer\'.','ort','#q','0','Anuller venligst dette felt \'Kommune\'.');return document.MM_returnValue">
 					<input type="hidden" name="country" value="DK" />
 					<input type="hidden" name="contract-id" value="$(contract-id)" />
+					<input type="hidden" name="sponsor-id" value="$(sponsor-id)" />
 					<input type="hidden" name="amount" value="$(amount)" />
 					<input type="hidden" name="numsqm" value="$(numsqm)" />
 					<input type="hidden" name="gift" value="$(gift)" />

Added: branches/bos/projects/bos/payment-website/templates/da/welcome-email.template
===================================================================
--- branches/bos/projects/bos/payment-website/templates/da/welcome-email.template	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/payment-website/templates/da/welcome-email.template	2007-10-20 09:40:58 UTC (rev 2241)
@@ -0,0 +1,35 @@
+Velkommen til BOS Denmark
+Kære sponsor 
+
+Velkommen til BOS Danmark. Vi takker mange gange for din donation og
+deltagelse i skovrejsningsprojektet i Samboja Lestari
+
+Følgende sponsorprofil er blevet oprettet til dig:
+
+Dit Sponsor ID: $(sponsor-id)
+Din Masterkode: $(master-code)
+
+
+Betjeningsvejledning
+
+Ved hjælp af dit sponsor-ID og masterkode kan du på websiden
+
+http://create-rainforest.org/ logge dig ind på din personlige profil
+og lokalisere dine m2. Under "satellitkort" kan adgangsdata indføres i
+nederste venstre hjørne ved sponsor ID og masterkodefeltet. Du når
+dernæst til din profil ved at klikke på det fremkommende "profil". Du
+har her mulighed for at vedlægge en hilsen, der vil være synlig for
+alle de besøgende på web-siden, som klikker ind på dine m2 i
+forstørrelsesvinduet, samt ligeledes mulighed for at hente dit
+regnskovsdiplom ned i form af en pdf-fil. Vælg også i profilen,
+hvorvidt du vil være anonym.
+
+Vi ønsker dig god fornøjelse med at læse om og se billeder fra et
+stadigt voksende regnskovsområde i Samboja Lestari - Borneo!
+
+På vegne af orangutangerne og regnskovens øvrige dyr og planter samt
+naturligvis den lokale indonesiske befolkning, takker vi endnu engang
+for din donation.
+ 
+
+BOS Danmark
\ No newline at end of file

Modified: branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml
===================================================================
--- branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml	2007-10-20 09:40:58 UTC (rev 2241)
@@ -42,6 +42,7 @@
 						id="mailtransfer"
 						onsubmit="YY_checkform('mailtransfer','vorname','#q','0','Bitte das Feld \'Vorname\' ausfuellen.','name','#q','0','Bitte das Feld \'Name\' ausfuellen.','strasse','#q','0','Bitte das Feld \'Strasse\' ausfuellen.','plz','#q','0','Bitte das Feld \'PLZ\' ausfuellen.','ort','#q','0','Bitte das Feld \'Ort\' ausfuellen.');return document.MM_returnValue">
 					<input type="hidden" name="contract-id" value="$(contract-id)" />
+					<input type="hidden" name="sponsor-id" value="$(sponsor-id)" />
 					<input type="hidden" name="amount" value="$(amount)" />
 					<input type="hidden" name="numsqm" value="$(numsqm)" />
 					<input type="hidden" name="gift" value="$(gift)" />

Added: branches/bos/projects/bos/payment-website/templates/de/welcome-email.template
===================================================================
--- branches/bos/projects/bos/payment-website/templates/de/welcome-email.template	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/payment-website/templates/de/welcome-email.template	2007-10-20 09:40:58 UTC (rev 2241)
@@ -0,0 +1,33 @@
+Willkommen zur Samboja Lestari Informations-Website
+Sehr geehrte(r) Sponsor(in),
+
+wir haben Ihr Sponsoren-Profil fuer Sie eingerichtet.
+
+Ihre Sponsoren-ID lautet: $(sponsor-id)
+Ihr Master-Code lautet: $(master-code)
+
+Besuchen Sie unsere Website http://create-rainforest.org/ regelmäßig,
+um sich ein Bild darüber zu verschaffen, was auf "Ihren" Quadratmetern
+passiert.
+
+Bedienungsanleitung:
+
+Mit Hilfe Ihrer Sponsoren-ID und Ihrem Kennwort oder auch Mastercode
+können Sie sich auf der Webseite in Ihr persönliches Profil
+einloggen und "Ihre" Quadratmeter lokalisieren.  Die Zugangsdaten
+können in der linken unteren Ecke der Satellitenkarte unter Sponsoren
+ID und Kennwort (oder Mastercode) eingegeben werden.  Sie gelangen in
+ihr Profil indem sie nach dem Eingeben der Daten das an gleicher
+Stelle erscheinende "Profil-Feld" anklicken.  Es besteht zusätzlich
+die Möglichkeit für Sie, einen Grußtext zu hinterlegen, welcher für
+jeden Besucher dieser Webseite sichtbar wird, sofern dieser Besucher
+auf Ihre Quadratmeter in dem Vergrößerungsfenster klickt.  Wählen
+Sie in Ihrem Profil, ob Sie anonym bleiben wollen oder nicht.
+
+Wir wünschen Ihnen viel Spaß beim Lesen der Texte und betrachten der
+Bilder vom immer größer werdenden Regenwald in Samboja Lestari - Borneo!
+
+Nochmals danken wir Ihnen im Namen der Orang-Utans und Malaienbären, sowie
+aller Waldbewohner und natürlich der lokalen Bevölkerung Indonesiens.
+
+Das Team von BOS Deutschland e.V.

Added: branches/bos/projects/bos/payment-website/templates/en/welcome-email.template
===================================================================
--- branches/bos/projects/bos/payment-website/templates/en/welcome-email.template	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/payment-website/templates/en/welcome-email.template	2007-10-20 09:40:58 UTC (rev 2241)
@@ -0,0 +1,33 @@
+Willkommen zur Samboja Lestari Informations-Website
+Sehr geehrte(r) Sponsor(in),
+
+wir haben Ihr Sponsoren-Profil fuer Sie eingerichtet.
+
+Ihre Sponsoren-ID lautet: $(sponsor-id)
+Ihr Master-Code lautet: $(master-code)
+
+Besuchen Sie unsere Website http://create-rainforest.org/ regelmäßig,
+um sich ein Bild darüber zu verschaffen, was auf "Ihren" Quadratmetern
+passiert.
+
+Bedienungsanleitung:
+
+Mit Hilfe Ihrer Sponsoren-ID und Ihrem Kennwort oder auch Mastercode
+können Sie sich auf der Webseite in Ihr persönliches Profil
+einloggen und "Ihre" Quadratmeter lokalisieren.  Die Zugangsdaten
+können in der linken unteren Ecke der Satellitenkarte unter Sponsoren
+ID und Kennwort (oder Mastercode) eingegeben werden.  Sie gelangen in
+ihr Profil indem sie nach dem Eingeben der Daten das an gleicher
+Stelle erscheinende "Profil-Feld" anklicken.  Es besteht zusätzlich
+die Möglichkeit für Sie, einen Grußtext zu hinterlegen, welcher für
+jeden Besucher dieser Webseite sichtbar wird, sofern dieser Besucher
+auf Ihre Quadratmeter in dem Vergrößerungsfenster klickt.  Wählen
+Sie in Ihrem Profil, ob Sie anonym bleiben wollen oder nicht.
+
+Wir wünschen Ihnen viel Spaß beim Lesen der Texte und betrachten der
+Bilder vom immer größer werdenden Regenwald in Samboja Lestari - Borneo!
+
+Nochmals danken wir Ihnen im Namen der Orang-Utans und Malaienbären, sowie
+aller Waldbewohner und natürlich der lokalen Bevölkerung Indonesiens.
+
+Das Team von BOS Deutschland e.V.

Modified: branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp
===================================================================
--- branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp	2007-10-20 09:40:58 UTC (rev 2241)
@@ -230,7 +230,7 @@
 (defun parse-point (line)
   (destructuring-bind (x y) (read-from-string (format nil "(~A)" line))
     (cons (scale-coordinate 'x +nw-utm-x+ x)
-	  (scale-coordinate 'y +nw-utm-y+ y))))
+	  (scale-coordinate 'y +nw-utm-y+ (- y +width+)))))
 
 (defun polygon-from-text-file (filename)
   (coerce (with-open-file (input-file filename)

Modified: branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp
===================================================================
--- branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp	2007-10-20 09:40:58 UTC (rev 2241)
@@ -19,6 +19,23 @@
       (contract (contract-sponsor object))
       (otherwise nil))))
 
+(defmethod language-selector ((language string))
+  (html
+   ((:select :name "language")
+    (loop
+       for (language-symbol language-name) in (website-languages)
+       do (if (string-equal language-symbol language)
+	      (html ((:option :value language-symbol :selected "selected")
+		     (:princ-safe language-name)))
+	      (html ((:option :value language-symbol)
+		     (:princ-safe language-name))))))))
+
+(defmethod language-selector ((sponsor sponsor))
+  (language-selector (sponsor-language sponsor)))
+
+(defmethod language-selector ((contract contract))
+  (language-selector (contract-sponsor contract)))
+
 (defmethod handle-object-form ((handler edit-sponsor-handler) action (sponsor (eql nil)) req)
   (with-query-params (req id key count)
     (when id
@@ -76,11 +93,8 @@
             (:td (text-field "country" :size 2 :value "DE")))
        (:tr (:td "Email-Address")
 	    (:td (text-field "email" :size 40)))
-       (:tr (:td "Language for certificate")
-            (:td ((:select :name "language")
-                  (loop
-                     for (language-symbol language-name) in (website-languages)
-                     do (html ((:option :value language-symbol) (:princ-safe language-name)))))))
+       (:tr (:td "Language for communication and certificate")
+            (:td (language-selector "en")))
        (:tr (:td "Name for certificate")
 	    (:td (text-field "name" :size 20)))
        (:tr (:td "Postal address for certificate")
@@ -94,7 +108,7 @@
 
 (defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :create)) (sponsor (eql nil)) req)
   (with-query-params (req numsqm country email name address date language)
-    (let* ((sponsor (make-sponsor :email email :country country))
+    (let* ((sponsor (make-sponsor :email email :country country :language language))
 	   (contract (make-contract sponsor (parse-integer numsqm)
 				    :paidp (format nil "~A: manually created by ~A"
 						   (format-date-time (get-universal-time))
@@ -128,6 +142,8 @@
 	    (:td (text-field "country"
 			     :value (sponsor-country sponsor)
 			     :size 2)))
+       (:tr (:td "language")
+	    (:td (language-selector sponsor)))
        (:tr (:td "info-text")
 	    (:td (textarea-field "info-text"
 				 :value (sponsor-info-text sponsor)
@@ -159,7 +175,7 @@
 (defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :save)) sponsor req)
   (let (changed)
     (with-bos-cms-page (req :title "Saving sponsor data")
-      (dolist (field-name '(full-name email password country info-text))
+      (dolist (field-name '(full-name email password country language info-text))
 	(let ((field-value (query-param req (string-downcase (symbol-name field-name)))))
 	  (when (and field-value
 		     (not (equal field-value (slot-value sponsor field-name))))
@@ -208,16 +224,13 @@
 	       (:tr (:td "Country code (2 chars)")
 		    (:td (text-field "country" :size 2 :value "DE")))
 	       (:tr (:td "Language")
-		    (:td ((:select :name "language")
-			  (loop
-			     for (language-symbol language-name) in (website-languages)
-			     do (html ((:option :value language-symbol) (:princ-safe language-name)))))))
+		    (:td (:princ-safe (sponsor-language (contract-sponsor contract)))))
 	       (:tr (:td "Email-Address")
 		    (:td (text-field "email" :size 20 :value email)))
 	       (:tr (:td (submit-button "process" "process" :formcheck "javascript:return check_complete_sale()")))))))))))
 
 (defmethod handle-object-form ((handler complete-transfer-handler) (action (eql :process)) contract req)
-  (with-query-params (req email country language)
+  (with-query-params (req email country)
     (with-bos-cms-page (req :title "Square meter sale completion")
       (if (contract-paidp contract)
 	  (html (:h2 "This sale has already been completed"))
@@ -298,10 +311,7 @@
        (:tr (:td "Name")
 	    (:td (text-field "name" :size 40)))
        (:tr (:td "Language")
-            (:td ((:select :name "language")
-                  (loop
-                     for (language-symbol language-name) in (website-languages)
-                     do (html ((:option :value language-symbol) (:princ-safe language-name)))))))
+            (:td (language-selector contract)))
        (unless (contract-download-only-p contract)
          (html
 	  (:tr (:td "Address")

Modified: branches/bos/projects/bos/worldpay-test/tags.lisp
===================================================================
--- branches/bos/projects/bos/worldpay-test/tags.lisp	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/worldpay-test/tags.lisp	2007-10-20 09:40:58 UTC (rev 2241)
@@ -71,14 +71,14 @@
 	       (manual-transfer (or (scan #?r"rweisen" action)
 				    (scan #?r"rweisung" action)
 				    (scan #?r"verf" action)))
-	       (sponsor (make-sponsor))
+	       (language (session-variable :language))
+	       (sponsor (make-sponsor :language language))
 	       (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)))
+						    (get-universal-time)))))
 	  (destructuring-bind (price currency)
 	      (case (make-keyword-from-string language)
 		(:da (list (* numsqm 24) "DKK"))
@@ -135,8 +135,8 @@
     (when (some #'contract-pdf-pathname (sponsor-contracts sponsor))
       (mapc #'emit-template-node children))))
 
-(define-bknr-tag send-info-request (&key children email)
-  (mail-info-request email)
+(define-bknr-tag send-info-request (&key children email country)
+  (mail-info-request email (or country "DE"))
   (mapc #'emit-template-node children))
 
 (define-bknr-tag save-profile (&key children)

Modified: branches/bos/projects/bos/worldpay-test/worldpay-test.lisp
===================================================================
--- branches/bos/projects/bos/worldpay-test/worldpay-test.lisp	2007-10-14 20:28:22 UTC (rev 2240)
+++ branches/bos/projects/bos/worldpay-test/worldpay-test.lisp	2007-10-20 09:40:58 UTC (rev 2241)
@@ -29,6 +29,7 @@
 	(setf lang *default-language*))
       (bos.m2::remember-worldpay-params cartId (all-request-params request))
       (let ((contract (get-contract (parse-integer cartId))))
+	(sponsor-set-language (contract-sponsor contract) lang)
 	(cond
 	  ((not (typep contract 'contract))
 	   (user-error "Error: Invalid transaction ID."))




More information about the Bknr-cvs mailing list