Permalink
Browse files

Added tests for versioning, gzipping, bundling

  • Loading branch information...
1 parent c615f04 commit d07627681368cd32689151f26b8cd537316c163a JT committed May 4, 2009
View
2 examples/weblocks-demo/data/snapshot.xml
@@ -1 +1 @@
-<HASH-TABLE ID="1" TEST="CL:EQ" SIZE="16"><ENTRY><KEY><SYMBOL>WEBLOCKS-DEMO::COMPANY</SYMBOL></KEY><VALUE><OBJECT ID="2" CLASS="WEBLOCKS-PREVALENCE::PERSISTENT-OBJECTS-OF-CLASS"><SLOT NAME="WEBLOCKS-PREVALENCE::OBJECTS-BY-ID"><HASH-TABLE ID="3" TEST="CL:EQL" SIZE="16"><ENTRY><KEY><INT>0</INT></KEY><VALUE><OBJECT ID="4" CLASS="WEBLOCKS-DEMO::COMPANY"><SLOT NAME="WEBLOCKS::ID"><INT>0</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::NAME"><STRING>Bar</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::INDUSTRY"><STRING>Entertainment</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::NON-PROFIT"><NULL/></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><INT>1</INT></KEY><VALUE><OBJECT ID="5" CLASS="WEBLOCKS-DEMO::COMPANY"><SLOT NAME="WEBLOCKS::ID"><INT>1</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::NAME"><STRING>Church</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::INDUSTRY"><STRING>Spiritual</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::NON-PROFIT"><TRUE/></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><INT>2</INT></KEY><VALUE><OBJECT ID="6" CLASS="WEBLOCKS-DEMO::COMPANY"><SLOT NAME="WEBLOCKS::ID"><INT>2</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::NAME"><STRING>Nuclear Plant</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::INDUSTRY"><STRING>Energy</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::NON-PROFIT"><NULL/></SLOT></OBJECT></VALUE></ENTRY></HASH-TABLE></SLOT><SLOT NAME="WEBLOCKS-PREVALENCE::NEXT-ID"><INT>2</INT></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><SYMBOL>WEBLOCKS-DEMO::EMPLOYEE</SYMBOL></KEY><VALUE><OBJECT ID="7" CLASS="WEBLOCKS-PREVALENCE::PERSISTENT-OBJECTS-OF-CLASS"><SLOT NAME="WEBLOCKS-PREVALENCE::OBJECTS-BY-ID"><HASH-TABLE ID="8" TEST="CL:EQL" SIZE="16"><ENTRY><KEY><INT>0</INT></KEY><VALUE><OBJECT ID="9" CLASS="WEBLOCKS-DEMO::EMPLOYEE"><SLOT NAME="WEBLOCKS::ID"><INT>0</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::FIRST-NAME"><STRING>Homer</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::LAST-NAME"><STRING>Simpson</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::AGE"><INT>50</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::ADDRESS"><OBJECT ID="10" CLASS="WEBLOCKS-DEMO::ADDRESS"><SLOT NAME="WEBLOCKS-DEMO::STREET"><STRING>12 Rose Ln.</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::CITY"><STRING>Springfield</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::STATE"><STRING>NJ</STRING></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::COMPANY"><REF ID="6"/></SLOT><SLOT NAME="WEBLOCKS-DEMO::CONTRACT"><SYMBOL>:FULL-TIME</SYMBOL></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><INT>1</INT></KEY><VALUE><OBJECT ID="11" CLASS="WEBLOCKS-DEMO::EMPLOYEE"><SLOT NAME="WEBLOCKS::ID"><INT>1</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::FIRST-NAME"><STRING>Moe</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::LAST-NAME"><STRING>Szyslak</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::AGE"><INT>55</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::ADDRESS"><OBJECT ID="12" CLASS="WEBLOCKS-DEMO::ADDRESS"><SLOT NAME="WEBLOCKS-DEMO::STREET"><STRING>14 Iris Ave.</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::CITY"><STRING>Springfield</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::STATE"><STRING>NJ</STRING></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::COMPANY"><REF ID="4"/></SLOT><SLOT NAME="WEBLOCKS-DEMO::CONTRACT"><SYMBOL>:FULL-TIME</SYMBOL></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><INT>2</INT></KEY><VALUE><OBJECT ID="13" CLASS="WEBLOCKS-DEMO::EMPLOYEE"><SLOT NAME="WEBLOCKS::ID"><INT>2</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::FIRST-NAME"><STRING>Ned</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::LAST-NAME"><STRING>Flanders</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::AGE"><INT>45</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::ADDRESS"><OBJECT ID="14" CLASS="WEBLOCKS-DEMO::ADDRESS"><SLOT NAME="WEBLOCKS-DEMO::STREET"><STRING>13 Violet St.</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::CITY"><STRING>Springfield</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::STATE"><STRING>NJ</STRING></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::COMPANY"><REF ID="5"/></SLOT><SLOT NAME="WEBLOCKS-DEMO::CONTRACT"><SYMBOL>:PART-TIME</SYMBOL></SLOT></OBJECT></VALUE></ENTRY></HASH-TABLE></SLOT><SLOT NAME="WEBLOCKS-PREVALENCE::NEXT-ID"><INT>2</INT></SLOT></OBJECT></VALUE></ENTRY></HASH-TABLE>
+<HASH-TABLE ID="1" TEST="CL:EQ" SIZE="16"><ENTRY><KEY><SYMBOL>WEBLOCKS-DEMO::EMPLOYEE</SYMBOL></KEY><VALUE><OBJECT ID="2" CLASS="WEBLOCKS-PREVALENCE::PERSISTENT-OBJECTS-OF-CLASS"><SLOT NAME="WEBLOCKS-PREVALENCE::OBJECTS-BY-ID"><HASH-TABLE ID="3" TEST="CL:EQL" SIZE="16"><ENTRY><KEY><INT>2</INT></KEY><VALUE><OBJECT ID="4" CLASS="WEBLOCKS-DEMO::EMPLOYEE"><SLOT NAME="WEBLOCKS::ID"><INT>2</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::FIRST-NAME"><STRING>Ned</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::LAST-NAME"><STRING>Flanders</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::AGE"><INT>45</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::ADDRESS"><OBJECT ID="5" CLASS="WEBLOCKS-DEMO::ADDRESS"><SLOT NAME="WEBLOCKS-DEMO::STREET"><STRING>13 Violet St.</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::CITY"><STRING>Springfield</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::STATE"><STRING>NJ</STRING></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::COMPANY"><OBJECT ID="6" CLASS="WEBLOCKS-DEMO::COMPANY"><SLOT NAME="WEBLOCKS::ID"><INT>1</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::NAME"><STRING>Church</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::INDUSTRY"><STRING>Spiritual</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::NON-PROFIT"><TRUE/></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::CONTRACT"><SYMBOL>:PART-TIME</SYMBOL></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><INT>1</INT></KEY><VALUE><OBJECT ID="7" CLASS="WEBLOCKS-DEMO::EMPLOYEE"><SLOT NAME="WEBLOCKS::ID"><INT>1</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::FIRST-NAME"><STRING>Moe</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::LAST-NAME"><STRING>Szyslak</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::AGE"><INT>55</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::ADDRESS"><OBJECT ID="8" CLASS="WEBLOCKS-DEMO::ADDRESS"><SLOT NAME="WEBLOCKS-DEMO::STREET"><STRING>14 Iris Ave.</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::CITY"><STRING>Springfield</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::STATE"><STRING>NJ</STRING></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::COMPANY"><OBJECT ID="9" CLASS="WEBLOCKS-DEMO::COMPANY"><SLOT NAME="WEBLOCKS::ID"><INT>0</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::NAME"><STRING>Bar</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::INDUSTRY"><STRING>Entertainment</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::NON-PROFIT"><NULL/></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::CONTRACT"><SYMBOL>:FULL-TIME</SYMBOL></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><INT>0</INT></KEY><VALUE><OBJECT ID="10" CLASS="WEBLOCKS-DEMO::EMPLOYEE"><SLOT NAME="WEBLOCKS::ID"><INT>0</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::FIRST-NAME"><STRING>Homer</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::LAST-NAME"><STRING>Simpson</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::AGE"><INT>50</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::ADDRESS"><OBJECT ID="11" CLASS="WEBLOCKS-DEMO::ADDRESS"><SLOT NAME="WEBLOCKS-DEMO::STREET"><STRING>12 Rose Ln.</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::CITY"><STRING>Springfield</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::STATE"><STRING>NJ</STRING></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::COMPANY"><OBJECT ID="12" CLASS="WEBLOCKS-DEMO::COMPANY"><SLOT NAME="WEBLOCKS::ID"><INT>2</INT></SLOT><SLOT NAME="WEBLOCKS-DEMO::NAME"><STRING>Nuclear Plant</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::INDUSTRY"><STRING>Energy</STRING></SLOT><SLOT NAME="WEBLOCKS-DEMO::NON-PROFIT"><NULL/></SLOT></OBJECT></SLOT><SLOT NAME="WEBLOCKS-DEMO::CONTRACT"><SYMBOL>:FULL-TIME</SYMBOL></SLOT></OBJECT></VALUE></ENTRY></HASH-TABLE></SLOT><SLOT NAME="WEBLOCKS-PREVALENCE::NEXT-ID"><INT>2</INT></SLOT></OBJECT></VALUE></ENTRY><ENTRY><KEY><SYMBOL>WEBLOCKS-DEMO::COMPANY</SYMBOL></KEY><VALUE><OBJECT ID="13" CLASS="WEBLOCKS-PREVALENCE::PERSISTENT-OBJECTS-OF-CLASS"><SLOT NAME="WEBLOCKS-PREVALENCE::OBJECTS-BY-ID"><HASH-TABLE ID="14" TEST="CL:EQL" SIZE="16"><ENTRY><KEY><INT>2</INT></KEY><VALUE><REF ID="12"/></VALUE></ENTRY><ENTRY><KEY><INT>1</INT></KEY><VALUE><REF ID="6"/></VALUE></ENTRY><ENTRY><KEY><INT>0</INT></KEY><VALUE><REF ID="9"/></VALUE></ENTRY></HASH-TABLE></SLOT><SLOT NAME="WEBLOCKS-PREVALENCE::NEXT-ID"><INT>2</INT></SLOT></OBJECT></VALUE></ENTRY></HASH-TABLE>
View
36 src/bundling.lisp
@@ -27,10 +27,11 @@
(defvar *initial-bundle-id* 1)
-(defun get-bundle-tally ()
+(defun get-bundle-tally (&key bundle-folder)
"Copy the tally file into a bundle-tally object"
- (let* ((bundle-folder (merge-pathnames "bundles/" (compute-webapp-public-files-path (current-webapp))))
- (tally-path (merge-pathnames "tally" bundle-folder))
+ (when (null bundle-folder)
+ (setf bundle-folder (merge-pathnames "bundles/" (compute-webapp-public-files-path (current-webapp)))))
+ (let* ((tally-path (merge-pathnames "tally" bundle-folder))
(file-data (when (cl-fad:file-exists-p tally-path)
(read-from-file tally-path)))
(last-bundle-id (if file-data (car file-data) (1- *initial-bundle-id*)))
@@ -50,38 +51,39 @@
(push (cons bundle-name file-list) composition-list)
(setf modified-p t)))
-
+#|
(defun remove-from-tally (bundle-name tally)
(with-slots (composition-list modified-p) tally
- (setf composition-list (remove-if #'(lambda (x) (string-equal (car x) bundle-name)) composition-list))
+ (setf composition-list (remove-if #'(lambda (x) (string-equal (car x) bundle-name))
+ composition-list))
(setf modified-p t)))
+(defun delete-bundle-file (bundle-name tally)
+ (remove-from-tally bundle-name tally)
+ (delete-file (merge-pathnames bundle-name (bundle-folder tally))))
+|#
+
(defun create-bundle-file (file-list type tally)
(let ((bundle-name (format nil "~A.~A"
(incf (last-bundle-id tally))
(ecase type
(stylesheet-dependency "css")
(script-dependency "js")))))
(add-to-tally bundle-name file-list tally)
- (merge-files file-list (merge-pathnames bundle-name (bundle-folder tally)))
+ (merge-files-with-newline file-list (merge-pathnames bundle-name (bundle-folder tally)))
bundle-name))
-(defun delete-bundle-file (bundle-name tally)
- (remove-from-tally bundle-name tally)
- (delete-file (merge-pathnames bundle-name (bundle-folder tally))))
-
-
(defun find-bundle (file-list tally)
"If the same files have already been bundled, return the bundle-name"
(car (find-if #'(lambda (x) (equalp (cdr x) file-list))
(composition-list tally))))
(defvar *bundle-dependencies-lock* (bordeaux-threads:make-lock))
-(defun build-bundle (file-list type &key media)
+(defun build-bundle (file-list type &key media bundle-folder)
(bordeaux-threads:with-lock-held (*bundle-dependencies-lock*)
(let* ((app (current-webapp))
- (tally (get-bundle-tally))
+ (tally (get-bundle-tally :bundle-folder bundle-folder))
(bundle-name (find-bundle file-list tally)))
(when (null bundle-name)
(setf bundle-name (create-bundle-file file-list type tally)))
@@ -106,7 +108,7 @@
:local-path physical-path)))))))
-(defun bundle-some-dependencies (dependency-list dependency-type)
+(defun bundle-some-dependencies (dependency-list dependency-type &key bundle-folder)
(let (exceptions)
(when (listp dependency-type)
(setf exceptions (cdr dependency-type))
@@ -127,9 +129,7 @@
finally
(return (progn
(when imports
- (setf main
- (append imports main)))
+ (setf main (append imports main)))
(when main
- (push (build-bundle main dependency-type)
- others))
+ (push (build-bundle main dependency-type :bundle-folder bundle-folder) others))
others)))))
View
4 src/debug-mode.lisp
@@ -5,8 +5,11 @@
(declaim (special *maintain-last-session*))
+(defvar *weblocks-global-debug* nil)
+
(defun enable-global-debugging ()
"Setup hooks for session maintenance and showing backtraces"
+ (setf *weblocks-global-debug* t)
;; Set hunchentoot defaults (for everyone)
(setf *show-lisp-errors-p* t)
;(setf *show-lisp-backtraces-p* t)
@@ -17,6 +20,7 @@
(defun disable-global-debugging ()
"A manual method for resetting global debugging state"
+ (setf *weblocks-global-debug* nil)
(setf *show-lisp-errors-p* nil)
;(setf *show-lisp-backtraces-p* nil)
(setf *maintain-last-session* nil))
View
60 src/dependencies.lisp
@@ -104,13 +104,15 @@ when new dependencies appeared in AJAX page updates.")
(defun sort-dependencies-by-type (dependency-list)
(sort dependency-list #'dependencies-lessp))
-(defun bundle-dependencies (dependency-list)
- (let ((types (bundle-dependency-types* (current-webapp))))
- (when (find :stylesheet types)
- (setf dependency-list (bundle-some-dependencies dependency-list 'stylesheet-dependency)))
- (when (find :script types)
- (setf dependency-list (bundle-some-dependencies dependency-list 'script-dependency)))
- dependency-list))
+(defun bundle-dependencies (dependency-list &key bundle-folder
+ (bundle-types (bundle-dependency-types* (current-webapp))))
+ (when (find :stylesheet bundle-types)
+ (setf dependency-list (bundle-some-dependencies dependency-list 'stylesheet-dependency
+ :bundle-folder bundle-folder)))
+ (when (find :script bundle-types)
+ (setf dependency-list (bundle-some-dependencies dependency-list 'script-dependency
+ :bundle-folder bundle-folder)))
+ dependency-list)
(defgeneric compact-dependencies (dependency-list)
@@ -189,50 +191,6 @@ when new dependencies appeared in AJAX page updates.")
(let ((new-path (format nil "~A.gz" original-path)))
(gzip-file original-path new-path))))
-;;; Dealing with CSS import rules
-
-(defun write-import-css (url stream)
- (write-char #\Newline stream)
- (write-string "@import url(" stream)
- (princ url stream)
- (write-string ");" stream))
-
-(defun extract-import-urls (string)
- (let (urls (start 0))
- (loop
- (multiple-value-bind (head tail) (cl-ppcre:scan "(?i)import url\(.*?\);" string :start start)
- (if head
- (progn
- (push (subseq string (+ head 11) (- tail 2)) urls)
- (setf start tail))
- (return-from extract-import-urls urls))))))
-
-(defun local-path-from-url (url &key (type :stylesheet))
- (let* ((name (pathname-name url))
- (relative (public-file-relative-path type name))
- (webapp (current-webapp))
- (local (princ-to-string (merge-pathnames relative
- (compute-webapp-public-files-path webapp)))))
- (when (cl-fad:file-exists-p local)
- (values local
- (princ-to-string (merge-pathnames relative
- (maybe-add-trailing-slash (compute-webapp-public-files-uri-prefix webapp))))))))
-
-(defun update-import-css-content (import-path)
- (let ((urls (extract-import-urls (slurp-file import-path)))
- (webapp (current-webapp)))
- (with-file-write (stream import-path)
- (dolist (url urls)
- (multiple-value-bind (physical-path virtual-path) (local-path-from-url url)
- (if physical-path
- (progn
- (when (find :stylesheet (version-dependency-types* webapp))
- (multiple-value-setq (physical-path virtual-path)
- (update-versioned-dependency-path physical-path virtual-path)))
- (when (find :stylesheet (gzip-dependency-types* webapp))
- (create-gziped-dependency-file physical-path))
- (write-import-css virtual-path stream))
- (write-import-css url stream)))))))
;; Dependency gathering
View
19 src/utils/misc.lisp
@@ -542,11 +542,20 @@ answering its result."
(read-sequence seq stream)
seq))
-(defun merge-files (file-list saved-path)
- (with-file-write (stream saved-path :element-type '(unsigned-byte 8))
- (dolist (file file-list)
- (write-sequence (slurp-file file :element-type '(unsigned-byte 8)) stream)
- (write-byte 10 stream))))
+(defun merge-files (file-list saved-path
+ &key (element-type '(unsigned-byte 8)) linkage-element-fn)
+ (with-file-write (stream saved-path :element-type element-type)
+ (write-sequence (slurp-file (car file-list) :element-type element-type)
+ stream)
+ (dolist (file (cdr file-list))
+ (when linkage-element-fn
+ (funcall linkage-element-fn stream))
+ (write-sequence (slurp-file file :element-type element-type)
+ stream))))
+
+(defun merge-files-with-newline (file-list saved-path)
+ (merge-files file-list saved-path
+ :linkage-element-fn (lambda (stream) (write-byte 10 stream))))
(defun relative-path (full-path prefix-path)
(princ-to-string
View
48 src/versioning.lisp
@@ -91,4 +91,50 @@
(when (file-modified-p mod-record) (update-mod-record mod-record :versioning-p t))
(with-slots (last-version) mod-record
(values (make-versioned-path original-path last-version)
- (make-versioned-path other-path last-version))))))
+ (make-versioned-path other-path last-version))))))
+
+
+;;; Dealing with CSS import rules
+
+(defun write-import-css (url stream)
+ (write-char #\Newline stream)
+ (write-string "@import url(" stream)
+ (princ url stream)
+ (write-string ");" stream))
+
+(defun extract-import-urls (string)
+ (let (urls (start 0))
+ (loop
+ (multiple-value-bind (head tail) (cl-ppcre:scan "(?i)import url\(.*?\);" string :start start)
+ (if head
+ (progn
+ (push (subseq string (+ head 11) (- tail 2)) urls)
+ (setf start tail))
+ (return-from extract-import-urls urls))))))
+
+(defun local-path-from-url (url &key (type :stylesheet))
+ (let* ((name (pathname-name url))
+ (relative (public-file-relative-path type name))
+ (webapp (current-webapp))
+ (local (princ-to-string (merge-pathnames relative
+ (compute-webapp-public-files-path webapp)))))
+ (when (cl-fad:file-exists-p local)
+ (values local
+ (princ-to-string (merge-pathnames relative
+ (maybe-add-trailing-slash (compute-webapp-public-files-uri-prefix webapp))))))))
+
+(defun update-import-css-content (import-path &key (version-types (version-dependency-types* (current-webapp)))
+ (gzip-types (gzip-dependency-types* (current-webapp))))
+ (let ((urls (extract-import-urls (slurp-file import-path))))
+ (with-file-write (stream import-path)
+ (dolist (url (nreverse urls))
+ (multiple-value-bind (physical-path virtual-path) (local-path-from-url url)
+ (if physical-path
+ (progn
+ (when (find :stylesheet version-types)
+ (multiple-value-setq (physical-path virtual-path)
+ (update-versioned-dependency-path physical-path virtual-path)))
+ (when (find :stylesheet gzip-types)
+ (create-gziped-dependency-file physical-path))
+ (write-import-css virtual-path stream))
+ (write-import-css url stream)))))))
View
141 test/bundling.lisp
@@ -0,0 +1,141 @@
+(in-package :weblocks-test)
+
+(deftestsuite bundling-suite (weblocks-suite print-upcase-suite)
+ ())
+
+(defparameter *temp-bundles-folder* (princ-to-string (compute-public-files-path "weblocks" "test/temp-bundles")))
+
+(addtest merge-files-with-newline
+ (cl-fad:delete-directory-and-files *temp-bundles-folder* :if-does-not-exist :ignore)
+ (let ((path1 (merge-pathnames "test1" *temp-bundles-folder*))
+ (path2 (merge-pathnames "test2" *temp-bundles-folder*))
+ (path3 (merge-pathnames "test3" *temp-bundles-folder*)))
+ (weblocks::write-to-file 'test1 path1)
+ (weblocks::write-to-file 'test2 path2)
+ (weblocks::merge-files-with-newline (list path1 path2) path3)
+ (ensure-same (weblocks::slurp-file path3)
+ "TEST1
+TEST2")))
+
+(defun make-test-dependencies-1 ()
+ (let ((test-deps (mapcar (lambda (x) (apply #'make-local-dependency x))
+ '((:stylesheet "isearch")
+ (:script "weblocks-debug")
+ (:stylesheet "datagrid-import" :import-p t)
+ (:stylesheet "datagrid")
+ (:script "sound")))))
+ (push (make-instance 'stylesheet-dependency :url #P"http://external.css")
+ test-deps)
+ (push (make-instance 'script-dependency :url #P"http://external.js")
+ test-deps)
+ test-deps))
+
+(defun make-test-dependencies-2 ()
+ (mapcar (lambda (x) (apply #'make-local-dependency x))
+ '((:stylesheet "suggest")
+ (:script "dialog")
+ (:stylesheet "isearch")
+ (:script "sound"))))
+
+(defun make-test-dependencies-3 ()
+ (mapcar (lambda (x) (apply #'make-local-dependency x))
+ '((:script "sound")
+ (:script "dialog"))))
+
+(defun make-test-dependencies-4 ()
+ (mapcar (lambda (x) (apply #'make-local-dependency x))
+ '((:stylesheet "isearch")
+ (:stylesheet "suggest"))))
+
+(defun make-temp-bundles (dependencies)
+ (weblocks::bundle-dependencies dependencies
+ :bundle-folder *temp-bundles-folder*
+ :bundle-types '(:stylesheet :script)))
+
+(defun merged-with-newline-equal (part-paths merged-path)
+ (let ((result (weblocks::slurp-file merged-path)))
+ (dolist (path part-paths)
+ (setf result (cl-ppcre:regex-replace (list :sequence (weblocks::slurp-file path))
+ result "")))
+ (and (= (length result)
+ (1- (length part-paths)))
+ (zerop (length (remove #\Newline result))))))
+
+(addtest bundling-test-1
+ (cl-fad:delete-directory-and-files *temp-bundles-folder* :if-does-not-exist :ignore)
+ (let* ((test-deps (make-test-dependencies-1))
+ (temp-bundles (make-temp-bundles test-deps)))
+ ;; uri test
+ (ensure-same (values-list (mapcar (lambda (x) (puri:uri-path (dependency-url x)))
+ temp-bundles))
+ (values "/pub/bundles/2.js" "/pub/bundles/1.css"
+ "/external.js" "/external.css"))
+ ;; local-path test
+ (ensure-same (values-list (mapcar #'weblocks::local-path temp-bundles))
+ (values (concatenate 'string *temp-bundles-folder* "2.js")
+ (concatenate 'string *temp-bundles-folder* "1.css")
+ nil nil))
+ (let ((tally (weblocks::get-bundle-tally :bundle-folder *temp-bundles-folder*)))
+ (destructuring-bind ((js-merged . js-parts) (css-merged . css-parts))
+ (weblocks::composition-list tally)
+ ;; composition-list test
+ (ensure-same js-merged "2.js")
+ (ensure-same css-merged "1.css")
+ (ensure-same (values-list (append js-parts css-parts))
+ (values '("weblocks-debug" "js")
+ '("sound" "js")
+ '("datagrid-import" "css")
+ '("isearch" "css")
+ '("datagrid" "css"))
+ :test (lambda (x y) (cl-ppcre:scan (subseq (apply #'make-versioned-regex y) 1)
+ x)))
+ ;; merged file test
+ (ensure-same (values js-parts css-parts)
+ (values js-merged css-merged)
+ :test (lambda (x y)
+ (merged-with-newline-equal x
+ (merge-pathnames y (weblocks::bundle-folder tally)))))
+ ;; import rule first test
+ (ensure-same (cl-ppcre:scan (list :sequence (weblocks::slurp-file (car css-parts)))
+ (weblocks::slurp-file (merge-pathnames css-merged
+ (weblocks::bundle-folder tally))))
+ 0)))
+
+ ;; bundling different files
+ (setf test-deps (make-test-dependencies-2))
+ (setf temp-bundles (make-temp-bundles test-deps))
+ ;; uri test
+ (ensure-same (values-list (mapcar (lambda (x) (puri:uri-path (dependency-url x)))
+ temp-bundles))
+ (values "/pub/bundles/4.js" "/pub/bundles/3.css"))
+ ;; local-path test
+ (ensure-same (values-list (mapcar #'weblocks::local-path temp-bundles))
+ (values (concatenate 'string *temp-bundles-folder* "4.js")
+ (concatenate 'string *temp-bundles-folder* "3.css")))
+ ;; composition-list test
+ (destructuring-bind (js-parts css-parts)
+ (loop for bundle in (weblocks::composition-list (weblocks::get-bundle-tally :bundle-folder *temp-bundles-folder*))
+ if (or (string= (car bundle) "4.js")
+ (string= (car bundle) "3.css"))
+ collect (cdr bundle))
+ (ensure-same (values-list (append js-parts css-parts))
+ (values '("dialog" "js")
+ '("sound" "js")
+ '("suggest" "css")
+ '("isearch" "css"))
+ :test (lambda (x y) (cl-ppcre:scan (subseq (apply #'make-versioned-regex y) 1)
+ x))))
+
+ ;; no css bundle
+ (setf test-deps (make-test-dependencies-3))
+ (setf temp-bundles (make-temp-bundles test-deps))
+ ;; uri test
+ (ensure-same (puri:uri-path (dependency-url (car temp-bundles)))
+ "/pub/bundles/5.js")
+
+ ;; no js bundle
+ (setf test-deps (make-test-dependencies-4))
+ (setf temp-bundles (make-temp-bundles test-deps))
+ ;; uri test
+ (ensure-same (puri:uri-path (dependency-url (car temp-bundles)))
+ "/pub/bundles/6.css")))
View
7 test/dependencies.lisp
@@ -3,13 +3,6 @@
(deftestsuite dependencies-suite (weblocks-suite)
())
-(defun make-versioned-regex (name type)
- "Used for checking potential local dependency path."
- (let ((dir (cond ((string= type "css") "stylesheets")
- ((string= type "js") "scripts")))
- (pub-dir "pub"))
- (format nil "^/~A/~A/(?:vzn/~A\\.\\d\\d*?|~A)\\.~A$" pub-dir dir name name type)))
-
(addtest dependencies-by-symbol
(ensure-same (remove nil (weblocks::dependencies-by-symbol 'non-existent-widget-name))
nil)
View
52 test/versioning.lisp
@@ -0,0 +1,52 @@
+(in-package :weblocks-test)
+
+(defun remove-import-urls (urls)
+ (loop for url in urls
+ if (not (cl-ppcre:scan "-import\\.(?:\\d\\d*?\\.|)css$" url))
+ collect url))
+
+(defun make-versioned-regex (name type)
+ "Used for checking potential local dependency path."
+ (let ((dir (cond ((string= type "css") "stylesheets")
+ ((string= type "js") "scripts")))
+ (pub-dir "pub"))
+ (format nil "^/~A/~A/(?:vzn/~A\\.\\d\\d*?|~A)\\.~A$" pub-dir dir name name type)))
+
+(deftestsuite versioning-suite (weblocks-suite print-upcase-suite)
+ ())
+
+(defparameter *temp-mod-record-folder* (princ-to-string (compute-public-files-path "weblocks" "mod-record/test/temp-vzn")))
+(defparameter *temp-version-folder* (princ-to-string (compute-public-files-path "weblocks" "test/temp-vzn")))
+(defparameter *temp-version-file* (concatenate 'string *temp-version-folder* "temp.test"))
+
+(addtest versioning-test-1
+ (cl-fad:delete-directory-and-files *temp-version-folder* :if-does-not-exist :ignore)
+ (cl-fad:delete-directory-and-files *temp-mod-record-folder* :if-does-not-exist :ignore)
+ (weblocks::write-to-file 'test-text *temp-version-file*)
+ ;; version file initialization
+ (ensure-same (weblocks::update-versioned-dependency-path *temp-version-file* "/www/temp.test")
+ (values (cl-ppcre:regex-replace "temp.test$" *temp-version-file* "vzn/temp.0.test")
+ "/www/vzn/temp.0.test"))
+
+ (sleep 1) ;; so that modified time of temp.test will change
+ (weblocks::write-to-file 'new-test-text *temp-version-file*)
+ (ensure-same (weblocks::update-versioned-dependency-path *temp-version-file* "/www/temp.test")
+ (values (cl-ppcre:regex-replace "temp.test$" *temp-version-file* "vzn/temp.1.test")
+ "/www/vzn/temp.1.test"))
+
+ ;; import rule versioning
+ (let ((import-path (concatenate 'string *temp-version-folder* "import.css")))
+ (weblocks::with-file-write (stream import-path)
+ (write-string "@import url(/pub/stylesheets/table.css);
+@import url(/pub/stylesheets/form.css);" stream))
+ (weblocks::update-import-css-content import-path :version-types '(:stylesheet) :gzip-types nil)
+ (ensure-same "^\\n@import url\\(/pub/stylesheets/vzn/table\\.\\d\\d*?\\.css\\);\\n@import url\\(/pub/stylesheets/vzn/form\\.\\d\\d*?\\.css\\);$"
+ (weblocks::slurp-file import-path)
+ :test #'cl-ppcre:scan)))
+
+(addtest gzipping-test-1
+ (cl-fad:delete-directory-and-files *temp-version-folder* :if-does-not-exist :ignore)
+ (weblocks::with-file-write (stream *temp-version-file*)
+ (write-string (make-sequence 'string 1000 :initial-element #\x) stream))
+ (weblocks::create-gziped-dependency-file *temp-version-file*)
+ (ensure (cl-fad:file-exists-p (concatenate 'string *temp-version-file* ".gz"))))
View
4 test/widgets/datagrid/datagrid.lisp
@@ -367,10 +367,10 @@
(deftest datagrid-dependencies-1
(with-request :get nil
(not (null
- (member "/pub/stylesheets/pagination.css"
+ (member (make-versioned-regex "pagination" "css")
(dependencies (make-instance 'datagrid :data-class 'employee))
:key (lambda (e)
(format nil "~A" (dependency-url e)))
- :test #'string-equal))))
+ :test #'cl-ppcre:scan))))
t)
View
44 test/widgets/widget/widget.lisp
@@ -12,7 +12,7 @@
(progn
(defclass foo (bar)
((slot1 :initarg :slot1)
- (slot2 :initform nil))
+ (slot2 :initform nil))
(:metaclass widget-class))
(defmethod per-class-dependencies append ((weblocks::obj foo))
(declare (ignore weblocks::obj))
@@ -36,23 +36,27 @@
;;; test widget-dependencies
(addtest widget-dependencies-1
- (ensure-same (values-list
- (mapcar #'dependency-url
- (dependencies (make-instance 'navigation))))
- (values (puri:uri "/pub/stylesheets/menu.css")
- (puri:uri "/pub/stylesheets/navigation.css"))
- :test puri:uri=))
+ (ensure-same (values-list (mapcar (lambda (x) (puri:uri-path (dependency-url x)))
+ (dependencies (make-instance 'navigation))))
+ (values-list (mapcar (lambda (x) (apply #'make-versioned-regex x))
+ '(("menu" "css")
+ ("navigation" "css"))))
+ :test (lambda (x y) (cl-ppcre:scan y x))))
(addtest widget-dependencies-2
(ensure-same
- (mapcar #'dependency-url
- (dependencies (make-instance 'gridedit :data-class 'employee)))
+ (values-list (remove-import-urls (mapcar (lambda (x) (puri:uri-path (dependency-url x)))
+ (dependencies (make-instance 'gridedit
+ :data-class 'employee)))))
;; note, pagination and dataform are there because for gridedit and
;; datagrid widget-dependencies is specialized
- '(#U"/pub/stylesheets/dataform.css" #U"/pub/stylesheets/pagination.css"
- #U"/pub/stylesheets/datagrid.css" #U"/pub/scripts/datagrid.js"
- #U"/pub/stylesheets/dataseq.css")
- :test set-equal-uri=))
+ (values-list (mapcar (lambda (x) (apply #'make-versioned-regex x))
+ '(("dataseq" "css")
+ ("datagrid" "js")
+ ("datagrid" "css")
+ ("pagination" "css")
+ ("dataform" "css"))))
+ :test (lambda (x y) (cl-ppcre:scan y x))))
(deftest widget-dependencies-3
(with-request :get nil
@@ -255,12 +259,14 @@
(:li :class "manager" (:span :class "label text" "Manager:&nbsp;") (:span :class "value" "Jim")))))
(deftest render-widget-4
- (let ((*weblocks-output-stream* (make-string-output-stream)))
- (declare (special *weblocks-output-stream*))
- (with-request :get nil
- (render-widget (make-instance 'dataform :data *joe*))
- (format nil "~A" (mapcar #'dependency-url weblocks::*page-dependencies*))))
- "(/pub/stylesheets/dataform.css)")
+ (ensure-same
+ (let ((*weblocks-output-stream* (make-string-output-stream)))
+ (declare (special *weblocks-output-stream*))
+ (with-request :get nil
+ (render-widget (make-instance 'dataform :data *joe*))
+ (format nil "~A" (car (mapcar #'dependency-url weblocks::*page-dependencies*)))))
+ (make-versioned-regex "dataform-import" "css")
+ :test (lambda (x y) (cl-ppcre:scan y x))))
(deftest render-widget-5
(with-request :get nil
View
8 weblocks-test.asd
@@ -28,8 +28,12 @@
:components ((:file "misc")
(:file "runtime-class"))
:depends-on ("test-code"))
- (:file "dependencies"
+ (:file "versioning"
:depends-on ("test-code" utils-test))
+ (:file "bundling"
+ :depends-on ("test-code" "versioning" utils-test))
+ (:file "dependencies"
+ :depends-on ("test-code" "versioning" utils-test))
(:file "actions"
:depends-on ("test-code"))
(:file "uri-tokens"
@@ -143,7 +147,7 @@
(:file "pagination"
:depends-on ("pagination-utils"))
(:file "composite"))
- :depends-on ("test-code" fixtures views))
+ :depends-on ("versioning" "test-code" fixtures views))
(:module control-flow
:components ((:file "call-answer")
(:file "dialog")

0 comments on commit d076276

Please sign in to comment.