October 2006 - bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] r2038 - in branches/xml-class-rework/projects/bos: m2 worldpay-test
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 07:45:32 -0400 (Mon, 23 Oct 2006) New Revision: 2038 Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp Log: copy-list before sorting Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/mail-generator.lisp 2006-10-23 11:10:22 UTC (rev 2037) +++ branches/xml-class-rework/projects/bos/m2/mail-generator.lisp 2006-10-23 11:45:32 UTC (rev 2038) @@ -207,11 +207,11 @@ </sponsor> " (apply #'append (mapcar #'(lambda (cons) - (list (car cons) - (if (find #\Newline (cdr cons)) - (format nil "<![CDATA[~A]]>" (cdr cons)) - (cdr cons)) - (car 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" @@ -253,7 +253,7 @@ </table> " (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons))) - (sort (all-request-params req) + (sort (copy-list (all-request-params req)) #'string-lessp :key #'car))))) (make-instance 'text-mime Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-10-23 11:10:22 UTC (rev 2037) +++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-10-23 11:45:32 UTC (rev 2038) @@ -24,7 +24,7 @@ (defmethod find-template-pathname ((handler worldpay-template-handler) template-name &key request) (when (scan #?r"(^|.*/)handle-sale" template-name) - (with-query-params (request cartId email name address country transStatus lang MC_gift MC_donationcert-yearly testMode) + (with-query-params (request cartId name address country transStatus lang MC_gift) (unless (website-supports-language lang) (setf lang *default-language*)) (let ((contract (get-contract (parse-integer cartId))))

1 0

[bknr-cvs] r2037 - branches/xml-class-rework/thirdparty/cl-qprint
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 07:10:22 -0400 (Mon, 23 Oct 2006) New Revision: 2037 Modified: branches/xml-class-rework/thirdparty/cl-qprint/base.lisp Log: Throw error if unexpected type of input passed to encode/decode. Modified: branches/xml-class-rework/thirdparty/cl-qprint/base.lisp =================================================================== --- branches/xml-class-rework/thirdparty/cl-qprint/base.lisp 2006-10-23 08:15:36 UTC (rev 2036) +++ branches/xml-class-rework/thirdparty/cl-qprint/base.lisp 2006-10-23 11:10:22 UTC (rev 2037) @@ -33,7 +33,7 @@ from INPUT and produces the equivalent decoded string" (let ((out-stream (make-string-output-stream)) (in-stream - (typecase input + (etypecase input (string (make-string-input-stream input)) (stream input)))) (do ((char (read-char in-stream nil 'eof) @@ -73,7 +73,7 @@ a quoted-printable encoded string" (let ((out-stream (make-string-output-stream)) (in-stream - (typecase input + (etypecase input (string (make-string-input-stream input)) (stream input))) (last-line-break 0)

1 0

[bknr-cvs] r2036 - branches/xml-class-rework/thirdparty/cl-mime
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 04:15:36 -0400 (Mon, 23 Oct 2006) New Revision: 2036 Modified: branches/xml-class-rework/thirdparty/cl-mime/classes.lisp Log: Fix type declarations for epilogue and prologue (not string, but string or nil) Modified: branches/xml-class-rework/thirdparty/cl-mime/classes.lisp =================================================================== --- branches/xml-class-rework/thirdparty/cl-mime/classes.lisp 2006-10-23 08:14:40 UTC (rev 2035) +++ branches/xml-class-rework/thirdparty/cl-mime/classes.lisp 2006-10-23 08:15:36 UTC (rev 2036) @@ -107,13 +107,11 @@ (prologue :accessor prologue :initform nil - :initarg :prologue - :type string) + :initarg :prologue) (epilogue :accessor epilogue :initform nil - :initarg :epilogue - :type string)) + :initarg :epilogue)) (:documentation "Multipart Mime Object Representation")) ;;; This boundary contains text which should never appear in the

1 0

[bknr-cvs] r2035 - in branches/xml-class-rework/projects/bos: m2 worldpay-test
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 04:14:40 -0400 (Mon, 23 Oct 2006) New Revision: 2035 Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp branches/xml-class-rework/projects/bos/m2/packages.lisp branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp Log: mail vcards of manual sales functions renamed, api enhanced Modified: branches/xml-class-rework/projects/bos/m2/mail-generator.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/mail-generator.lisp 2006-10-23 06:05:39 UTC (rev 2034) +++ branches/xml-class-rework/projects/bos/m2/mail-generator.lisp 2006-10-23 08:14:40 UTC (rev 2035) @@ -10,8 +10,14 @@ To: ~A Subject: ~A Content-Type: ~A -~@[~%~]~A" - (format-date-time (get-universal-time) :mail-style t) *mail-sender* to subject content-type (not more-headers) text))) +~@[~*~%~]~A" + (format-date-time (get-universal-time) :mail-style t) + *mail-sender* + to + subject + content-type + (not more-headers) + text))) (defun mail-info-request (email) (send-system-mail :subject "Mailinglisten-Eintrag" @@ -26,7 +32,7 @@ (send-system-mail :subject #?"Druckauftrag fuer Spender-Urkunde" :text #?"Bitte die folgende Urkunde ausdrucken und versenden: -http://create-rainforest.org/print-certificate/$(contract-id) +$(*website-url*)/print-certificate/$(contract-id) Versandadresse: @@ -75,27 +81,100 @@ Das Team von BOS Deutschland e.V."))) -(defun mail-transfer-indication (contract-id vorname name strasse plz ort email telefon mail-certificate donationcert-yearly) - (let ((contract (store-object-with-id (parse-integer contract-id)))) - (send-system-mail :subject #?"Ueberweisungsformular fuer Contract-ID $(contract-id)" - :content-type "text/html; charset=UTF-8" - :text (format nil " +(defun make-vcard (&key contract-id sponsor-id worldpay-transaction-id + donationcert-yearly gift + vorname nachname + name + address postcode country + strasse ort + email tel) + (with-output-to-string (s) + (format s "BEGIN:VCARD~%") + (format s "REV:~A~%" (format-date-time (get-universal-time) :xml-style t)) + (format s "VERSION:2.1~%") + (if name + (format s "FN;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A~%" (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" name))) + (format s "FN;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A ~A~%" + (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" vorname)) + (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" nachname)))) + (when vorname + (format s "N;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A;~A;;;~%" + (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" nachname)) + (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" vorname)))) + (when address + (format s "ADR;DOM;HOME;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:;;~A;;;~@[~A~];~A~%" + (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" address) :encode-newlines t) postcode country)) + (when strasse + (format s "ADR;DOM;HOME;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:;;~A;~A;;~A;~@[~A~]~%" + (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" strasse)) + (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" ort)) + postcode country)) + (when tel + (format s "TEL;WORK;HOME:~A~%" tel)) + (format s "EMAIL;PREF;INTERNET:~A~%" email) + (format s "URL;WORK:~A/edit-sponsor/~A~%" *website-url* sponsor-id) + (format s "NOTE;ENCODING=QUOTED-PRINTABLE:~A~%" + (cl-qprint:encode (format nil "Contract ID: ~A~%Sponsor ID: ~A~%~@[WorldPay Transaction ID: ~A~%~]Donationcert yearly: ~A~%Gift: ~A~%" + contract-id + sponsor-id + worldpay-transaction-id + (if donationcert-yearly "Yes" "No") + (if gift "Yes" "No")) + :encode-newlines t)) + (format s "END:VCARD~%"))) + +(defun worldpay-callback-request-to-vcard (request) + (with-query-params (request cartId + transId + MC_sponsorid + MC_donationcert-yearly + MC_gift + name + address + postcode + country + email + tel) + (make-vcard :contract-id cartId + :sponsor-id MC_sponsorid + :worldpay-transaction-id transId + :donationcert-yearly MC_donationcert-yearly + :gift MC_gift + :name name + :address address + :postcode postcode + :country country + :email email + :tel tel))) + +(defun mail-manual-sponsor-data (req) + (with-query-params (req contract-id vorname name strasse plz ort email telefon mail-certificate 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 + :type "text" + :subtype "html" + :charset "utf-8" + :encoding :quoted-printable + :content (format nil " <html> <body> <h1>Ueberweisungsformulardaten:</h1> <table border=\"1\"> - <tr><td>Contract-ID</td><td>~@[~a~]</td></tr> - <tr><td>Anzahl sqm</td><td>~a</td></tr> - <tr><td>Vorname</td><td>~@[~a~]</td></tr> - <tr><td>Name</td><td>~@[~a~]</td></tr> - <tr><td>Strasse</td><td>~@[~a~]</td></tr> - <tr><td>PLZ</td><td>~@[~a~]</td></tr> - <tr><td>Ort</td><td>~@[~a~]</td></tr> - <tr><td>Email</td><td>~@[~a~]</td></tr> - <tr><td>Telefon</td><td>~@[~a~]</td></tr>~@[ + <tr><td>Contract-ID</td><td>~@[~A~]</td></tr> + <tr><td>Anzahl sqm</td><td>~A</td></tr> + <tr><td>Vorname</td><td>~@[~A~]</td></tr> + <tr><td>Name</td><td>~@[~A~]</td></tr> + <tr><td>Strasse</td><td>~@[~A~]</td></tr> + <tr><td>PLZ</td><td>~@[~A~]</td></tr> + <tr><td>Ort</td><td>~@[~A~]</td></tr> + <tr><td>Email</td><td>~@[~A~]</td></tr> + <tr><td>Telefon</td><td>~@[~A~]</td></tr>~@[ <tr><td></td></tr> - <tr><td>Urkunde per Post</td><td>~a</td></tr> - <tr><td>Spendenbescheinigung am Jahresende</td><td>~a</td></tr>~] + <tr><td>Urkunde per Post</td><td>~A</td></tr> + <tr><td>Spendenbescheinigung am Jahresende</td><td>~A</td></tr>~] </table> <p>Email & Adresse fuer Cut&Paste:</p> <pre> @@ -105,60 +184,66 @@ ~A ~A ~A </pre> - <p><a href=\"http://create-rainforest.org/complete-transfer/~a\">Link zum Sponsor-Datensatz</a></p> + <p><a href=\"~A/complete-transfer/~A\">Link zum Sponsor-Datensatz</a></p> </body> </html> " - contract-id - (length (contract-m2s contract)) - vorname name strasse plz ort email telefon - (if mail-certificate "ja" "nein") - (if donationcert-yearly "ja" "nein") - email vorname name strasse plz ort - contract-id)))) + contract-id + (length (contract-m2s contract)) + vorname name strasse plz ort email telefon + (if mail-certificate "ja" "nein") + (if donationcert-yearly "ja" "nein") + email vorname name + strasse plz ort + *website-url* contract-id)) + (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 :contract-id contract-id + :sponsor-id sponsor-id + :donationcert-yearly donationcert-yearly + :vorname vorname + :nachname name + :strasse strasse + :postcode plz + :ort ort + :email email + :tel telefon)))))) + (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)))))) -(defun worldpay-callback-request-to-vcard (request) - (with-query-params (request cartId - transId - MC_sponsorid - MC_donationcert-yearly - MC_gift - name - address - postcode - country - email - tel) - (with-output-to-string (s) - (format s "BEGIN:VCARD~%") - (format s "REV:~A~%" (format-date-time (get-universal-time) :xml-style t)) - (format s "VERSION:2.1~%") - (format s "FN;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:~A~%" (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" name))) - (format s "ADR;DOM;HOME;CHARSET=ISO-8859-1;ENCODING=QUOTED-PRINTABLE:;;~A;;;~@[~A~];~A~%" - (cl-qprint:encode (iconv:iconv "UTF-8" "ISO-8859-1" address) :encode-newlines t) postcode country) - (when tel - (format s "TEL;WORK;HOME:~A~%" tel)) - (format s "EMAIL;PREF;INTERNET:~A~%" email) - (format s "URL;WORK:~A/edit-sponsor/~A~%" *website-url* MC_sponsorid) - (format s "NOTE;ENCODING=QUOTED-PRINTABLE:~A~%" - (cl-qprint:encode (format nil "Contract ID: ~A~%Sponsor ID: ~A~%WorldPay Transaction ID: ~A~%Donationcert yearly: ~A~%Gift: ~A~%" - cartId - MC_sponsorid - transId - (if MC_donationcert-yearly "Yes" "No") - (if MC_gift "Yes" "No")) - :encode-newlines t)) - (format s "END:VCARD~%")))) - -(defun mail-request-parameters (req subject) - (let ((mime (make-instance 'cl-mime:multipart-mime - :subtype "mixed" - :content (list (make-instance 'cl-mime:text-mime - :type "text" - :subtype "html" - :charset "utf-8" - :encoding :quoted-printable - :content (format nil " +(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 + :type "text" + :subtype "html" + :charset "utf-8" + :encoding :quoted-printable + :content (format nil " <table border=\"1\"> <tr> <th>Parameter</th> @@ -167,27 +252,35 @@ ~{<tr><td>~A</td><td>~A</td></tr>~} </table> " - (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons))) - (all-request-params req))))) - (make-instance 'cl-mime:text-mime - :type "text" - :subtype "xml; name=\"sponsor.xml\"" - :charset "utf-8" - :encoding :quoted-printable - :content (format nil " + (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons))) + (sort (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 " <sponsor> ~{<~A>~A</~A>~} </sponsor> " - (apply #'append (mapcar #'(lambda (cons) (list (car cons) (cdr cons) (car cons))) - (all-request-params req))))) - (make-instance 'cl-mime:text-mime - :type "text" - :subtype "x-vcard; name=\"sponsor.vcf\"" - :charset "utf-8" - :content (worldpay-callback-request-to-vcard req)))))) - (format t "made mame~%") - (send-system-mail :subject subject - :content-type "multipart/mixed" - :more-headers t - :text (with-output-to-string (s) (cl-mime:print-mime s mime t t))))) + (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)))))) + (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)))))) Modified: branches/xml-class-rework/projects/bos/m2/packages.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/packages.lisp 2006-10-23 06:05:39 UTC (rev 2034) +++ branches/xml-class-rework/projects/bos/m2/packages.lisp 2006-10-23 08:14:40 UTC (rev 2035) @@ -38,6 +38,7 @@ :bos.m2.config :net.post-office :cxml + :cl-mime :cl-gd) (:shadowing-import-from :cl-interpol #:quote-meta-chars) (:export #:m2-store @@ -178,9 +179,9 @@ #:mail-fiscal-certificate-to-office #:mail-instructions-to-sponsor - #:mail-transfer-indication #:mail-info-request - #:mail-request-parameters + #:mail-manual-sponsor-data + #:mail-worldpay-sponsor-data #:*cert-download-directory*)) Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-10-23 06:05:39 UTC (rev 2034) +++ branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-10-23 08:14:40 UTC (rev 2035) @@ -100,8 +100,7 @@ (mapc #'emit-template-node children)) (define-bknr-tag mail-transfer () - (with-query-params ((get-template-var :request) contract-id vorname name strasse plz ort email telefon mail-certificate donationcert-yearly) - (mail-transfer-indication contract-id vorname name strasse plz ort email telefon mail-certificate donationcert-yearly))) + (mail-manual-sponsor-data (get-template-var :request))) (define-bknr-tag when-certificate (&key children) (let ((sponsor (bknr-request-user (get-template-var :request)))) Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-10-23 06:05:39 UTC (rev 2034) +++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-10-23 08:14:40 UTC (rev 2035) @@ -36,14 +36,10 @@ ((equal "C" transStatus) (setf template-name #?"/$(lang)/sponsor_canceled")) ((< (contract-price contract) *mail-certificate-threshold*) - (mail-request-parameters request (format nil "Online-Spenderdaten - Sponsor-ID ~D Contract-ID ~D" - (store-object-id (contract-sponsor contract)) - (store-object-id contract))) + (mail-worldpay-sponsor-data request) (setf template-name #?"/$(lang)/quittung")) (t - (mail-request-parameters request (format nil "Online-Spenderdaten - Sponsor-ID ~D Contract-ID ~D" - (store-object-id (contract-sponsor contract)) - (store-object-id contract))) + (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] r2034 - branches/xml-class-rework/projects/bos/tools
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 02:05:39 -0400 (Mon, 23 Oct 2006) New Revision: 2034 Modified: branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl Log: Pass content-type to handling host. Modified: branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl =================================================================== --- branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl 2006-10-23 05:53:29 UTC (rev 2033) +++ branches/xml-class-rework/projects/bos/tools/wp-callpack-redirect.pl 2006-10-23 06:05:39 UTC (rev 2034) @@ -18,6 +18,8 @@ my $is_test = ($content =~ /testMode=100/); my $host = $is_test ? "test.createrainforest.org" : "createrainforest.org"; + + $ua->default_header('Content-Type', $request->header('Content-Type')); my $response = $ua->get("http://" . $host . ":8080/handle-sale?" . $content); $client->send_response($response); print "Redirected request to ", ($is_test ? "TEST" : "PRODUCTION"), " system\n";

1 0

[bknr-cvs] r2033 - branches/xml-class-rework/thirdparty/iconv
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 01:53:29 -0400 (Mon, 23 Oct 2006) New Revision: 2033 Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp Log: Fix error handling Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp =================================================================== --- branches/xml-class-rework/thirdparty/iconv/iconv.lisp 2006-10-23 05:11:42 UTC (rev 2032) +++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp 2006-10-23 05:53:29 UTC (rev 2033) @@ -81,13 +81,11 @@ in-ptr inbytesleft out-ptr outbytesleft) #xffffffff) - (if (= (get-errno) EILSEQ) + (if (find (get-errno) (list EILSEQ EINVAL) :test #'eql) (if error-p - (error "invalid multibyte(~X)." - (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current))) + (error "invalid multibyte character (0x~X)." (cffi:mem-aref inbuffer :unsigned-char (current))) (progn - (setf (cffi-uffi-compat:deref-array inbuffer (cffi-uffi-compat::convert-uffi-type :unsigned-byte) (current)) - error-value) + (setf (cffi:mem-aref inbuffer :unsigned-char (current)) error-value) (self))) (error "unexpected iconv error ~A" (get-errno)))))) (self))

1 0

[bknr-cvs] r2032 - branches/xml-class-rework/thirdparty/cl-qprint
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 01:11:42 -0400 (Mon, 23 Oct 2006) New Revision: 2032 Modified: branches/xml-class-rework/thirdparty/cl-qprint/base.lisp Log: Properly generate crlf Modified: branches/xml-class-rework/thirdparty/cl-qprint/base.lisp =================================================================== --- branches/xml-class-rework/thirdparty/cl-qprint/base.lisp 2006-10-23 05:00:44 UTC (rev 2031) +++ branches/xml-class-rework/thirdparty/cl-qprint/base.lisp 2006-10-23 05:11:42 UTC (rev 2032) @@ -102,7 +102,7 @@ ;; Ensure newlines are CR-LF ((char= c #\newline) (if encode-newlines - (format out-stream "=0A=0D") + (format out-stream "=0D=0A") (cr-lf out-stream)) (setf last-line-break position))

1 0

[bknr-cvs] r2031 - branches/xml-class-rework/thirdparty/iconv
by bknr＠bknr.net 23 Oct '06

23 Oct '06

Author: hhubner Date: 2006-10-23 01:00:44 -0400 (Mon, 23 Oct 2006) New Revision: 2031 Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp Log: modified for different errno handling in cmucl19c Modified: branches/xml-class-rework/thirdparty/iconv/iconv.lisp =================================================================== --- branches/xml-class-rework/thirdparty/iconv/iconv.lisp 2006-10-22 17:18:39 UTC (rev 2030) +++ branches/xml-class-rework/thirdparty/iconv/iconv.lisp 2006-10-23 05:00:44 UTC (rev 2031) @@ -12,13 +12,15 @@ (cffi-uffi-compat:load-foreign-library "/usr/lib/libc.so") (cffi-uffi-compat:load-foreign-library "/usr/local/lib/libiconv.so") -#-:sbcl +#-sbcl (cffi-uffi-compat:def-foreign-var ("errno" errno) :int "iconv") (defun get-errno () - #-:sbcl + #-(or sbcl cmu19c) errno - #+:sbcl + #+cmu19c + (unix:unix-errno) + #+sbcl (sb-alien:get-errno) )

1 0

[bknr-cvs] r2030 - branches/xml-class-rework/projects/bos
by bknr＠bknr.net 22 Oct '06

22 Oct '06

Author: hhubner Date: 2006-10-22 13:18:39 -0400 (Sun, 22 Oct 2006) New Revision: 2030 Modified: branches/xml-class-rework/projects/bos/build.lisp Log: Reinitialize shared libs while starting up in (presumably) original order so that dependencies between libraries are correctly caught. Modified: branches/xml-class-rework/projects/bos/build.lisp =================================================================== --- branches/xml-class-rework/projects/bos/build.lisp 2006-10-22 17:00:41 UTC (rev 2029) +++ branches/xml-class-rework/projects/bos/build.lisp 2006-10-22 17:18:39 UTC (rev 2030) @@ -35,7 +35,7 @@ (swank::create-swank-server 4005 :spawn #'swank::simple-announce-function t)) (defun reload-global-table () - (loop for lib-entry in sys::*global-table* + (loop for lib-entry in (reverse sys::*global-table*) for (sap . lib-path) = lib-entry when lib-path do (let ((new-sap (sys::dlopen (namestring lib-path)

1 0

[bknr-cvs] r2029 - branches/xml-class-rework/projects/bos/m2
by bknr＠bknr.net 22 Oct '06

22 Oct '06

Author: hhubner Date: 2006-10-22 13:00:41 -0400 (Sun, 22 Oct 2006) New Revision: 2029 Modified: branches/xml-class-rework/projects/bos/m2/bos.m2.asd Log: Use iconv package Modified: branches/xml-class-rework/projects/bos/m2/bos.m2.asd =================================================================== --- branches/xml-class-rework/projects/bos/m2/bos.m2.asd 2006-10-22 16:50:56 UTC (rev 2028) +++ branches/xml-class-rework/projects/bos/m2/bos.m2.asd 2006-10-22 17:00:41 UTC (rev 2029) @@ -1,7 +1,7 @@ (in-package :cl-user) (asdf:defsystem :bos.m2 - :depends-on (:bknr :bknr-modules :net.post-office :cl-mime) + :depends-on (:bknr :bknr-modules :net.post-office :cl-mime :iconv) :components ((:file "packages") (:file "config" :depends-on ("packages")) (:file "utils" :depends-on ("config"))

1 0