[bknr-cvs] r1918 - branches/xml-class-rework/projects/bos/m2

[bknr at bknr.net]

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*)))