Commit 2b90ff88 authored by Dave Cooper's avatar Dave Cooper
Browse files

default publish-shared to share instance over multiple servers.

parent 8142ddb9
Loading
Loading
Loading
Loading
Loading
+5 −3
Original line number Diff line number Diff line
@@ -948,8 +948,7 @@ by the update."
    (&key (replace-bashed-values? t) immune-message-keys)
    (let ((all-messages (the (:message-list)))
          (methods (the (:message-list :category :functions)))
          (immune-messages (append (list :$$ta2 :$$ta2-object 
                                         :$$tatu :$$tatu-object)
          (immune-messages (append (list :object-unique-id)
                                   (ensure-list immune-message-keys)))
          (true-root (if (and (the root parent) (the root parent root?)
                              (defaulting (the root parent root-object-object))
@@ -1256,7 +1255,10 @@ object as a toplevel input at the time of object instantiation.</li></ol>"

(defmethod print-object ((object vanilla-mixin) stream)
  (print-unreadable-object (object stream :type t)
    (format stream "~a" (theo object object-unique-id))))
    (format stream "~a (~a)"
	    (theo object object-unique-id)
	    (with-output-to-string(ss)(call-next-method object ss)))))
	    
  

(define-object vanilla-mixin (vanilla-mixin* gdl-basis)
+40 −17
Original line number Diff line number Diff line
@@ -398,6 +398,7 @@ package-qualified object name\")
			  (server *http-server*)
			  host	 ;; by default this comes from object.
			  hosts
			  overwrite?
			  (key (make-keyword-sensitive
				(format nil "~a~a" (if host (format nil "~a/" host) "") (first paths))))
			  object ;; if you want to provide an already-instantiated one. Will override object-type. 
@@ -431,27 +432,46 @@ being generated dynamically.
  </pre>"

  (assert (consp paths))
  (assert (every  #'(lambda(path) (and (stringp path) (plusp (length path)) (eql (aref path 0) #\/))) paths))
  (assert (every  #'(lambda(path) (and (stringp path)
				       (plusp (length path))
				       (eql (aref path 0) #\/))) paths))
  
  (let ((self (or object (apply #'make-object (if (stringp object-type)
  (let* ((requested-type (if (stringp object-type)
			     (read-safe-string object-type)
						  object-type)
			     object-type))
	 (existing nil)
	 (self (or object
		   (unless overwrite?
		     (setq existing (first (gethash key *instance-hash-table*)))
		     (when (and existing (typep existing requested-type)) existing))
		  (apply #'make-object requested-type
			 :compute-urls paths
			 :instance-id key
			 :plain-url? t
			 :pre-published? t
			 :host host object-args))))
    (if existing
	(format t "Found existing ~s, and :overwrite was not specified to publish-shared.
Not replacing existing instance in `gwl:*instance-hash-table*`~%"
		requested-type)
	(progn
	  (setf (gethash key *instance-hash-table*) (list self))
	  (format t "Just set ~s into the instance hash table." self)))
    
    (let ((hosts (or (ensure-list (or hosts host (the host))) (list nil)))
	  (function
	    #'(lambda(req ent)
	    (the (before-response!))
  	    (the (present-part req ent)))))
  	    (the (present-part req ent))
	    )))
      
      (dolist (path paths)
	(pushnew path (gethash (make-keyword (the instance-id)) *url-hash-table*) :test #'string-equal)
	(pushnew path (gethash (make-keyword (the instance-id)) *url-hash-table*)
		 :test #'string-equal)

	(when *debug?* (print-variables path server host (or content-type (the content-type)) function aserve-args))
	(when *debug?* (print-variables path server host
					(or content-type (the content-type))
					function aserve-args))
	
	(dolist (host hosts)
	  (apply #'publish :path path
@@ -483,7 +503,8 @@ being generated dynamically.
                           (string-equal (second (getf (the query-plist) key)) "true"))
                  (list (make-keyword-sensitive (glisp:replace-regexp
						 (glisp:replace-regexp 
						  (glisp:replace-regexp  (format nil "~a" key) "^RADIO-" "")
						  (glisp:replace-regexp
						   (format nil "~a" key) "^RADIO-" "")
						  "^radio-" "")
						 "-.*" ""))
                        (first (getf (the query-plist) key)))))
@@ -492,8 +513,10 @@ being generated dynamically.
   (query-plist-all 
    (append (the radios) 
	    (mapcan #'(lambda(key val)
			(unless (or (glisp:match-regexp "^radio-" (string-downcase (format nil "~a" key)))
				    (glisp:match-regexp "-checkedp$" (string-downcase (format nil "~a" key))))
			(unless (or (glisp:match-regexp "^radio-"
							(string-downcase (format nil "~a" key)))
				    (glisp:match-regexp "-checkedp$"
							(string-downcase (format nil "~a" key))))
			  (list key val)))
		    (plist-keys (the query-plist))
		    (plist-values (the query-plist)))))
+4 −2
Original line number Diff line number Diff line
@@ -329,13 +329,15 @@ values are set into the specified bashee."
       (let* ((skin (third (gethash (the instance-id) *instance-hash-table*)))
	      (respondent self))

	 (when *debug?* (print-variables (the instance-id) (the root) (the root-path) respondent))

	 (when *debug?* (print-variables (the instance-id) (the root)
					 (the root-path) respondent))
	 ;;
	 ;; FLAG -- use actual application-root rather than global root here
	 ;;
	 (when (and respondent (the-object respondent root) 
                    (typep (the-object respondent root) 'session-control-mixin))
                    (typep (the-object respondent root)
			   'session-control-mixin))
           (the-object respondent root (set-expires-at)))
	 (when (and respondent (the-object respondent root) 
                    (the-object respondent root (set-time-last-touched!))))