Changeset 2241

Show
Ignore:
Timestamp:
10/20/07 11:40:58 (1 year ago)
Author:
hhubner
Message:

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.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • branches/bos/projects/bos/m2/m2.lisp

    r2175 r2241  
    113113;;; SPONSOR-INFO-TEXT (sponsor) => string 
    114114;;; SPONSOR-COUNTRY (sponsor) => string 
     115;;; SPONSOR-LANGUAGE (sponsor) => string (preferred language) 
    115116;;; SPONSOR-CONTRACTS (sponsor) => list of contract 
    116117;;; 
    …… 
    118119 
    119120(define-persistent-class sponsor (user) 
    120   ((master-code :read          :initform nil) 
    121    (info-text :update          :initform nil) 
    122    (country :update            :initform nil) 
    123    (contracts :update          :initform nil)) 
     121  ((master-code :read :initform nil) 
     122   (info-text :update :initform nil) 
     123   (country :update :initform nil) 
     124   (contracts :update :initform nil) 
     125   (language :update :initform nil)) 
    124126  (:default-initargs :full-name nil :email nil)) 
    125127 
    …… 
    135137(deftransaction sponsor-set-country (sponsor newval) 
    136138  (setf (sponsor-country sponsor) newval)) 
     139 
     140(deftransaction sponsor-set-language (sponsor newval) 
     141  (setf (sponsor-language sponsor) newval)) 
     142 
     143(defmethod sponsor-language :around ((sponsor sponsor)) 
     144  (or (call-next-method) 
     145      "en")) 
    137146 
    138147(defvar *sponsor-counter* 0) 

  • branches/bos/projects/bos/m2/mail-generator.lisp

    r2173 r2241  
    33(enable-interpol-syntax) 
    44 
    5 (defvar *country->office-email* '(("DK" . "service@bosdanmark.dk"))) 
     5(defvar *country->office-email* '(("DK" . "bosdanmark.regnskov@gmail.com") 
     6                                  ("SE" . "bosdanmark.regnskov@gmail.com"))) 
     7 
     8(defun country->office-email (country) 
     9  (or (cdr (assoc country *country->office-email* :test #'string-equal)) 
     10      *office-mail-address*)) 
    611 
    712(defun contract-office-email (contract) 
    813  "Return the email address of the MXM office responsible for handling a contract" 
    9   (or (cdr (assoc (sponsor-country (contract-sponsor contract)) *country->office-email* :test #'string-equal)) 
    10       *office-mail-address*)) 
     14  (country->office-email (sponsor-country (contract-sponsor contract)))) 
    1115 
    1216(defun send-system-mail (&key (to *office-mail-address*) (subject "(no subject") (text "(no text)") (content-type "text/plain; charset=UTF-8") more-headers) 
    …… 
    2731                     text))) 
    2832   
    29 (defun mail-info-request (email) 
     33(defun mail-info-request (email country) 
    3034  (send-system-mail :subject "Mailing list request" 
     35                    :to (country->office-email country) 
    3136                    :text #?"Please enter into the mailing list: 
    3237 
    …… 
    3843  (format t "mail-fiscal-certificate-to-office: ~a name: ~a address: ~a country: ~a~%" contract name address country)) 
    3944 
     45(defun mail-template-directory (language) 
     46  "Return the directory where the mail templates are stored" 
     47  (merge-pathnames (make-pathname :directory `(:relative "templates" ,(string-downcase language))) 
     48                   (symbol-value (find-symbol "*WEBSITE-DIRECTORY*" "WORLDPAY-TEST")))) 
     49 
     50(defun rest-of-file (file) 
     51  (let ((result (make-array (- (file-length file) 
     52                               (file-position file)) 
     53                            :element-type 'character))) 
     54    (read-sequence result file) 
     55    result)) 
     56 
     57(defun make-welcome-mail (sponsor) 
     58  "Return a plist containing the :subject and :text options to generate an email with send-system-mail" 
     59  (let ((vars (list :sponsor-id (sponsor-id sponsor) 
     60                    :master-code (sponsor-master-code sponsor)))) 
     61    (labels 
     62        ((get-var (var-name) (getf vars var-name))) 
     63      (with-open-file (template (merge-pathnames #p"welcome-email.template" 
     64                                                 (mail-template-directory (sponsor-language sponsor)))) 
     65        (let ((subject (expand-variables (read-line template) #'get-var)) 
     66              (text (expand-variables (rest-of-file template) #'get-var))) 
     67          (list :subject subject :text text)))))) 
     68 
    4069(defun mail-instructions-to-sponsor (contract email) 
    41   (let* ((sponsor (contract-sponsor contract)) 
    42          (sponsor-id (sponsor-id sponsor)) 
    43          (master-code (sponsor-master-code sponsor))) 
    44     (send-system-mail :to email 
    45                       :subject "Willkommen zur Samboja Lestari Informations-Website" 
    46                       :text #?"Sehr geehrte(r) Sponsor(in), 
    47  
    48 wir haben Ihr Sponsoren-Profil fuer Sie eingerichtet. 
    49  
    50 Ihre Sponsoren-ID lautet: $(sponsor-id) 
    51 Ihr Master-Code lautet: $(master-code) 
    52  
    53 Besuchen Sie unsere Website http://create-rainforest.org/ regelmaessig, 
    54 um sich ein Bild darueber zu verschaffen, was auf \"Ihren\" Quadratmetern 
    55 passiert. 
    56  
    57 Bedienungsanleitung: 
    58  
    59 Mit Hilfe Ihrer Sponsoren-ID und Ihrem Kennwort oder auch Mastercode 
    60 koennen Sie sich auf der Webseite in Ihr persoenliches Profil einloggen 
    61 und \"Ihre\" Quadratmeter lokalisieren. 
    62 Die Zugangsdaten können in der linken unteren Ecke der Satellitenkarte unter 
    63 Sponsoren ID und Kennwort (oder Mastercode) eingegeben werden. 
    64 Sie gelangen in ihr Profil indem sie nach dem Eingeben der Daten  das an 
    65 gleicher Stelle erscheinende \"Profil-Feld\" anklicken. 
    66 Es besteht zusaetzlich die Moeglichkeit fÃŒr Sie, einen Grusstext zu 
    67 hinterlegen, 
    68 welcher fuer jeden Besucher dieser Webseite sichtbar wird, sofern dieser 
    69 Besucher auf Ihre Quadratmeter in dem Vergroesserungsfenster klickt. 
    70 Waehlen Sie in Ihrem Profil, ob Sie anonym bleiben wollen oder nicht. 
    71  
    72 Wir wuenschen Ihnen viel Spass beim Lesen der Texte und betrachten der 
    73 Bilder vom immer groesser werdenden Regenwald in Samboja Lestari - Borneo! 
    74  
    75 Nochmals danken wir Ihnen im Namen der Orang-Utans und Malaienbaeren, sowie 
    76 aller Waldbewohner und natuerlich der lokalen Bevoelkerung Indonesiens. 
    77  
    78 Das Team von BOS Deutschland e.V."))) 
     70  (apply #'send-system-mail 
     71         :to email 
     72         (make-welcome-mail (contract-sponsor contract)))) 
    7973 
    8074(defun format-vcard (field-list) 
    …… 
    160154 
    161155(defparameter *common-element-names* 
    162   '(("MC_donationcert-yearly" "donationcert-yearly") 
    163     ("MC_sponsorid" "sponsor-id") 
    164     ("countryString" "country") 
    165     ("postcode" "plz") 
    166     ("MC_gift" "gift") 
    167     ("cartId" "contract-id"))) 
     156  '(("MC_donationcert-yearly" . "donationcert-yearly") 
     157    ("MC_sponsorid" . "sponsor-id") 
     158    ("countryString" . "country") 
     159    ("postcode" . "plz") 
     160    ("MC_gift" . "gift") 
     161    ("cartId" . "contract-id"))) 
    168162 
    169163(defun lookup-element-name (element-name) 
    …… 
    181175                 :content (format nil " 
    182176<sponsor> 
     177 <date>~A</date> 
    183178 ~{<~A>~A</~A>~} 
    184179</sponsor> 
    185180" 
     181                                  (format-date-time (get-universal-time) :xml-style t) 
    186182                                  (apply #'append 
    187183                                         (mapcar #'(lambda (cons) 
    …… 
    239235   <tr><td>Adress</td><td>~@[~A~]</td></tr> 
    240236   <tr><td>Email</td><td>~@[~A~]</td></tr> 
     237   <tr><td>Country</td><td>~@[~A~]</td></tr> 
     238   <tr><td>Language</td><td>~@[~A~]</td></tr> 
    241239  </table> 
    242240 </body> 
    …… 
    246244                                               name 
    247245                                               address 
    248                                                email)) 
     246                                               email 
     247                                               country 
     248                                               language)) 
    249249                       (make-contract-xml-part (store-object-id contract) (all-request-params req)) 
    250250                       (make-vcard-part (store-object-id contract) 

  • branches/bos/projects/bos/m2/packages.lisp

    r2175 r2241  
    8686           #:sponsor-country 
    8787           #:sponsor-contracts 
     88           #:sponsor-id 
     89           #:sponsor-language 
    8890           #:sponsor-set-info-text 
    8991           #:sponsor-set-country 
    90            #:sponsor-id 
     92           #:sponsor-set-language 
    9193           #:country 
    9294           #:info-text 
     95           #:language 
    9396 
    9497           #:editor-only-handler 

  • branches/bos/projects/bos/payment-website/templates/da/contact.xml

    r2115 r2241  
    2828                                                E-Mail: 
    2929                                                <img src="/images/pfeil_link_on.gif" width="10" height="9" alt=""></img> 
    30                                                 <a href="mailto:bos@orangutang.dk" class="more"> 
    31                                                         bos@orangutang.dk 
     30                                                <a href="mailto:regnskov@bosdanmark.dk" class="more"> 
     31                                                        regnskov@bosdanmark.dk 
    3232                                                </a> 
    3333                                                <br></br><br></br><br></br><br></br><br></br><br></br> 

  • branches/bos/projects/bos/payment-website/templates/da/info-request.xml

    r2065 r2241  
    22<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" > 
    33<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"> 
    4         <bos:send-info-request email="$(email)"> 
     4        <bos:send-info-request email="$(email)" country="DK"> 
    55                <p> 
    66                        <span class="headline"> 

  • branches/bos/projects/bos/payment-website/templates/da/ueberweisung.xml

    r2172 r2241  
    4444                                        <input type="hidden" name="country" value="DK" /> 
    4545                                        <input type="hidden" name="contract-id" value="$(contract-id)" /> 
     46                                        <input type="hidden" name="sponsor-id" value="$(sponsor-id)" /> 
    4647                                        <input type="hidden" name="amount" value="$(amount)" /> 
    4748                                        <input type="hidden" name="numsqm" value="$(numsqm)" /> 

  • branches/bos/projects/bos/payment-website/templates/de/ueberweisung.xml

    r2172 r2241  
    4343                                                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"> 
    4444                                        <input type="hidden" name="contract-id" value="$(contract-id)" /> 
     45                                        <input type="hidden" name="sponsor-id" value="$(sponsor-id)" /> 
    4546                                        <input type="hidden" name="amount" value="$(amount)" /> 
    4647                                        <input type="hidden" name="numsqm" value="$(numsqm)" /> 

  • branches/bos/projects/bos/worldpay-test/allocation-area-handlers.lisp

    r2175 r2241  
    231231  (destructuring-bind (x y) (read-from-string (format nil "(~A)" line)) 
    232232    (cons (scale-coordinate 'x +nw-utm-x+ x) 
    233           (scale-coordinate 'y +nw-utm-y+ y)))) 
     233          (scale-coordinate 'y +nw-utm-y+ (- y +width+))))) 
    234234 
    235235(defun polygon-from-text-file (filename) 

  • branches/bos/projects/bos/worldpay-test/sponsor-handlers.lisp

    r2175 r2241  
    1919      (contract (contract-sponsor object)) 
    2020      (otherwise nil)))) 
     21 
     22(defmethod language-selector ((language string)) 
     23  (html 
     24   ((:select :name "language") 
     25    (loop 
     26       for (language-symbol language-name) in (website-languages) 
     27       do (if (string-equal language-symbol language) 
     28              (html ((:option :value language-symbol :selected "selected") 
     29                     (:princ-safe language-name))) 
     30              (html ((:option :value language-symbol) 
     31                     (:princ-safe language-name)))))))) 
     32 
     33(defmethod language-selector ((sponsor sponsor)) 
     34  (language-selector (sponsor-language sponsor))) 
     35 
     36(defmethod language-selector ((contract contract)) 
     37  (language-selector (contract-sponsor contract))) 
    2138 
    2239(defmethod handle-object-form ((handler edit-sponsor-handler) action (sponsor (eql nil)) req) 
    …… 
    7794       (:tr (:td "Email-Address") 
    7895            (:td (text-field "email" :size 40))) 
    79        (:tr (:td "Language for certificate") 
    80             (:td ((:select :name "language") 
    81                   (loop 
    82                      for (language-symbol language-name) in (website-languages) 
    83                      do (html ((:option :value language-symbol) (:princ-safe language-name))))))) 
     96       (:tr (:td "Language for communication and certificate") 
     97            (:td (language-selector "en"))) 
    8498       (:tr (:td "Name for certificate") 
    8599            (:td (text-field "name" :size 20))) 
    …… 
    95109(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :create)) (sponsor (eql nil)) req) 
    96110  (with-query-params (req numsqm country email name address date language) 
    97     (let* ((sponsor (make-sponsor :email email :country country)) 
     111    (let* ((sponsor (make-sponsor :email email :country country :language language)) 
    98112           (contract (make-contract sponsor (parse-integer numsqm) 
    99113                                    :paidp (format nil "~A: manually created by ~A" 
    …… 
    129143                             :value (sponsor-country sponsor) 
    130144                             :size 2))) 
     145       (:tr (:td "language") 
     146            (:td (language-selector sponsor))) 
    131147       (:tr (:td "info-text") 
    132148            (:td (textarea-field "info-text" 
    …… 
    160176  (let (changed) 
    161177    (with-bos-cms-page (req :title "Saving sponsor data") 
    162       (dolist (field-name '(full-name email password country info-text)) 
     178      (dolist (field-name '(full-name email password country language info-text)) 
    163179        (let ((field-value (query-param req (string-downcase (symbol-name field-name))))) 
    164180          (when (and field-value 
    …… 
    209225                    (:td (text-field "country" :size 2 :value "DE"))) 
    210226               (:tr (:td "Language") 
    211                     (:td ((:select :name "language") 
    212                           (loop 
    213                              for (language-symbol language-name) in (website-languages) 
    214                              do (html ((:option :value language-symbol) (:princ-safe language-name))))))) 
     227                    (:td (:princ-safe (sponsor-language (contract-sponsor contract))))) 
    215228               (:tr (:td "Email-Address") 
    216229                    (:td (text-field "email" :size 20 :value email))) 
    …… 
    218231 
    219232(defmethod handle-object-form ((handler complete-transfer-handler) (action (eql :process)) contract req) 
    220   (with-query-params (req email country language) 
     233  (with-query-params (req email country) 
    221234    (with-bos-cms-page (req :title "Square meter sale completion") 
    222235      (if (contract-paidp contract) 
    …… 
    299312            (:td (text-field "name" :size 40))) 
    300313       (:tr (:td "Language") 
    301             (:td ((:select :name "language") 
    302                   (loop 
    303                      for (language-symbol language-name) in (website-languages) 
    304                      do (html ((:option :value language-symbol) (:princ-safe language-name))))))) 
     314            (:td (language-selector contract))) 
    305315       (unless (contract-download-only-p contract) 
    306316         (html 

  • branches/bos/projects/bos/worldpay-test/tags.lisp

    r2175 r2241  
    7272                                    (scan #?r"rweisung" action) 
    7373                                    (scan #?r"verf" action))) 
    74                (sponsor (make-sponsor)) 
     74               (language (session-variable :language)) 
     75               (sponsor (make-sponsor :language language)) 
    7576               (contract (make-contract sponsor numsqm 
    7677                                        :download-only download-only 
    …… 
    7879                                                        bos.m2::*manual-contract-expiry-time* 
    7980                                                        bos.m2::*online-contract-expiry-time*) 
    80                                                     (get-universal-time)))) 
    81                (language (session-variable :language))) 
     81                                                    (get-universal-time))))) 
    8282          (destructuring-bind (price currency) 
    8383              (case (make-keyword-from-string language) 
    …… 
    136136      (mapc #'emit-template-node children)))) 
    137137 
    138 (define-bknr-tag send-info-request (&key children email) 
    139   (mail-info-request email) 
     138(define-bknr-tag send-info-request (&key children email country) 
     139  (mail-info-request email (or country "DE")) 
    140140  (mapc #'emit-template-node children)) 
    141141 

  • branches/bos/projects/bos/worldpay-test/worldpay-test.lisp

    r2175 r2241  
    3030      (bos.m2::remember-worldpay-params cartId (all-request-params request)) 
    3131      (let ((contract (get-contract (parse-integer cartId)))) 
     32        (sponsor-set-language (contract-sponsor contract) lang) 
    3233        (cond 
    3334          ((not (typep contract 'contract))