[bknr-cvs] hans changed trunk/

[BKNR Commits]

Revision: 3554
Author: hans
URL: http://bknr.net/trac/changeset/3554

Never block in contract-issue-cert.  In the frontend, the user will always
spend enough time on the following pages so that the certificate will be
generated.  In order to support the CMS workflow, the /certificate handler
now waits until the certificates have been generated before serving the PDF.

U   trunk/bknr/datastore/src/data/object.lisp
U   trunk/projects/bos/m2/m2.lisp
U   trunk/projects/bos/m2/packages.lisp
U   trunk/projects/bos/web/contract-handlers.lisp
U   trunk/projects/bos/web/kml-handlers.lisp
U   trunk/projects/bos/web/webserver.lisp

Modified: trunk/bknr/datastore/src/data/object.lisp
===================================================================
--- trunk/bknr/datastore/src/data/object.lisp	2008-07-22 11:48:19 UTC (rev 3553)
+++ trunk/bknr/datastore/src/data/object.lisp	2008-07-22 12:02:48 UTC (rev 3554)
@@ -41,7 +41,7 @@
   (let ((instance-count (length (class-instances class))))
     (when (plusp instance-count)
       (unless *suppress-schema-warnings*
-	(warn "updating ~A instances of ~A for class changes" instance-count class))
+	(format *trace-output* "~&; updating ~A instances of ~A for class changes~%" instance-count class))
       (mapc #'reinitialize-instance (class-instances class)))))
 
 (defmethod instance :after ((class persistent-class) &rest args)

Modified: trunk/projects/bos/m2/m2.lisp
===================================================================
--- trunk/projects/bos/m2/m2.lisp	2008-07-22 11:48:19 UTC (rev 3553)
+++ trunk/projects/bos/m2/m2.lisp	2008-07-22 12:02:48 UTC (rev 3554)
@@ -342,15 +342,6 @@
     (delete-file (contract-pdf-pathname contract))
     (delete-file (contract-pdf-pathname contract :print t))))
 
-(defun wait-for-certificates (contract)
-  "Wait until the PDF generating process has generated the certificates"
-  (dotimes (i 10)
-    (when (contract-certificates-generated-p contract)
-      (return))
-    (sleep 1))
-  (unless (contract-certificates-generated-p contract)
-    (error "Cannot generate certificate")))
-
 (defmethod contract-issue-cert ((contract contract) name &key address language)
   (when (contract-cert-issued contract)
     (warn "re-issuing cert for ~A" contract))
@@ -358,7 +349,6 @@
   (make-certificate contract name :address address :language language)
   (unless (contract-download-only-p contract)
     (make-certificate contract name :address address :language language :print t))
-  (wait-for-certificates contract)
   (change-slot-values contract 'cert-issued t))
 
 (defmethod contract-image-tiles ((contract contract))

Modified: trunk/projects/bos/m2/packages.lisp
===================================================================
--- trunk/projects/bos/m2/packages.lisp	2008-07-22 11:48:19 UTC (rev 3553)
+++ trunk/projects/bos/m2/packages.lisp	2008-07-22 12:02:48 UTC (rev 3554)
@@ -161,6 +161,7 @@
 	   #:contract-set-download-only-p
 	   #:contract-price
 	   #:contract-issue-cert
+           #:contract-certificates-generated-p
 	   #:contract-worldpay-trans-id
 	   #:contract-pdf-pathname
 	   #:contract-pdf-url

Modified: trunk/projects/bos/web/contract-handlers.lisp
===================================================================
--- trunk/projects/bos/web/contract-handlers.lisp	2008-07-22 11:48:19 UTC (rev 3553)
+++ trunk/projects/bos/web/contract-handlers.lisp	2008-07-22 12:02:48 UTC (rev 3554)
@@ -32,4 +32,5 @@
 	  (:td (:princ-safe (contract-color contract))))
      #+(or)
      (:tr (:td "cert issued?")
-	  (:td (:princ-safe (if (contract-cert-issued contract) "yes" "no")))))))
\ No newline at end of file
+	  (:td (:princ-safe (if (contract-cert-issued contract) "yes" "no")))))))
+

Modified: trunk/projects/bos/web/kml-handlers.lisp
===================================================================
--- trunk/projects/bos/web/kml-handlers.lisp	2008-07-22 11:48:19 UTC (rev 3553)
+++ trunk/projects/bos/web/kml-handlers.lisp	2008-07-22 12:02:48 UTC (rev 3554)
@@ -138,7 +138,7 @@
     (hunchentoot:handle-if-modified-since timestamp)  
     (setf (hunchentoot:header-out :last-modified)
           (hunchentoot:rfc-1123-date timestamp))
-    (with-xml-response (:content-type #+nil "text/xml" "application/vnd.google-earth.kml+xml; charset=utf-8"
+    (with-xml-response (:content-type "application/vnd.google-earth.kml+xml; charset=utf-8"
                                       :root-element "kml")      
       (with-query-params ((lang "en"))
         (with-element "Document"

Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp	2008-07-22 11:48:19 UTC (rev 3553)
+++ trunk/projects/bos/web/webserver.lisp	2008-07-22 12:02:48 UTC (rev 3554)
@@ -122,7 +122,17 @@
 (defmethod handle-object ((handler certificate-handler) contract)
   (unless contract
     (setf contract (find-if #'contract-pdf-pathname (sponsor-contracts (bknr.web:bknr-session-user)))))
-  (redirect (format nil "/certificates/~D.pdf" (store-object-id contract))))
+  (if (contract-certificates-generated-p contract)
+      (redirect (format nil "/certificates/~D.pdf" (store-object-id contract)))
+      (with-http-response (:content-type "text/html; charset=UTF-8")
+        (with-http-body ()
+          (html
+           (:html
+            (:head
+             (:title "Waiting for certificate generation...")
+             ((:meta :http-equiv "Refresh" :content (format nil "3; ~A" (hunchentoot:script-name*)))))
+            (:body
+             "Please wait, certificate is being generated")))))))
 
 (defclass statistics-handler (editor-only-handler prefix-handler)
   ())