Changeset 13336 for trunk


Ignore:
Timestamp:
06/16/11 14:56:53 (12 years ago)
Author:
Mark Evenson
Message:

Create form of SYSTEM:ZIP that uses a hashtable to map files to entries.

SYSTEM:ZIP PATH HASHTABLE now creates entries in a zipfile at PATH
whose entries are the contents of for each (KEY VALUE) in HASHTABLE
for which KEY refers to an object on the filesystem and VALUE is the
location in the zip archive.

Introduce Java interfaces in org.armedbear.lisp.protocol to start
encapsulating behavior of Java system. By retroactively adding
markers to the object hierarchy rooted on LispObject we gain the
ability to have our JVM code optionally work with interfaces but we
leave the core dispatch functions alone for speed.

Location:
trunk/abcl
Files:
5 added
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/abcl.asd

    r13309 r13336  
    5858                      #+abcl
    5959                      (:file "weak-hash-tables")
     60                      #+abcl
     61                      (:file "zip")
    6062                      #+abcl
    6163                      (:file "pathname-tests" :depends-on

  • trunk/abcl/contrib/asdf-jar/asdf-jar.lisp

    r13308 r13336  
    55(in-package :asdf-jar)
    66
     7
    78(defvar *systems*)
    89(defmethod asdf:perform :before ((op asdf:compile-op) (c asdf:system))
    910       (push c *systems*))
    1011
    11 (defun package (system-name &key (recursive t) (verbose t))
    12   (declare (ignore recursive))
     12;; (defvar *sources*)
     13;; (defmethod asdf:perform :before ((op asdf:compile-op) (s asdf:source-file))
     14;;        (push c *sources*))
     15
     16(eval-when (:compile-toplevel :execute)
     17  (ql:quickload "cl-fad"))
     18
     19(defun package (system-name
     20                &key (out #p"/var/tmp/")
     21                     (recursive t)
     22                     (verbose t))
    1323  (asdf:disable-output-translations)
    14   (let* ((system (asdf:find-system system-name))
    15    (name (slot-value system 'asdf::name)))
     24  (let* ((system
     25          (asdf:find-system system-name))
     26   (name
     27          (slot-value system 'asdf::name))
     28         (version
     29          (slot-value system 'asdf:version))
     30         (package-jar-name
     31          (format nil "~A~A-~A.jar" name (when recursive "-all") version))
     32         (package-jar
     33          (make-pathname :directory out :defaults package-jar-name))
     34         (tmpdir (tmpdir (pathname-name (pathname package-jar-name)))))
    1635    (when verbose
    17       (format verbose "Packaging ASDF definition of~A~%" system))
     36      (format verbose "~&Packaging ASDF definition of ~A~&as ~A." system package-jar))
    1837    (setf *systems* nil)
    1938    (asdf:compile-system system :force t)
    … …  
    2140     (wild-contents (merge-pathnames "**/*" dir))
    2241     (contents (directory wild-contents))
    23      (output (format nil "/var/tmp/~A.jar" name))
    2442     (topdir (truename (merge-pathnames "../" dir))))
    2543      (when verbose
    26   (format verbose "Packaging contents in ~A.~%" output))
    27       (system:zip output contents topdir)))
     44  (format verbose "~&Packaging contents in ~A." package-jar))
     45      (dolist (system (append (list system) *systems*))
     46        (copy-recursively system tmpdir))
     47      (system:zip package-jar contents topdir)))
    2848  (asdf:initialize-output-translations))
     49
     50(defun copy-recursively (source destination)
     51  (let* ((source (truename source))
     52         (source-directories (1- (length (pathname-directory source))))
     53         (destination (truename destination)))
     54    (cl-fad:walk-directory
     55     source
     56   (lambda (p)
     57     (let* ((relative-depth (- (length (pathname-directory p))
     58                               (length (pathname-directory source))))
     59            (subdir '(nthcdr (+ source-directories relative-depth)
     60                      (pathname-directory source)))
     61            (orig (merge-pathnames p
     62                                   (make-pathname :directory (append (pathname-directory
     63                                                                      source)
     64                                                                     subdir))))
     65            (dest (merge-pathnames p
     66                                  (make-pathname :directory (append (pathname-directory
     67                                                                     destination)
     68                                                                    subdir)))))
     69       (format t "~&Would copy ~A~&to ~A." orig dest))))))
     70                         
     71
     72(defun tmpdir (name)
     73  "Return a the named temporary directory."
     74  (let* ((temp-file (java:jcall "getAbsolutePath"
     75                               (java:jstatic "createTempFile" "java.io.File" "foo" "tmp")))
     76         (temp-path (pathname temp-file)))
     77    (make-pathname
     78     :directory (nconc (pathname-directory temp-path)
     79                       (list name)))))
     80
     81
     82
     83
     84
     85
     86
     87
     88
     89
     90
     91
     92
    2993
    3094

  • trunk/abcl/src/org/armedbear/lisp/HashTable.java

    r12971 r13336  
    3737import static org.armedbear.lisp.Lisp.*;
    3838
    39 public class HashTable extends LispObject {
     39public class HashTable
     40    extends LispObject
     41    implements org.armedbear.lisp.protocol.Hashtable
     42{
    4043
    4144    protected static final float loadFactor = 0.75f;
    … …  
    348351    }
    349352
    350     // Returns a list of (key . value) pairs.
     353
    351354    public LispObject ENTRIES() {
     355        return getEntries();
     356    }
     357
     358    // Returns a list of (key . value) pairs.       
     359    public LispObject getEntries() {
    352360        // No need to take out a read lock, for the same reason as MAPHASH
    353361        HashEntry[] b = buckets;

  • trunk/abcl/src/org/armedbear/lisp/WeakHashTable.java

    r13310 r13336  
    5858public class WeakHashTable
    5959    extends LispObject
     60    implements org.armedbear.lisp.protocol.Hashtable
    6061{
    6162    protected static final float loadFactor = 0.75f;
    … …  
    509510    }
    510511
    511     // Returns a list of (key . value) pairs.
     512    @Deprecated
    512513    public LispObject ENTRIES() {
     514        return getEntries();
     515    }
     516
     517    /** @returns A list of (key . value) pairs. */
     518    public LispObject getEntries() {
    513519        HashEntry[] b = getTable();
    514520        LispObject list = NIL;

  • trunk/abcl/src/org/armedbear/lisp/zip.java

    r13321 r13336  
    5959        super("zip", PACKAGE_SYS, true);
    6060    }
     61   
    6162
    6263    @Override
    … …  
    6465    {
    6566        Pathname zipfilePathname = coerceToPathname(first);
     67        if (second instanceof org.armedbear.lisp.protocol.Hashtable) {
     68            return execute(zipfilePathname, (org.armedbear.lisp.protocol.Hashtable)second);
     69        }
    6670        byte[] buffer = new byte[4096];
    6771        try {
    … …  
    8185                    File zipfile = new File(zipfileNamestring);
    8286                    zipfile.delete();
    83                     return error(new SimpleError("Pathname has no namestring: " +
    84                                                   pathname.writeToString()));
     87                    return error(new SimpleError("Pathname has no namestring: "
     88                                                 + pathname.writeToString()));
    8589                }
    8690                File file = new File(namestring);
    … …  
    9599        return zipfilePathname;
    96100    }
     101
     102   
    97103
    98104    @Override
    … …  
    156162    }
    157163
     164    static class Directories extends HashSet<String> {
     165        private Directories() {
     166            super();
     167        }
     168       
     169        ZipOutputStream out;
     170        public Directories(ZipOutputStream out) {
     171            this.out = out;
     172        }
     173           
     174        public void ensure(String path)
     175            throws IOException
     176        {
     177            int i = 0;
     178            int j;
     179            while ((j = path.indexOf(Pathname.separator, i)) != -1) {
     180                i = j + 1;
     181                final String directory = path.substring(0, j) + Pathname.separator;
     182                if (!contains(directory)) {
     183                    add(directory);
     184                    ZipEntry entry = new ZipEntry(directory);
     185                    out.putNextEntry(entry);
     186                    out.closeEntry();
     187                }
     188            }
     189        }
     190    }
     191
     192    public LispObject execute(final Pathname zipfilePathname, final org.armedbear.lisp.protocol.Hashtable table) {
     193        LispObject entriesObject = (LispObject)table.getEntries();
     194        if (!(entriesObject instanceof Cons)) {
     195            return NIL;
     196        }
     197        Cons entries = (Cons)entriesObject;
     198
     199        String zipfileNamestring = zipfilePathname.getNamestring();
     200        if (zipfileNamestring == null)
     201            return error(new SimpleError("Pathname has no namestring: " +
     202                                         zipfilePathname.writeToString()));
     203        ZipOutputStream out = null;
     204        try {
     205            out = new ZipOutputStream(new FileOutputStream(zipfileNamestring));
     206        } catch (FileNotFoundException e) {
     207            return error(new FileError("Failed to create file for writing zip archive", zipfilePathname));
     208        }
     209        Directories directories = new Directories(out);
     210
     211
     212        for (LispObject head = entries; head != NIL; head = head.cdr()) {
     213            final LispObject key = head.car().car();
     214            final LispObject value = head.car().cdr();
     215
     216            final Pathname source = Lisp.coerceToPathname(key);
     217            final Pathname destination = Lisp.coerceToPathname(value);
     218            final File file = Utilities.getFile(source);
     219            try {
     220                String jarEntry = destination.getNamestring();
     221                if (jarEntry.startsWith("/")) {
     222                    jarEntry = jarEntry.substring(1);
     223                }
     224                directories.ensure(jarEntry);
     225                makeEntry(out, file, jarEntry);
     226            } catch (FileNotFoundException e) {
     227                return error(new FileError("Failed to read file for incoporation in zip archive.", source));
     228            } catch (IOException e) {
     229                return error(new FileError("Failed to add file to zip archive.", source));
     230            }
     231        }
     232        try {
     233            out.close();
     234        } catch (IOException ex) {
     235            return error(new FileError("Failed to close zip archive.", zipfilePathname));
     236        }
     237        return zipfilePathname;
     238    }
     239
    158240    private static final Primitive zip = new zip();
    159241
Note: See TracChangeset for help on using the changeset viewer.