Loading source/patches.lisp +44 −2 Original line number Diff line number Diff line Loading @@ -31,6 +31,48 @@ (export 'wmd) (defun publish-shared (&key path object-type object host (server *wserver*) (key (make-keyword-sensitive (format nil "~a_~a" host path)))) "Void. Used to publish a site which is to have a shared toplevel instance tree, and no URI rewriting (i.e. no \"/sessions/XXX/\" at the beginning of the path). So, this site will appear to be a normal non-dynamic site even though the pages are being generated dynamically. :&key ((path nil) \"String. The URI path to be published.\" (object-type nil) \"Symbol. The type of the toplevel object to be instantiated.\" (host nil) \"hostname for the URI to be published.\" (server *wserver*) \"Allegroserve server object. If you have additional servers other than the default <tt>*wserver*</tt> (e.g. an SSL server) you may want to call this function for each server.\") :example <pre> (publish-shared :path \"/\" :object-type 'site:assembly :host (list \"www.genworks.com\" \"ww2.genworks.com\" \"mccarthy.genworks.com\")) </pre>" (let ((object (or object (make-object (if (stringp object-type) (read-safe-string object-type) object-type) :instance-id key :plain-url? t :host host)))) (setf (gethash key *instance-hash-table*) (list object)) (publish :path path :server server :host host :content-type "text/html" :function #'(lambda(req ent) (let ((*req* req) (*ent* ent) (object (first (gethash key *instance-hash-table*)))) (with-http-response (req ent :response *response-found*) (setf (reply-header-slot-value req :location) (format nil "~a" (the-object object url))) (setf (reply-header-slot-value req :cache-control) "no-cache") (setf (reply-header-slot-value req :pragma) "no-cache") (with-http-body (req ent)) )))))) (defun crawl (&key part url-path ;; to give explicit url instead of part type. Loading Loading @@ -105,7 +147,7 @@ the files are written into \"/tmp/sites/\". (let* ((components (let ((components (remove "" (glisp:split-regexp "/" uri-path) :test #'string-equal))) (if (find "sessions" components :test #'string-equal) (rest (rest components)) components))) (directory (butlast components))) (destructuring-bind (name type) (glisp:split-regexp "\\." (lastcar components)) (destructuring-bind (name &optional type) (glisp:split-regexp "\\." (lastcar components)) (make-pathname :directory (append (pathname-directory output-root) directory) :name name :type type))))) (let ((lhtml (relativize-lhtml lhtml uri-path output-path host port visited-urls))) Loading Loading @@ -133,7 +175,7 @@ the files are written into \"/tmp/sites/\". (components (if (find "sessions" components :test #'string-equal) (rest (rest components)) components))) (and (null uri-host) (null uri-scheme) (null uri-port) (destructuring-bind (name type) (glisp:split-regexp "\\." (lastcar components)) (destructuring-bind (name &optional type) (glisp:split-regexp "\\." (lastcar components)) (declare (ignore name)) (member type '("htm" "html") :test #'string-equal))))) Loading Loading
source/patches.lisp +44 −2 Original line number Diff line number Diff line Loading @@ -31,6 +31,48 @@ (export 'wmd) (defun publish-shared (&key path object-type object host (server *wserver*) (key (make-keyword-sensitive (format nil "~a_~a" host path)))) "Void. Used to publish a site which is to have a shared toplevel instance tree, and no URI rewriting (i.e. no \"/sessions/XXX/\" at the beginning of the path). So, this site will appear to be a normal non-dynamic site even though the pages are being generated dynamically. :&key ((path nil) \"String. The URI path to be published.\" (object-type nil) \"Symbol. The type of the toplevel object to be instantiated.\" (host nil) \"hostname for the URI to be published.\" (server *wserver*) \"Allegroserve server object. If you have additional servers other than the default <tt>*wserver*</tt> (e.g. an SSL server) you may want to call this function for each server.\") :example <pre> (publish-shared :path \"/\" :object-type 'site:assembly :host (list \"www.genworks.com\" \"ww2.genworks.com\" \"mccarthy.genworks.com\")) </pre>" (let ((object (or object (make-object (if (stringp object-type) (read-safe-string object-type) object-type) :instance-id key :plain-url? t :host host)))) (setf (gethash key *instance-hash-table*) (list object)) (publish :path path :server server :host host :content-type "text/html" :function #'(lambda(req ent) (let ((*req* req) (*ent* ent) (object (first (gethash key *instance-hash-table*)))) (with-http-response (req ent :response *response-found*) (setf (reply-header-slot-value req :location) (format nil "~a" (the-object object url))) (setf (reply-header-slot-value req :cache-control) "no-cache") (setf (reply-header-slot-value req :pragma) "no-cache") (with-http-body (req ent)) )))))) (defun crawl (&key part url-path ;; to give explicit url instead of part type. Loading Loading @@ -105,7 +147,7 @@ the files are written into \"/tmp/sites/\". (let* ((components (let ((components (remove "" (glisp:split-regexp "/" uri-path) :test #'string-equal))) (if (find "sessions" components :test #'string-equal) (rest (rest components)) components))) (directory (butlast components))) (destructuring-bind (name type) (glisp:split-regexp "\\." (lastcar components)) (destructuring-bind (name &optional type) (glisp:split-regexp "\\." (lastcar components)) (make-pathname :directory (append (pathname-directory output-root) directory) :name name :type type))))) (let ((lhtml (relativize-lhtml lhtml uri-path output-path host port visited-urls))) Loading Loading @@ -133,7 +175,7 @@ the files are written into \"/tmp/sites/\". (components (if (find "sessions" components :test #'string-equal) (rest (rest components)) components))) (and (null uri-host) (null uri-scheme) (null uri-port) (destructuring-bind (name type) (glisp:split-regexp "\\." (lastcar components)) (destructuring-bind (name &optional type) (glisp:split-regexp "\\." (lastcar components)) (declare (ignore name)) (member type '("htm" "html") :test #'string-equal))))) Loading