bknr-cvs November 2006

bknr-cvs@common-lisp.net

1 participants
44 discussions

[bknr-cvs] r2062 - trunk/projects/bos/payment-website/static
by bknr＠bknr.net 07 Nov '06

07 Nov '06

Author: hhubner Date: 2006-11-07 12:29:07 -0500 (Tue, 07 Nov 2006) New Revision: 2062 Modified: trunk/projects/bos/payment-website/static/bos.js trunk/projects/bos/payment-website/static/bos_en.js Log: Check that the user entered the number of square meters she wants to "buy". Modified: trunk/projects/bos/payment-website/static/bos.js =================================================================== --- trunk/projects/bos/payment-website/static/bos.js 2006-11-05 20:58:53 UTC (rev 2061) +++ trunk/projects/bos/payment-website/static/bos.js 2006-11-07 17:29:07 UTC (rev 2062) @@ -1,220 +1,227 @@ // -*- Java -*- Script + // *** extrafenster fuer impressum, kontakt etc. *** // function window_extra(target) { - mywin=open(target,"detailwin","width=482,height=600,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); - mywin.focus(); + mywin=open(target,"detailwin","width=482,height=600,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); + mywin.focus(); }; // *** extrafenster für das Ringschema *** // function window_ringdetail() { - mywin=open("ring-detail","ringdetail","width=492,height=450,status=no,toolbar=no,menubar=no,resizable=no,scrollbars=no,left=100,top=100"); - mywin.focus(); + mywin=open("ring-detail","ringdetail","width=492,height=450,status=no,toolbar=no,menubar=no,resizable=no,scrollbars=no,left=100,top=100"); + mywin.focus(); }; // *** extrafenster fuer news + archive *** // function window_news(target) { - mywin=open(target,"newswin","width=480,height=400,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); - mywin.focus(); + mywin=open(target,"newswin","width=480,height=400,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); + mywin.focus(); }; // *** extrafenster fuer satellitenkarte *** // function window_infosys() { - var language = document.location.pathname.substr(1, 2); // XXX funktioniert nur mit 2-buchstaben-abkuerzungen von sprachen - var url = "/infosystem/" + language + "/satellitenkarte.htm"; + var language = document.location.pathname.substr(1, 2); // XXX funktioniert nur mit 2-buchstaben-abkuerzungen von sprachen + var url = "/infosystem/" + language + "/satellitenkarte.htm"; - var sponsorid_input = document.getElementById('sponsorid-input'); - var password_input = document.getElementById('password-input'); + var sponsorid_input = document.getElementById('sponsorid-input'); + var password_input = document.getElementById('password-input'); - if (sponsorid_input && password_input) { - url += "?__sponsorid=" + sponsorid_input.value + "&__password=" + password_input.value; - } + if (sponsorid_input && password_input) { + url += "?__sponsorid=" + sponsorid_input.value + "&__password=" + password_input.value; + } - mywin=open(url, - "infowin", - "width=740,height=500,status=no,toolbar=no,menubar=no,resizable=no,scrollbars=no,left=250,top=50"); - mywin.focus(); + mywin=open(url, + "infowin", + "width=740,height=500,status=no,toolbar=no,menubar=no,resizable=no,scrollbars=no,left=250,top=50"); + mywin.focus(); }; // Sprachumschaltung function jumpMenu(targ, selObj, restore) { - eval(targ + ".location='" + selObj.options[selObj.selectedIndex].value + "'"); - if (restore) - selObj.selectedIndex=0; + eval(targ + ".location='" + selObj.options[selObj.selectedIndex].value + "'"); + if (restore) + selObj.selectedIndex=0; } // Formularcheck für Profilsetup function check_profil_setup() { - if (document.form.password.value == "") { - alert('Das Kennwort darf nicht leer sein'); - document.form.password.focus(); - return false; - } + if (document.form.password.value == "") { + alert('Das Kennwort darf nicht leer sein'); + document.form.password.focus(); + return false; + } - if (document.form.password.value != document.form.password1.value) { - alert('Bitte geben Sie zwei mal das gleiche Kennwort ein'); - document.form.password.focus(); - return false; - } + if (document.form.password.value != document.form.password1.value) { + alert('Bitte geben Sie zwei mal das gleiche Kennwort ein'); + document.form.password.focus(); + return false; + } - window_infosys(); + window_infosys(); - return true; + return true; } // Formularchecks für Bestellung function show_disclaimer() { - document.bestellformular.disclaimer_read.checked = true; - window_extra('disclaimer'); + document.bestellformular.disclaimer_read.checked = true; + window_extra('disclaimer'); } function check_ueberweisung() { -// alert("numsqm: " + + " numsqm1: " + ); + // alert("numsqm: " + + " numsqm1: " + ); - if (!document.bestellformular.disclaimer_read.checked) { - alert("Bitte lesen Sie die Verzichtsklausel und bestätigen Sie sie Ihr Einverständnis durch Setzen des Häkchens"); - return false; - } + if (!document.bestellformular.disclaimer_read.checked) { + alert("Bitte lesen Sie die Verzichtsklausel und bestätigen Sie sie Ihr Einverständnis durch Setzen des Häkchens"); + return false; + } - if (document.bestellformular.numsqm[0].checked - || (document.bestellformular.numsqm[4].checked - && (document.bestellformular.numsqm1.value < 5))) { + if (document.bestellformular.numsqm[0].checked + || (document.bestellformular.numsqm[4].checked + && (document.bestellformular.numsqm1.value < 5))) { - alert("Aufgrund des hohen manuellen Bearbeitungsaufands sind Überweisungen erst ab einer Summe von 15 Euro (5 Quadratmeter) möglich"); - return false; - } + alert("Aufgrund des hohen manuellen Bearbeitungsaufands sind Überweisungen erst ab einer Summe von 15 Euro (5 Quadratmeter) möglich"); + return false; + } - if (document.bestellformular.gift.checked) { - alert("Den Geschenkservice können wir nur bei Online-Überweisungen anbieten"); - return false; - } + if (document.bestellformular.gift.checked) { + alert("Den Geschenkservice können wir nur bei Online-Überweisungen anbieten"); + return false; + } } function check_online() { - if (!document.bestellformular.disclaimer_read.checked) { - alert("Bitte lesen Sie die Verzichtsklausel und bestätigen Sie sie Ihr Einverständnis durch Ankreuzen der Checkbox"); - return false; - } + if (!document.bestellformular.disclaimer_read.checked) { + alert("Bitte lesen Sie die Verzichtsklausel und bestätigen Sie sie Ihr Einverständnis durch Ankreuzen der Checkbox"); + return false; + } - if (document.bestellformular.gift.checked - && (document.bestellformular.numsqm[0].checked - || document.bestellformular.numsqm[1].checked - || (document.bestellformular.numsqm[4].checked - && (document.bestellformular.numsqm1.value < 10)))) { + if (!document.bestellformular.numsqm1.value.match(/^\d+/)) { + alert('Bitte geben Sie die Anzahl der Quadratmeter ein, die Sie "kaufen" möchten!'); + document.bestellformular.numsqm1.focus(); + return false; + } - alert("Das Verschenken von Quadratmetern ist erst ab einer Summe von 30 Euro möglich"); - return false; - } + if (document.bestellformular.gift.checked + && (document.bestellformular.numsqm[0].checked + || document.bestellformular.numsqm[1].checked + || (document.bestellformular.numsqm[4].checked + && (document.bestellformular.numsqm1.value < 10)))) { - return true; + alert("Das Verschenken von Quadratmetern ist erst ab einer Summe von 30 Euro möglich"); + return false; + } + + return true; } // Formularcheck für Versandinformationen function check_versand_info() { - if ((document.formular.name.value == '') - || (document.formular.address.value == '')) { - alert("Bitte geben Sie einen Namen für die Urkunde sowie die Versandadresse an"); - return false; - } + if ((document.formular.name.value == '') + || (document.formular.address.value == '')) { + alert("Bitte geben Sie einen Namen für die Urkunde sowie die Versandadresse an"); + return false; + } - return true; + return true; } // Funktion zum Verschicken von Info-Mail-Requests function send_info_request() { - var address = document.form.email.value; + var address = document.form.email.value; - if (!is_valid_email(address)) { - alert('Die von Ihnen eingegebene Email-Adresse "' + address + '" konnte von unserem Server nicht erkannt werden. Bitte senden ' - + 'Sie uns Ihre Anfrage per Email an service(a)createrainforest.org'); - } else { - if (confirm('Wünschen Sie, daß wir Ihnen an die Email-Adresse "' + address + '" Informationen zu BOS und Samboja Lestari schicken?')) { - document.form.email.value = ''; - open("info-request?email=" + escape(address), - "mailwin", "width=480,height=235,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); - } + if (!is_valid_email(address)) { + alert('Die von Ihnen eingegebene Email-Adresse "' + address + '" konnte von unserem Server nicht erkannt werden. Bitte senden ' + + 'Sie uns Ihre Anfrage per Email an service(a)createrainforest.org'); + } else { + if (confirm('Wünschen Sie, daß wir Ihnen an die Email-Adresse "' + address + '" Informationen zu BOS und Samboja Lestari schicken?')) { + document.form.email.value = ''; + open("info-request?email=" + escape(address), + "mailwin", "width=480,height=235,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); } + } - return false; + return false; } function is_valid_email(address) { - var filter = /^([a-zA-Z0-9_\.\-])+\(a)(([a-zA-Z0-9\-])+\.)+([a-zA-Z0-9]{2,4})+$/; + var filter = /^([a-zA-Z0-9_\.\-])+\(a)(([a-zA-Z0-9\-])+\.)+([a-zA-Z0-9]{2,4})+$/; - return filter.test(address); + return filter.test(address); } // Allgemeiner Formular-Check function MM_findObj(n, d) { - var p,i,x; if(!d) d=document; if((p=n.indexOf("?"))>0&&parent.frames.length) { - d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);} - if(!(x=d[n])&&d.all) x=d.all[n]; for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n]; - for(i=0;!x&&d.layers&&i<d.layers.length;i++) x=MM_findObj(n,d.layers[i].document); - if(!x && d.getElementById) x=d.getElementById(n); return x; + var p,i,x; if(!d) d=document; if((p=n.indexOf("?"))>0&&parent.frames.length) { + d=parent.frames[n.substring(p+1)].document; n=n.substring(0,p);} + if(!(x=d[n])&&d.all) x=d.all[n]; for (i=0;!x&&i<d.forms.length;i++) x=d.forms[i][n]; + for(i=0;!x&&d.layers&&i<d.layers.length;i++) x=MM_findObj(n,d.layers[i].document); + if(!x && d.getElementById) x=d.getElementById(n); return x; } function YY_checkform() { //v4.71 -//copyright (c)1998,2002 Yaromat.com - var a=YY_checkform.arguments,oo=true,v='',s='',err=false,r,o,at,o1,t,i,j,ma,rx,cd,cm,cy,dte,at; - for (i=1; i<a.length;i=i+4){ - if (a[i+1].charAt(0)=='#'){r=true; a[i+1]=a[i+1].substring(1);}else{r=false} - o=MM_findObj(a[i].replace(/\[\d+\]/ig,"")); - o1=MM_findObj(a[i+1].replace(/\[\d+\]/ig,"")); - v=o.value;t=a[i+2]; - if (o.type=='text'||o.type=='password'||o.type=='hidden'){ - if (r&&v.length==0){err=true} - if (v.length>0) - if (t==1){ //fromto - ma=a[i+1].split('_');if(isNaN(v)||v<ma[0]/1||v > ma[1]/1){err=true} - } else if (t==2){ - rx=new RegExp("^[\\w\.=-]+(a)[\\w\\.-]+\\.[a-zA-Z]{2,4}$");if(!rx.test(v))err=true; - } else if (t==3){ // date - ma=a[i+1].split("#");at=v.match(ma[0]); - if(at){ - cd=(at[ma[1]])?at[ma[1]]:1;cm=at[ma[2]]-1;cy=at[ma[3]]; - dte=new Date(cy,cm,cd); - if(dte.getFullYear()!=cy||dte.getDate()!=cd||dte.getMonth()!=cm){err=true}; - }else{err=true} - } else if (t==4){ // time - ma=a[i+1].split("#");at=v.match(ma[0]);if(!at){err=true} - } else if (t==5){ // check this 2 - if(o1.length)o1=o1[a[i+1].replace(/(.*\[)|(\].*)/ig,"")]; - if(!o1.checked){err=true} - } else if (t==6){ // the same - if(v!=MM_findObj(a[i+1]).value){err=true} - } - } else - if (!o.type&&o.length>0&&o[0].type=='radio'){ - at = a[i].match(/(.*)\[(\d+)\].*/i); - o2=(o.length>1)?o[at[2]]:o; - if (t==1&&o2&&o2.checked&&o1&&o1.value.length/1==0){err=true} - if (t==2){ - oo=false; - for(j=0;j<o.length;j++){oo=oo||o[j].checked} - if(!oo){s+='* '+a[i+3]+'\n'} - } - } else if (o.type=='checkbox'){ - if((t==1&&o.checked==false)||(t==2&&o.checked&&o1&&o1.value.length/1==0)){err=true} - } else if (o.type=='select-one'||o.type=='select-multiple'){ - if(t==1&&o.selectedIndex/1==0){err=true} - }else if (o.type=='textarea'){ - if(v.length<a[i+1]){err=true} + //copyright (c)1998,2002 Yaromat.com + var a=YY_checkform.arguments,oo=true,v='',s='',err=false,r,o,at,o1,t,i,j,ma,rx,cd,cm,cy,dte,at; + for (i=1; i<a.length;i=i+4){ + if (a[i+1].charAt(0)=='#'){r=true; a[i+1]=a[i+1].substring(1);}else{r=false} + o=MM_findObj(a[i].replace(/\[\d+\]/ig,"")); + o1=MM_findObj(a[i+1].replace(/\[\d+\]/ig,"")); + v=o.value;t=a[i+2]; + if (o.type=='text'||o.type=='password'||o.type=='hidden'){ + if (r&&v.length==0){err=true} + if (v.length>0) + if (t==1){ //fromto + ma=a[i+1].split('_');if(isNaN(v)||v<ma[0]/1||v > ma[1]/1){err=true} + } else if (t==2){ + rx=new RegExp("^[\\w\.=-]+(a)[\\w\\.-]+\\.[a-zA-Z]{2,4}$");if(!rx.test(v))err=true; + } else if (t==3){ // date + ma=a[i+1].split("#");at=v.match(ma[0]); + if(at){ + cd=(at[ma[1]])?at[ma[1]]:1;cm=at[ma[2]]-1;cy=at[ma[3]]; + dte=new Date(cy,cm,cd); + if(dte.getFullYear()!=cy||dte.getDate()!=cd||dte.getMonth()!=cm){err=true}; + }else{err=true} + } else if (t==4){ // time + ma=a[i+1].split("#");at=v.match(ma[0]);if(!at){err=true} + } else if (t==5){ // check this 2 + if(o1.length)o1=o1[a[i+1].replace(/(.*\[)|(\].*)/ig,"")]; + if(!o1.checked){err=true} + } else if (t==6){ // the same + if(v!=MM_findObj(a[i+1]).value){err=true} + } + } else + if (!o.type&&o.length>0&&o[0].type=='radio'){ + at = a[i].match(/(.*)\[(\d+)\].*/i); + o2=(o.length>1)?o[at[2]]:o; + if (t==1&&o2&&o2.checked&&o1&&o1.value.length/1==0){err=true} + if (t==2){ + oo=false; + for(j=0;j<o.length;j++){oo=oo||o[j].checked} + if(!oo){s+='* '+a[i+3]+'\n'} + } + } else if (o.type=='checkbox'){ + if((t==1&&o.checked==false)||(t==2&&o.checked&&o1&&o1.value.length/1==0)){err=true} + } else if (o.type=='select-one'||o.type=='select-multiple'){ + if(t==1&&o.selectedIndex/1==0){err=true} + }else if (o.type=='textarea'){ + if(v.length<a[i+1]){err=true} + } + if (err){s+='* '+a[i+3]+'\n'; err=false} } - if (err){s+='* '+a[i+3]+'\n'; err=false} - } - if (s!=''){alert('Die benötigten Informationen sind unvollständig oder fehlerhaft:\t\t\t\t\t\n\n'+s)} - document.MM_returnValue = (s==''); + if (s!=''){alert('Die benötigten Informationen sind unvollständig oder fehlerhaft:\t\t\t\t\t\n\n'+s)} + document.MM_returnValue = (s==''); } Modified: trunk/projects/bos/payment-website/static/bos_en.js =================================================================== --- trunk/projects/bos/payment-website/static/bos_en.js 2006-11-05 20:58:53 UTC (rev 2061) +++ trunk/projects/bos/payment-website/static/bos_en.js 2006-11-07 17:29:07 UTC (rev 2062) @@ -1,3 +1,4 @@ +// -*- Java -*- Script // Formularcheck für Profilsetup @@ -3,62 +4,68 @@ function check_profil_setup() { - if (document.form.password.value == "") { - alert('Please enter your personal password.'); - document.form.password.focus(); - return false; - } + if (document.form.password.value == "") { + alert('Please enter your personal password.'); + document.form.password.focus(); + return false; + } - if (document.form.password.value != document.form.password1.value) { - alert('Please enter your personal password again.'); - document.form.password.focus(); - return false; - } + if (document.form.password.value != document.form.password1.value) { + alert('Please enter your personal password again.'); + document.form.password.focus(); + return false; + } - window_infosys(); + window_infosys(); - return true; + return true; } function check_ueberweisung() { -// alert("numsqm: " + + " numsqm1: " + ); + // alert("numsqm: " + + " numsqm1: " + ); - if (!document.bestellformular.disclaimer_read.checked) { - alert("Please read the waiver clause and confirm your agreement with a click to the check box."); - return false; - } + if (!document.bestellformular.disclaimer_read.checked) { + alert("Please read the waiver clause and confirm your agreement with a click to the check box."); + return false; + } - if (document.bestellformular.numsqm[0].checked - || (document.bestellformular.numsqm[4].checked - && (document.bestellformular.numsqm1.value < 5))) { + if (document.bestellformular.numsqm[0].checked + || (document.bestellformular.numsqm[4].checked + && (document.bestellformular.numsqm1.value < 5))) { - alert("Aufgrund des hohen manuellen Bearbeitungsaufands sind Überweisungen erst ab einer Summe von 15 Euro (5 Quadratmeter) möglich"); - return false; - } + alert("Aufgrund des hohen manuellen Bearbeitungsaufands sind Überweisungen erst ab einer Summe von 15 Euro (5 Quadratmeter) möglich"); + return false; + } - if (document.bestellformular.gift.checked) { - alert("Den Geschenkservice können wir nur bei Online-Überweisungen anbieten"); - return false; - } + if (document.bestellformular.gift.checked) { + alert("Den Geschenkservice können wir nur bei Online-Überweisungen anbieten"); + return false; + } } function check_online() { - if (!document.bestellformular.disclaimer_read.checked) { - alert("Please read the waiver clause and confirm your agreement with a click to the check box."); - return false; - } + if (!document.bestellformular.disclaimer_read.checked) { + alert("Please read the waiver clause and confirm your agreement with a click to the check box."); + return false; + } - if (document.bestellformular.gift.checked - && (document.bestellformular.numsqm[0].checked - || document.bestellformular.numsqm[1].checked - || (document.bestellformular.numsqm[4].checked - && (document.bestellformular.numsqm1.value < 10)))) { + if (!document.bestellformular.numsqm1.value.match(/^\d+/)) { + alert('Please enter the number of square meters that you want to "buy"!'); + document.bestellformular.numsqm1.focus(); + return false; + } - alert("Das Verschenken von Quadratmetern ist erst ab einer Summe von 30 Euro möglich"); - return false; - } + if (document.bestellformular.gift.checked + && (document.bestellformular.numsqm[0].checked + || document.bestellformular.numsqm[1].checked + || (document.bestellformular.numsqm[4].checked + && (document.bestellformular.numsqm1.value < 10)))) { - return true; + alert("Das Verschenken von Quadratmetern ist erst ab einer Summe von 30 Euro möglich"); + return false; + } + + return true; } @@ -67,30 +74,30 @@ function check_versand_info() { - if ((document.formular.name.value == '') - || (document.formular.address.value == '')) { - alert("Please enter a name and address for your rainforest certificate."); - return false; - } + if ((document.formular.name.value == '') + || (document.formular.address.value == '')) { + alert("Please enter a name and address for your rainforest certificate."); + return false; + } - return true; + return true; } // Funktion zum Verschicken von Info-Mail-Requests function send_info_request() { - var address = document.form.email.value; + var address = document.form.email.value; - if (!is_valid_email(address)) { - alert('The email address you entered "' + address + '" was not recogniced by our server. Please send your request to ' - + 'service(a)createrainforest.org'); - } else { - if (confirm('Would you like to receive informations about BOS and Samboja Lestari to "' + address + '"?')) { - document.form.email.value = ''; - open("info-request?email=" + escape(address), - "mailwin", "width=480,height=235,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); - } + if (!is_valid_email(address)) { + alert('The email address you entered "' + address + '" was not recogniced by our server. Please send your request to ' + + 'service(a)createrainforest.org'); + } else { + if (confirm('Would you like to receive informations about BOS and Samboja Lestari to "' + address + '"?')) { + document.form.email.value = ''; + open("info-request?email=" + escape(address), + "mailwin", "width=480,height=235,status=no,toolbar=no,menubar=no,resizable=yes,scrollbars=yes,left=100,top=100"); } + } - return false; + return false; }

1 0

[bknr-cvs] r2061 - trunk/projects/bos/worldpay-test
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 15:58:53 -0500 (Sun, 05 Nov 2006) New Revision: 2061 Modified: trunk/projects/bos/worldpay-test/tags.lisp trunk/projects/bos/worldpay-test/worldpay-test.lisp Log: certificate generation fixed for WorldPay payment Modified: trunk/projects/bos/worldpay-test/tags.lisp =================================================================== --- trunk/projects/bos/worldpay-test/tags.lisp 2006-11-05 20:58:04 UTC (rev 2060) +++ trunk/projects/bos/worldpay-test/tags.lisp 2006-11-05 20:58:53 UTC (rev 2061) @@ -40,6 +40,7 @@ (with-template-vars (gift email name address) (let ((contract (find-store-object (parse-integer (get-template-var :contract-id))))) (contract-issue-cert contract name :address address :language (session-variable :language)) + (mail-worldpay-sponsor-data (get-template-var :request)) (bknr.web::redirect-request :target (if gift "index" (format nil "profil_setup?name=~A&email=~A&sponsor-id=~A" (uriencode-string name) (uriencode-string email) @@ -112,11 +113,6 @@ strasse plz ort) :language (session-variable :language)) - (loop - do (progn - (format t "~&; waiting for generation of certificate, contract-id ~A" contract-id) - (sleep 2)) - until (probe-file (contract-pdf-pathname contract))) (mail-manual-sponsor-data (get-template-var :request))))) (define-bknr-tag when-certificate (&key children) Modified: trunk/projects/bos/worldpay-test/worldpay-test.lisp =================================================================== --- trunk/projects/bos/worldpay-test/worldpay-test.lisp 2006-11-05 20:58:04 UTC (rev 2060) +++ trunk/projects/bos/worldpay-test/worldpay-test.lisp 2006-11-05 20:58:53 UTC (rev 2061) @@ -27,6 +27,7 @@ (with-query-params (request cartId name address country transStatus lang MC_gift) (unless (website-supports-language lang) (setf lang *default-language*)) + (bos.m2::remember-worldpay-params cartId (all-request-params request)) (let ((contract (get-contract (parse-integer cartId)))) (cond ((not (typep contract 'contract)) @@ -36,10 +37,8 @@ ((equal "C" transStatus) (setf template-name #?"/$(lang)/sponsor_canceled")) ((< (contract-price contract) *mail-certificate-threshold*) - (mail-worldpay-sponsor-data request) (setf template-name #?"/$(lang)/quittung")) (t - (mail-worldpay-sponsor-data request) (when (<= *mail-fiscal-certificate-threshold* (contract-price contract)) (mail-fiscal-certificate-to-office contract name address country)) (setf template-name (if (and MC_gift (equal MC_gift "1")) #?"/$(lang)/versand_geschenk" #?"/$(lang)/versand_info")))))))

1 0

[bknr-cvs] r2060 - trunk/projects/bos/m2
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 15:58:04 -0500 (Sun, 05 Nov 2006) New Revision: 2060 Modified: trunk/projects/bos/m2/m2.lisp trunk/projects/bos/m2/mail-generator.lisp Log: Certificate generation fixed for payment by WorldPay Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2006-11-05 20:57:13 UTC (rev 2059) +++ trunk/projects/bos/m2/m2.lisp 2006-11-05 20:58:04 UTC (rev 2060) @@ -263,6 +263,11 @@ (make-certificate contract name :address address :language language) (unless (contract-download-only-p contract) (make-certificate contract name :address address :language language :print t)) + (loop + do (progn + (format t "~&; waiting for generation of certificate, contract-id ~A" (store-object-id contract)) + (sleep 2)) + until (probe-file (contract-pdf-pathname contract))) (change-slot-values contract 'cert-issued t)))) (defmethod contract-image-tiles ((contract contract)) Modified: trunk/projects/bos/m2/mail-generator.lisp =================================================================== --- trunk/projects/bos/m2/mail-generator.lisp 2006-11-05 20:57:13 UTC (rev 2059) +++ trunk/projects/bos/m2/mail-generator.lisp 2006-11-05 20:58:04 UTC (rev 2060) @@ -113,22 +113,11 @@ (NOTE ,note) (END "VCARD")))) -(defun worldpay-callback-request-to-vcard (request) - (with-query-params (request cartId - transId - authAmountString - cardType - MC_sponsorid - MC_donationcert-yearly - MC_gift - name - address - postcode - country - email - tel) - (let ((contract (store-object-with-id (parse-integer cartId)))) - (make-vcard :sponsor-id MC_sponsorid +(defun worldpay-callback-params-to-vcard (params) + (labels ((param (name) + (cdr (assoc name params :test #'string-equal)))) + (let ((contract (store-object-with-id (parse-integer (param 'cartId))))) + (make-vcard :sponsor-id (param 'MC_sponsorid) :note (format nil "Paid-by: Worldpay Contract ID: ~A Sponsor ID: ~A @@ -139,54 +128,54 @@ Donationcert yearly: ~A Gift: ~A " - cartId + (param 'cartId) (store-object-id (contract-sponsor contract)) (length (contract-m2s contract)) - authAmountString - cardType - transId - (if MC_donationcert-yearly "Yes" "No") - (if MC_gift "Yes" "No")) - :name name - :address address - :postcode postcode - :country country - :email email - :tel tel)))) + (param 'authAmountString) + (param 'cardType) + (param 'transId) + (if (param 'MC_donationcert-yearly) "Yes" "No") + (if (param 'MC_gift) "Yes" "No")) + :name (param 'name) + :address (param 'address) + :postcode (param 'postcode) + :country (param 'country) + :email (param 'email) + :tel (param 'tel))))) (defun mail-contract-data (contract type mime-parts) (unless (contract-download-only-p contract) - (push (make-instance 'mime - :type "application" - :subtype (format nil "pdf; name=\"contract-~A.pdf\"" (store-object-id contract)) - :encoding :base64 - :content (file-contents (contract-pdf-pathname contract :print t))) - mime-parts)) - (send-system-mail :subject (format nil "~A-Spenderdaten - Sponsor-ID ~D Contract-ID ~D" - type - (store-object-id (contract-sponsor contract)) - (store-object-id contract)) - :content-type "multipart/mixed" - :more-headers t - :text (with-output-to-string (s) - (print-mime s - (make-instance 'multipart-mime - :subtype "mixed" - :content mime-parts) - t t))) - (unless (contract-download-only-p contract) - (delete-file (contract-pdf-pathname contract :print t)))) + (push (make-instance 'mime + :type "application" + :subtype (format nil "pdf; name=\"contract-~A.pdf\"" (store-object-id contract)) + :encoding :base64 + :content (file-contents (contract-pdf-pathname contract :print t))) + mime-parts)) + (send-system-mail :subject (format nil "~A-Spenderdaten - Sponsor-ID ~D Contract-ID ~D" + type + (store-object-id (contract-sponsor contract)) + (store-object-id contract)) + :content-type "multipart/mixed" + :more-headers t + :text (with-output-to-string (s) + (print-mime s + (make-instance 'multipart-mime + :subtype "mixed" + :content mime-parts) + t t))) + (unless (contract-download-only-p contract) + (delete-file (contract-pdf-pathname contract :print t)))) (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 " + :type "text" + :subtype "html" + :charset "utf-8" + :encoding :quoted-printable + :content (format nil " <html> <body> <h1>Ueberweisungsformulardaten:</h1> @@ -207,63 +196,76 @@ </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 " + 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 + (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: ~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)) + +(defun remember-worldpay-params (contract-id params) + "Remember the parameters sent in a callback request from Worldpay so that they can be mailed to the BOS office later on" + (setf (gethash contract-id *worldpay-params-hash*) params)) + +(defun get-worldpay-params (contract-id) + (or (prog1 + (gethash contract-id *worldpay-params-hash*) + (remhash contract-id *worldpay-params-hash*)) + (error "cannot find WorldPay callback params for contract ~A~%" contract-id))) + (defun mail-worldpay-sponsor-data (req) - (with-query-params (req cartId) - (let* ((contract (store-object-with-id (parse-integer cartId))) + (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 " + :type "text" + :subtype "html" + :charset "utf-8" + :encoding :quoted-printable + :content (format nil " <table border=\"1\"> <tr> <th>Parameter</th> @@ -272,30 +274,30 @@ ~{<tr><td>~A</td><td>~A</td></tr>~} </table> " - (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons))) - (sort (copy-list (all-request-params req)) - #'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 " + (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))) - (all-request-params req))))) - (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-request-to-vcard req))))) + (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))))) (mail-contract-data contract "WorldPay" parts))))

1 0

[bknr-cvs] r2059 - in trunk/projects/bos/payment-website/templates: de dk
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 15:57:13 -0500 (Sun, 05 Nov 2006) New Revision: 2059 Modified: trunk/projects/bos/payment-website/templates/de/quittung.xml trunk/projects/bos/payment-website/templates/dk/contact.xml Log: textual correction, intermediate danish contact page. Modified: trunk/projects/bos/payment-website/templates/de/quittung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/quittung.xml 2006-11-05 20:56:25 UTC (rev 2058) +++ trunk/projects/bos/payment-website/templates/de/quittung.xml 2006-11-05 20:57:13 UTC (rev 2059) @@ -113,7 +113,7 @@ <tr> <td colspan="3" height="8"> <span class="help_text"> - Wir Äbernehmen den Namen, der in diesem Eingabefeld angegeben wird. + Wir Übernehmen den Namen, der in diesem Eingabefeld angegeben wird. Bitte korrigieren Sie bei Bedarf die angezeigte Eingabe. </span> </td> Modified: trunk/projects/bos/payment-website/templates/dk/contact.xml =================================================================== --- trunk/projects/bos/payment-website/templates/dk/contact.xml 2006-11-05 20:56:25 UTC (rev 2058) +++ trunk/projects/bos/payment-website/templates/dk/contact.xml 2006-11-05 20:57:13 UTC (rev 2059) @@ -1,78 +1,78 @@ -<?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_main" title="Regnskov til SAMBOJA LESTARI - Kontakt" xmlns="http://www.w3.org/1999/xhtml" xmlns:bknr="http://bknr.net" xmlns:bos="http://headcraft.de/bos"> - <div id="content_main"> - <div id="textbox_content"> - <table border="0" cellpadding="0" cellspacing="0"> - <tr> - <td colspan="3"><span class="headline">kontakt</span> - </td> - <td> - </td> - </tr> - <tr> - <td height="15"> - </td> - </tr> - <tr> - <td>Kontakt BOS Danmark med eventuelle spørgsmål.<br></br> - Vi modtager også gerne ideer til forbedringer at denne hjemmeside. - <br></br><br></br> - BOS Danmark.<br></br> - Økologihuset, Blegdamsvej 4b<br></br> - 2200 København N - <br></br><br></br> - Telefon: 70 203 206<br></br> - 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@orangutang.dk" class="more"> - bos(a)orangutang.dk - </a> - <br></br><br></br><br></br><br></br><br></br><br></br> - Vi besvarer alle henvendelser hurtigst muligt. - <br></br> - </td> - </tr> - </table> - </div> - </div> - <div id="content_right"> - <div id="textbox_right_top"> - <table id="rightTable" border="0" cellpadding="0" cellspacing="0"> - <tr> - <td height="30"> - </td> - </tr> - <tr> - <td colspan="2"><img src="/images/bos-logo.gif" width="116" height="85" alt=""></img> - </td> - </tr> - <tr> - <td height="10"> - </td> - </tr> - <tr> - <td colspan="2">Vil du vide mere om BOS's projekter? - <br></br><br></br> - <img src="/images/pfeil_link_on.gif" width="10" height="9" alt=""></img> - <a href="http://www.savetheorangutan.info" target="_blank" class="more"> - savetheorangutan.info - </a> - <br></br> - <img src="/images/pfeil_link_on.gif" width="10" height="9" alt=""></img> - <a href="http://www.orangutang.dk" target="_blank" class="more"> - orangutang.dk - </a> - <br></br><br></br> - </td> - </tr> - <tr> - <td>På disse hjemmesider kan du finde information om BOS's partnere rundt om i verden. - </td> - </tr> - </table> - </div> - </div> -</bknr:toplevel> - +<?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_main" title="Regnskov til SAMBOJA LESTARI - Kontakt" xmlns="http://www.w3.org/1999/xhtml" xmlns:bknr="http://bknr.net" xmlns:bos="http://headcraft.de/bos"> + <div id="content_main"> + <div id="textbox_content"> + <table border="0" cellpadding="0" cellspacing="0"> + <tr> + <td colspan="3"><span class="headline">kontakt</span> + </td> + <td> + </td> + </tr> + <tr> + <td height="15"> + </td> + </tr> + <tr> + <td>Kontakt BOS Danmark med eventuelle spørgsmål.<br></br> + Vi modtager også gerne ideer til forbedringer at denne hjemmeside. + <br></br><br></br> + BOS Danmark.<br></br> + Økologihuset<br></br> + Blegdamsvej 4b<br></br> + 2200 København N + <br></br><br></br> + Telefon: 70 203 206<br></br> + 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@orangutang.dk" class="more"> + bos(a)orangutang.dk + </a> + <br></br><br></br><br></br><br></br><br></br><br></br> + Vi besvarer alle henvendelser hurtigst muligt. + <br></br> + </td> + </tr> + </table> + </div> + </div> + <div id="content_right"> + <div id="textbox_right_top"> + <table id="rightTable" border="0" cellpadding="0" cellspacing="0"> + <tr> + <td height="30"> + </td> + </tr> + <tr> + <td colspan="2"><img src="/images/bos-logo.gif" width="116" height="85" alt=""></img> + </td> + </tr> + <tr> + <td height="10"> + </td> + </tr> + <tr> + <td colspan="2">Vil du vide mere om BOS's projekter? + <br></br><br></br> + <img src="/images/pfeil_link_on.gif" width="10" height="9" alt=""></img> + <a href="http://www.savetheorangutan.info" target="_blank" class="more"> + savetheorangutan.info + </a> + <br></br> + <img src="/images/pfeil_link_on.gif" width="10" height="9" alt=""></img> + <a href="http://www.orangutang.dk" target="_blank" class="more"> + orangutang.dk + </a> + <br></br><br></br> + </td> + </tr> + <tr> + <td>På disse hjemmesider kan du finde information om BOS's partnere rundt om i verden. + </td> + </tr> + </table> + </div> + </div> +</bknr:toplevel>

1 0

[bknr-cvs] r2058 - trunk/bknr/src/web
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 15:56:25 -0500 (Sun, 05 Nov 2006) New Revision: 2058 Modified: trunk/bknr/src/web/rss-handlers.lisp Log: Try to properly specify encoding for RSS feed, does not yet work. Modified: trunk/bknr/src/web/rss-handlers.lisp =================================================================== --- trunk/bknr/src/web/rss-handlers.lisp 2006-11-05 20:51:58 UTC (rev 2057) +++ trunk/bknr/src/web/rss-handlers.lisp 2006-11-05 20:56:25 UTC (rev 2058) @@ -9,7 +9,7 @@ (error "invalid channel name")) (defmethod handle-object ((handler rss-handler) (channel bknr.rss:rss-channel) req) - (with-bknr-http-response (req :content-type "text/xml") + (with-bknr-http-response (req :content-type "text/xml; charset=UTF-8") (with-http-body (req *ent*) - (html (:princ "<?xml version=\"1.0\"?>") + (html (:princ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>") (bknr.rss:rss-channel-xml channel *html-stream*)))))

1 0

[bknr-cvs] r2057 - in trunk/bknr/src: . web
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 15:51:58 -0500 (Sun, 05 Nov 2006) New Revision: 2057 Modified: trunk/bknr/src/packages.lisp trunk/bknr/src/web/handlers.lisp trunk/bknr/src/web/tags.lisp Log: Add RSS meta tag to generated pages. Modified: trunk/bknr/src/packages.lisp =================================================================== --- trunk/bknr/src/packages.lisp 2006-11-05 20:51:19 UTC (rev 2056) +++ trunk/bknr/src/packages.lisp 2006-11-05 20:51:58 UTC (rev 2057) @@ -290,6 +290,7 @@ #:website-session-info #:website-base-href #:website-make-path + #:website-rss-feed-url #:host #:publish-site #:publish-handler Modified: trunk/bknr/src/web/handlers.lisp =================================================================== --- trunk/bknr/src/web/handlers.lisp 2006-11-05 20:51:19 UTC (rev 2056) +++ trunk/bknr/src/web/handlers.lisp 2006-11-05 20:51:58 UTC (rev 2057) @@ -45,6 +45,8 @@ :accessor website-site-logo-url) (login-logo-url :initarg :login-logo-url :accessor website-login-logo-url) + (rss-feed-url :initarg :rss-feed-url + :accessor website-rss-feed-url) (import-spool-directory :initarg :import-spool-directory :accessor website-import-spool-directory) (template-base-directory :initarg :template-base-directory @@ -72,7 +74,8 @@ :template-base-directory nil :template-command-packages nil :show-page-function #'show-page - :show-error-page-function #'show-error-page)) + :show-error-page-function #'show-error-page + :rss-feed-url nil)) (defmethod initialize-instance :after ((website website) &key &allow-other-keys) (when *website* Modified: trunk/bknr/src/web/tags.lisp =================================================================== --- trunk/bknr/src/web/tags.lisp 2006-11-05 20:51:19 UTC (rev 2056) +++ trunk/bknr/src/web/tags.lisp 2006-11-05 20:51:58 UTC (rev 2057) @@ -189,6 +189,12 @@ (loop for javascript in (website-javascript-urls *website*) do (html ((:script :type "text/javascript" :language "JavaScript" :src javascript) ""))) + (when (website-rss-feed-url *website*) + (html + ((:link :rel "alternate" + :type "application/rss+xml" + :title "RSS Feed" + :href (website-rss-feed-url *website*))))) ((:link :rel "shortcut icon" :href "/favicon.ico" :type "image/png")) ((:meta :http-equiv "content-type" :content "text/html;charset=utf-8")) (:title (:princ-safe title))))

1 0

[bknr-cvs] r2056 - trunk/bknr/src/data
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 15:51:19 -0500 (Sun, 05 Nov 2006) New Revision: 2056 Modified: trunk/bknr/src/data/object.lisp Log: Make reminder warning for class changes suppressable. Modified: trunk/bknr/src/data/object.lisp =================================================================== --- trunk/bknr/src/data/object.lisp 2006-11-05 13:25:47 UTC (rev 2055) +++ trunk/bknr/src/data/object.lisp 2006-11-05 20:51:19 UTC (rev 2056) @@ -25,16 +25,20 @@ (defmethod validate-superclass ((sub persistent-class) (super indexed-class)) t) +(defvar *suppress-schema-warnings* nil) + (deftransaction update-instances-for-changed-class (class) - (warn "updating ~A instances of ~A for class changes" (length (class-instances class)) class) + (unless *suppress-schema-warnings* + (warn "updating ~A instances of ~A for class changes" (length (class-instances class)) class)) (mapc #'reinitialize-instance (class-instances class))) (defmethod reinitialize-instance :after ((class persistent-class) &rest args) (declare (ignore args)) (when *store* (update-instances-for-changed-class (class-name class)) - (warn "Class ~A has been changed. To ensure correct schema evolution, please snapshot your datastore." - (class-name class)))) + (unless *suppress-schema-warnings* + (warn "Class ~A has been changed. To ensure correct schema evolution, please snapshot your datastore." + (class-name class))))) (defclass persistent-direct-slot-definition (index-direct-slot-definition) ((transient :initarg :transient :initform nil)

1 0

[bknr-cvs] r2055 - in trunk/projects/bos: m2 payment-website/templates/de worldpay-test
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 08:25:47 -0500 (Sun, 05 Nov 2006) New Revision: 2055 Modified: trunk/projects/bos/m2/cert-daemon.lisp trunk/projects/bos/m2/config.lisp trunk/projects/bos/m2/m2.lisp trunk/projects/bos/m2/mail-generator.lisp trunk/projects/bos/m2/make-certificate.lisp trunk/projects/bos/payment-website/templates/de/ueberweisung.xml trunk/projects/bos/worldpay-test/sponsor-handlers.lisp trunk/projects/bos/worldpay-test/tags.lisp trunk/projects/bos/worldpay-test/worldpay-test.lisp Log: Certificate handling overhauled. All donors now have a downloadable PDF certificate. Print certificates are send by mail to the office and deleted from disk thereafter. Modified: trunk/projects/bos/m2/cert-daemon.lisp =================================================================== --- trunk/projects/bos/m2/cert-daemon.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/m2/cert-daemon.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -14,7 +14,6 @@ (defun fill-form (fdf-pathname pdf-pathname output-pathname) (handler-case (progn - (ignore-errors (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname)))) (cond ((unix-namestring pdf-pathname) (run-tool "pdftk" (list (unix-namestring pdf-pathname) Modified: trunk/projects/bos/m2/config.lisp =================================================================== --- trunk/projects/bos/m2/config.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/m2/config.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -48,7 +48,7 @@ *pdf-base-directory*)) (defparameter *receipt-download-template* (merge-pathnames #p"spendenbescheinigung-download.pdf" *pdf-base-directory*)) -(defparameter *cert-daemon-poll-seconds* 15 +(defparameter *cert-daemon-poll-seconds* 2 "Wartezeit zwischen zwei Directory-Scans des Urkunden-Daemons") ;; Mail-Stuff Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/m2/m2.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -238,28 +238,31 @@ (deftransaction contract-set-download-only-p (contract newval) (setf (contract-download-only contract) newval)) -(defmethod contract-fdf-pathname ((contract contract) language) +(defmethod contract-fdf-pathname ((contract contract) &key language print) + (when (and print + (contract-download-only-p contract)) + (error "no print fdf for download-only contract ~A" contract)) (merge-pathnames (make-pathname :name (format nil "~D-~(~A~)" (store-object-id contract) language) :type "fdf") - (if (contract-download-only-p contract) *cert-download-directory* *cert-mail-directory*))) + (if print *cert-mail-directory* *cert-download-directory*))) -(defmethod contract-pdf-pathname ((contract contract)) +(defmethod contract-pdf-pathname ((contract contract) &key print) (merge-pathnames (make-pathname :name (format nil "~D" (store-object-id contract)) :type "pdf") - (if (contract-download-only-p contract) - bos.m2::*cert-download-directory* - bos.m2::*cert-mail-directory*))) + (if print bos.m2::*cert-mail-directory* bos.m2::*cert-download-directory*))) (defmethod contract-pdf-url ((contract contract)) - (format nil "/~:[~;print-~]certificate/~A" (not (contract-download-only-p contract)) (store-object-id contract))) + (format nil "/certificate/~A" (store-object-id contract))) (defmethod contract-issue-cert ((contract contract) name &key address language) (if (contract-cert-issued contract) (warn "can't re-issue cert for ~A" contract) (progn (make-certificate contract name :address address :language language) + (unless (contract-download-only-p contract) + (make-certificate contract name :address address :language language :print t)) (change-slot-values contract 'cert-issued t)))) (defmethod contract-image-tiles ((contract contract)) Modified: trunk/projects/bos/m2/mail-generator.lisp =================================================================== --- trunk/projects/bos/m2/mail-generator.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/m2/mail-generator.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -89,6 +89,7 @@ (apply #'vcard-field field)))))) (defun make-vcard (&key sponsor-id + note vorname nachname name address postcode country @@ -139,7 +140,7 @@ Gift: ~A " cartId - sponsor-id + (store-object-id (contract-sponsor contract)) (length (contract-m2s contract)) authAmountString cardType @@ -153,13 +154,34 @@ :email email :tel tel)))) +(defun mail-contract-data (contract type mime-parts) + (unless (contract-download-only-p contract) + (push (make-instance 'mime + :type "application" + :subtype (format nil "pdf; name=\"contract-~A.pdf\"" (store-object-id contract)) + :encoding :base64 + :content (file-contents (contract-pdf-pathname contract :print t))) + mime-parts)) + (send-system-mail :subject (format nil "~A-Spenderdaten - Sponsor-ID ~D Contract-ID ~D" + type + (store-object-id (contract-sponsor contract)) + (store-object-id contract)) + :content-type "multipart/mixed" + :more-headers t + :text (with-output-to-string (s) + (print-mime s + (make-instance 'multipart-mime + :subtype "mixed" + :content mime-parts) + t t))) + (unless (contract-download-only-p contract) + (delete-file (contract-pdf-pathname contract :print t)))) + (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))) - (mime (make-instance 'multipart-mime - :subtype "mixed" - :content (list (make-instance 'text-mime + (parts (list (make-instance 'text-mime :type "text" :subtype "html" :charset "utf-8" @@ -181,15 +203,7 @@ <tr><td></td></tr> <tr><td>Spendenbescheinigung am Jahresende</td><td>~A</td></tr>~] </table> - <p>Email & Adresse fuer Cut&Paste:</p> - <pre> -~A - -~A ~A -~A -~A ~A - </pre> - <p><a href=\"~A/complete-transfer/~A\">Link zum Sponsor-Datensatz</a></p> + <p><a href=\"~A/complete-transfer/~A?email=~A\">Zahlungseingang bestätigen</a></p> </body> </html> " @@ -197,9 +211,7 @@ (length (contract-m2s contract)) vorname name strasse plz ort email telefon (if donationcert-yearly "ja" "nein") - email vorname name - strasse plz ort - *website-url* contract-id)) + *website-url* contract-id email)) (make-instance 'text-mime :type "text" :subtype (format nil "xml; name=\"contract-~A.xml\"" contract-id) @@ -223,7 +235,7 @@ :charset "utf-8" :content (make-vcard :sponsor-id sponsor-id :note (format nil "Paid-by: Manual money transfer -Contract ID: ~Annn +Contract ID: ~A Sponsor ID: ~A Number of sqms: ~A Amount: EUR~A.00 @@ -234,32 +246,19 @@ (length (contract-m2s contract)) (* 3 (length (contract-m2s contract))) (if donationcert-yearly "Yes" "No")) - :contract-id contract-id - :donationcert-yearly donationcert-yearly :vorname vorname :nachname name :strasse strasse :postcode plz :ort ort :email email - :tel telefon)) - (make-instance 'mime - :type "application" - :subtype (format nil "pdf; name=\"contract-~A.pdf\"" contract-id) - :encoding :base64 - :content (file-contents (contract-pdf-pathname contract))))))) - (send-system-mail :subject (format nil "Ueberweisungsformular-Spenderdaten - Sponsor-ID ~D Contract-ID ~D" - sponsor-id contract-id) - :content-type "multipart/mixed" - :more-headers t - :text (with-output-to-string (s) (print-mime s mime t t)))))) + :tel telefon))))) + (mail-contract-data contract "Ueberweisungsformular" parts)))) (defun mail-worldpay-sponsor-data (req) (with-query-params (req cartId) (let* ((contract (store-object-with-id (parse-integer cartId))) - (mime (make-instance 'multipart-mime - :subtype "mixed" - :content (list (make-instance 'text-mime + (parts (list (make-instance 'text-mime :type "text" :subtype "html" :charset "utf-8" @@ -298,10 +297,5 @@ :type "text" :subtype (format nil "x-vcard; name=\"contract-~A.vcf\"" (store-object-id contract)) :charset "utf-8" - :content (worldpay-callback-request-to-vcard req)))))) - (send-system-mail :subject (format nil "Online-Spenderdaten - Sponsor-ID ~D Contract-ID ~D" - (store-object-id (contract-sponsor contract)) - (store-object-id contract)) - :content-type "multipart/mixed" - :more-headers t - :text (with-output-to-string (s) (print-mime s mime t t)))))) + :content (worldpay-callback-request-to-vcard req))))) + (mail-contract-data contract "WorldPay" parts)))) Modified: trunk/projects/bos/m2/make-certificate.lisp =================================================================== --- trunk/projects/bos/m2/make-certificate.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/m2/make-certificate.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -27,13 +27,15 @@ ;; bzw. im Dateisystem für den Download durch den Spender abgelegt ;; werden. -(defun make-certificate (contract name &key (address "") (language "en")) +(defun make-certificate (contract name &key print (address "") (language "en")) "Erzeugen einer FDF-Datei für das Ausfüllen der Urkunde. Wenn das optionale address-Argument übergeben wird, wird die Urkunde per Post verschickt und entsprechend eine andere Vorlage ausgewählt als für den Download der Urkunde" (let ((sponsor (contract-sponsor contract))) - (make-fdf-file (contract-fdf-pathname contract language) + (make-fdf-file (contract-fdf-pathname contract + :language language + :print print) :datum (format-date-time (contract-date contract) :show-time nil) :name name :address address Modified: trunk/projects/bos/payment-website/templates/de/ueberweisung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/ueberweisung.xml 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/payment-website/templates/de/ueberweisung.xml 2006-11-05 13:25:47 UTC (rev 2055) @@ -103,16 +103,6 @@ <td><input name="telefon" type="text" size="25" maxlength="30" /></td> </tr> <tr> - <td colspan="3" height="5"> </td> - </tr> - <tr> - <td colspan="3"> - <bos:urkunde-per-post contract-id="$(contract-id)" - min-amount="30" - message="Ich möchte meine Regenwald-Urkunde per Post erhalten" /> - </td> - </tr> - <tr> <td colspan="3" height="20"> </td> </tr> <tr> Modified: trunk/projects/bos/worldpay-test/sponsor-handlers.lisp =================================================================== --- trunk/projects/bos/worldpay-test/sponsor-handlers.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/worldpay-test/sponsor-handlers.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -185,25 +185,26 @@ (redirect (format nil "/edit-sponsor/~D" (store-object-id (contract-sponsor contract))) req) (let ((numsqm (length (contract-m2s contract)))) - (with-bos-cms-page (req :title "Complete square meter sale with wire transfer payment") - (html - ((:form :name "form") - ((:input :type "hidden" :name "numsqm" :value #?"$(numsqm)")) - ((:table) - (:tr (:td "Number of square meters") - (:td (:princ-safe numsqm))) - (:tr (:td "Bought on") - (:td (:princ-safe (format-date-time (contract-date contract))))) - (: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))))))) - (:tr (:td "Email-Address") - (:td (text-field "email" :size 20))) - (:tr (:td (submit-button "process" "process" :formcheck "javascript:return check_complete_sale()")))))))))) + (with-query-params (req email) + (with-bos-cms-page (req :title "Complete square meter sale with wire transfer payment") + (html + ((:form :name "form") + ((:input :type "hidden" :name "numsqm" :value #?"$(numsqm)")) + ((:table) + (:tr (:td "Number of square meters") + (:td (:princ-safe numsqm))) + (:tr (:td "Bought on") + (:td (:princ-safe (format-date-time (contract-date contract))))) + (: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))))))) + (: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) Modified: trunk/projects/bos/worldpay-test/tags.lisp =================================================================== --- trunk/projects/bos/worldpay-test/tags.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/worldpay-test/tags.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -101,11 +101,10 @@ (define-bknr-tag mail-transfer () (with-query-params ((get-template-var :request) - contract-id mail-certificate + contract-id name vorname strasse plz ort) (let* ((contract (store-object-with-id (parse-integer contract-id))) - (download-only (or (< (contract-price contract) *mail-certificate-threshold*) - (not mail-certificate)))) + (download-only (< (contract-price contract) *mail-certificate-threshold*))) (contract-set-download-only-p contract download-only) (contract-issue-cert contract (format nil "~A ~A" vorname name) :address (format nil "~A ~A~%~A~%~A ~A" @@ -114,16 +113,15 @@ plz ort) :language (session-variable :language)) (loop - do (sleep 1) + do (progn + (format t "~&; waiting for generation of certificate, contract-id ~A" contract-id) + (sleep 2)) until (probe-file (contract-pdf-pathname contract))) (mail-manual-sponsor-data (get-template-var :request))))) (define-bknr-tag when-certificate (&key children) (let ((sponsor (bknr-request-user (get-template-var :request)))) - (when (some #'(lambda (contract) - (and (contract-download-only-p contract) - (contract-pdf-pathname contract))) - (sponsor-contracts sponsor)) + (when (some #'contract-pdf-pathname (sponsor-contracts sponsor)) (mapc #'emit-template-node children)))) (define-bknr-tag send-info-request (&key children email) Modified: trunk/projects/bos/worldpay-test/worldpay-test.lisp =================================================================== --- trunk/projects/bos/worldpay-test/worldpay-test.lisp 2006-11-05 13:23:45 UTC (rev 2054) +++ trunk/projects/bos/worldpay-test/worldpay-test.lisp 2006-11-05 13:25:47 UTC (rev 2055) @@ -134,19 +134,6 @@ ((:p :id "stats")) ((:script :type "text/javascript") "statistic_selected()")))))) -(defclass print-certificate-handler (admin-only-handler object-handler) - () - (:default-initargs :class 'contract)) - -(defmethod handle-object ((handler print-certificate-handler) contract req) - (let ((pdf (file-contents (merge-pathnames (make-pathname :type "pdf" - :name (format nil "~D" (store-object-id contract))) - *cert-mail-directory*)))) - (with-http-response (req *ent* :content-type "application/pdf") - (setf (request-reply-content-length req) (length pdf)) - (with-http-body (req *ent* :external-format '(unsigned-byte 8)) - (write-sequence pdf *html-stream*))))) - (defclass admin-handler (admin-only-handler page-handler) ()) @@ -219,7 +206,6 @@ ("/admin" admin-handler) ("/languages" languages-handler) ("/infosystem" infosystem-handler) - ("/print-certificate" print-certificate-handler) ("/overview" image-tile-handler) ("/enlarge-overview" enlarge-tile-handler) ("/create-contract" create-contract-handler)

1 0

[bknr-cvs] r2054 - in trunk/bknr/src: . utils web
by bknr＠bknr.net 05 Nov '06

05 Nov '06

Author: hhubner Date: 2006-11-05 08:23:45 -0500 (Sun, 05 Nov 2006) New Revision: 2054 Modified: trunk/bknr/src/bknr-utils.asd trunk/bknr/src/utils/make-fdf-file.lisp trunk/bknr/src/utils/package.lisp trunk/bknr/src/utils/utils.lisp trunk/bknr/src/web/web-utils.lisp Log: Misc small fixes and changes. Modified: trunk/bknr/src/bknr-utils.asd =================================================================== --- trunk/bknr/src/bknr-utils.asd 2006-11-04 08:50:05 UTC (rev 2053) +++ trunk/bknr/src/bknr-utils.asd 2006-11-05 13:23:45 UTC (rev 2054) @@ -20,7 +20,8 @@ :cxml :md5 #+(not allegro) - :acl-compat) + :acl-compat + :iconv) :components ((:module "statistics" :components ((:file "package") (:file "runtime-statistics" :depends-on ("package")))) Modified: trunk/bknr/src/utils/make-fdf-file.lisp =================================================================== --- trunk/bknr/src/utils/make-fdf-file.lisp 2006-11-04 08:50:05 UTC (rev 2053) +++ trunk/bknr/src/utils/make-fdf-file.lisp 2006-11-05 13:23:45 UTC (rev 2054) @@ -2,8 +2,8 @@ ;; make-fdf-file.lisp -;; Funktion zum Erstellen von FDF-Dateien. Diese k�nnen mit Hilfe von -;; pdftk verwendet werden, um PDF-Formulare auszuf�llen. Das +;; Funktion zum Erstellen von FDF-Dateien. Diese können mit Hilfe von +;; pdftk verwendet werden, um PDF-Formulare auszuföllen. Das ;; FDF-Format ist dabei ein Unterformat von Adobe PDF und wird in der ;; PDF-Spezifikation beschrieben. @@ -23,7 +23,11 @@ [ ") (loop for (key value) on keys-and-values by #'cddr - do (format stream " <</T(~(~a~))/V(~a)>>~%" key (pdf-quote-string (if (stringp value) value (format nil "~a" value))))) + do (format stream " <</T(~(~a~))/V(~a)>>~%" key + (pdf-quote-string (iconv:iconv "UTF-8" "ISO-8859-1" + (if (stringp value) + value + (format nil "~a" value)))))) (format stream " ] >> >> Modified: trunk/bknr/src/utils/package.lisp =================================================================== --- trunk/bknr/src/utils/package.lisp 2006-11-04 08:50:05 UTC (rev 2053) +++ trunk/bknr/src/utils/package.lisp 2006-11-05 13:23:45 UTC (rev 2054) @@ -57,7 +57,6 @@ #:find-neighbourhood #:group-by #:group-on - #:flatten #:find-all #:genlist #:rotate Modified: trunk/bknr/src/utils/utils.lisp =================================================================== --- trunk/bknr/src/utils/utils.lisp 2006-11-04 08:50:05 UTC (rev 2053) +++ trunk/bknr/src/utils/utils.lisp 2006-11-05 13:23:45 UTC (rev 2054) @@ -269,13 +269,6 @@ (loop for key being the hash-key of hash using (hash-value val) collect (cons key val)))) -(defun flatten (list) - (if (null list) - (list) - (if (atom (car list)) - (cons (car list) (flatten (cdr list))) - (flatten (append (car list) (cdr list)))))) - (defun count-multiple (objects &rest keys) (let ((hash-tables (loop for i from 1 to (length keys) collect (make-hash-table :test #'equal))) Modified: trunk/bknr/src/web/web-utils.lisp =================================================================== --- trunk/bknr/src/web/web-utils.lisp 2006-11-04 08:50:05 UTC (rev 2053) +++ trunk/bknr/src/web/web-utils.lisp 2006-11-05 13:23:45 UTC (rev 2054) @@ -126,8 +126,7 @@ (defun query-param (request param-name) (let ((value (cdr (assoc param-name (all-request-params request) :test #'string-equal)))) - (when (and value - (equal "" value)) + (when (equal "" value) (setf value nil)) value))

1 0

[bknr-cvs] r2053 - trunk/thirdparty/kmrcl-1.72
by bknr＠bknr.net 04 Nov '06

04 Nov '06

Author: hhubner Date: 2006-11-04 03:50:05 -0500 (Sat, 04 Nov 2006) New Revision: 2053 Modified: trunk/thirdparty/kmrcl-1.72/package.lisp Log: do not export *base-url*, used within bknr Modified: trunk/thirdparty/kmrcl-1.72/package.lisp =================================================================== --- trunk/thirdparty/kmrcl-1.72/package.lisp 2006-11-04 08:31:43 UTC (rev 2052) +++ trunk/thirdparty/kmrcl-1.72/package.lisp 2006-11-04 08:50:05 UTC (rev 2053) @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.1 2004/06/23 08:27:12 hans Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -215,7 +215,7 @@ #:init/repl ;; From web-utils - #:*base-url* + #+(or) #:*base-url* #:base-url! #:make-url #:*standard-html-header*

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs November 2006