Author: hhubner Date: 2006-03-12 06:37:36 -0500 (Sun, 12 Mar 2006) New Revision: 1918

Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp branches/xml-class-rework/projects/bos/m2/m2.lisp Log: Support multi lingual certificate versions.

Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-12 11:36:07 UTC (rev 1917) +++ branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-12 11:37:36 UTC (rev 1918) @@ -9,25 +9,31 @@ (error "Error executing ~A - Exit code ~D~%Error message: ~A" (format nil ""~A~{ ~A~}"" program program-args) (process-exit-code process) error-message)))))

-(defun fill-form (fdf-pathname pdf-pathname) - (let ((output-pathname (merge-pathnames (make-pathname :type "pdf") fdf-pathname))) - (handler-case - (progn - (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname))) - (run-tool "pdftk" (list (unix-namestring pdf-pathname) - "fill_form" (unix-namestring fdf-pathname) - "output" (namestring output-pathname) - "flatten")) - (delete-file fdf-pathname) - (format t "; generated ~A~%" output-pathname)) - (error (e) - (warn "While filling form ~A with ~A:~%~A" pdf-pathname fdf-pathname e))))) +(defun fill-form (fdf-pathname pdf-pathname output-pathname) + (handler-case + (progn + (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname))) + (run-tool "pdftk" (list (unix-namestring pdf-pathname) + "fill_form" (unix-namestring fdf-pathname) + "output" (namestring output-pathname) + "flatten")) + (delete-file fdf-pathname) + (format t "; generated ~A~%" output-pathname)) + (error (e) + (warn "While filling form ~A with ~A:~%~A" pdf-pathname fdf-pathname e))))

-(defun fill-forms (directory pdf-pathname) +(defun fill-forms (directory template-pathname) (dolist (fdf-pathname (remove "fdf" (directory directory) :test (complement #'string-equal) :key #'pathname-type)) - (fill-form fdf-pathname pdf-pathname))) + (destructuring-bind (id &optional (country "en")) (split "-" (pathname-name fdf-pathname)) + (let ((language-specific-template-pathname (merge-pathnames (make-pathname :name (format nil "~A-~A" (pathname-name template-pathname) country)) + template-pathname)) + (output-pathname (merge-pathnames (make-pathname :name id :type "pdf") fdf-pathname))) + (fill-form fdf-pathname (if (probe-file language-specific-template-pathname) + language-specific-template-pathname + template-pathname) + output-pathname)))))

(defun cert-daemon () (ensure-directories-exist *cert-mail-directory*)

Modified: branches/xml-class-rework/projects/bos/m2/m2.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-03-12 11:36:07 UTC (rev 1917) +++ branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-03-12 11:37:36 UTC (rev 1918) @@ -230,7 +230,9 @@ (< (contract-price contract) *mail-amount*))

(defmethod contract-fdf-pathname ((contract contract)) - (merge-pathnames (make-pathname :name (format nil "~D" (store-object-id contract)) + (merge-pathnames (make-pathname :name (format nil "~D-~(~A~)" + (store-object-id contract) + (or (sponsor-country (contract-sponsor contract)) "en")) :type "fdf") (if (contract-download-only-p contract) *cert-download-directory* *cert-mail-directory*)))