Changeset 14697

Timestamp:

04/27/14 14:11:37 (9 years ago)

Author:

Mark Evenson

Message:

Backport r14693: PREPARE-FOR-WAR packages ASDF systems for deployment in WAR archives.

With archives packages under 'WEB-INF/resources', placing these jar
files in the 'WEB-INF/lib' directory enables the Java Servlet
ServletContext?().getResourceAsStream() method to access their
contents.

Location:

branches/1.3.1/contrib/asdf-jar

Files:

• asdf-jar.asd (modified) (1 diff)
• asdf-jar.lisp (modified) (5 diffs)

branches/1.3.1/contrib/asdf-jar/asdf-jar.asd

@@ -4 +4 @@
 (defsystem :asdf-jar
   :author "Mark Evenson"
-  :version "0.2.1"
-  :description "<> asdf:defsystem <urn:abcl.org/release/1.3.0/contrib/asdf-jar#0.2.1>"
+  :version "0.3.0"
+  :description "<> asdf:defsystem <urn:abcl.org/release/1.3.0/contrib/asdf-jar#0.3.0>"
   :components 
   ((:module base :pathname "" :components

branches/1.3.1/contrib/asdf-jar/asdf-jar.lisp

@@ -6 +6 @@
   (:use :cl)
   (:export #:package 
+           ;; "Si vis pacem, para bellum" -- Publius Flavius Vegetius Renatus
+           #:prepare-for-war 
            #:add-to-asdf))
 
-(in-package :asdf-jar)
+(in-package #:asdf-jar)
 
 (defvar *debug* nil)
 
-(defun package (system
-          &key (out #p"/var/tmp/") 
-               (recursive t)          ; whether to package dependencies
-               (force nil)            ; whether to force ASDF compilation
-               (verbose t))
+(defun package (system &key 
+                         (out #p"/var/tmp/") 
+                         (recursive t)          ; whether to package dependencies
+                         (force nil)            ; whether to force ASDF compilation
+                         (root nil)
+                         (verbose t))
 "Compile and package the asdf SYSTEM in a jar.
 
@@ -32 +35 @@
   (let* ((name 
           (slot-value system 'asdf::name))
-         (version 
-          (handler-case (slot-value system 'asdf:version)
-            (unbound-slot () "unknown")))
+         (version (let ((v (slot-value system 'asdf:version)))
+                    (when v
+                      v)))
          (package-jar-name 
-          (format nil "~A~A-~A" name (if recursive "-all" "") version))
+          (format nil "~A~A~A" name (if recursive "-all" "") (if version 
+                                                                 (format nil "-~A" version)
+                                                                 "")))
          (package-jar
           (make-pathname :name package-jar-name
@@ -58 +63 @@
             (name (slot-value system 'asdf::name))
             (asdf (slot-value system 'asdf::source-file)))
-        (setf (gethash asdf mapping) (archive-relative-path base name asdf))
+        (setf (gethash asdf mapping) (let ((relative-path (archive-relative-path 
+                                                           base name asdf)))
+                                       (if root
+                                         (merge-pathnames
+                                          relative-path
+                                          (make-pathname :directory root))
+                                         relative-path)))
         (loop :for component :in (all-files system) 
            :for source = (slot-value component 'asdf::absolute-pathname)
            :for source-entry = (archive-relative-path base name source)
            :do (setf (gethash source mapping)
-                     source-entry)
+                     (if root 
+                         (merge-pathnames source-entry (make-pathname :directory root))
+                         source-entry))
            :do (when *debug*
                  (format verbose "~&~A~& => ~A" source source-entry))
@@ -73 +86 @@
                        :type "abcl"))
                      (output-entry 
-                      (make-pathname :defaults source-entry
-                                     :type "abcl")))
+                      (make-pathname :defaults source-entry 
+                                     :type "abcl"
+                                     :directory (append root
+                                                        (rest (pathname-directory source-entry))))))
                  (when *debug*
                    (format verbose "~&~A~& => ~A" output output-entry))
@@ -141 +156 @@
                             :inherit-configuration))))
 
+(defun prepare-for-war (system &key 
+                                 (out #p"/var/tmp/") 
+                                 (recursive nil)          ; whether to package dependencies
+                                 (force nil)            ; whether to force ASDF compilation
+                                 (root (list :relative "WEB-INF" "resources"))
+                                 (verbose t))
+  "Package named asdf SYSTEM for deployment in a Java Servlet container war file. 
+
+c.f. PACKAGE for further options."
+
+  (warn "Unaudited.  Please see your local Honey dealer.")
+  (package system :out out :recursive recursive :force force :verbose verbose
+           :root root))
+
+
 (provide :asdf-jar)