Changeset 12503

Timestamp:

02/22/10 16:32:45 (12 years ago)

Author:

Mark Evenson

Message:

DIRECTORY now works for jar pathnames.

The semantics for listing directories are a little bit different from
DIRECTORY on filesystems because directory entries in jar files
*always* have a trailing '/'.

Location:

trunk/abcl

Files:

• CHANGES (modified) (2 diffs)
• doc/design/pathnames/abcl-jar-url.text (modified) (2 diffs)
• src/org/armedbear/lisp/Pathname.java (modified) (4 diffs)
• src/org/armedbear/lisp/directory.lisp (modified) (2 diffs)

trunk/abcl/CHANGES

@@ -15 +15 @@
 
 * [svn r12422] Jar pathname support extensively re-worked and tested
-  so that LOAD, PROBE-FILE, TRUENAME, and WRITE-FILE-DATE all work
-  both for local and remote jar pathnames of the form
+  so that LOAD, PROBE-FILE, TRUENAME, DIRECTORY, and WRITE-FILE-DATE
+  all work both for local and remote jar pathnames of the form
   "jar:URL!/JAR-ENTRY".
 
@@ -24 +24 @@
   jar.
        
-  NB: jar pathnames do *not* currently work as an argument to OPEN or
-  DIRECTORY.
+  NB: jar pathnames do *not* currently work as an argument to OPEN.
 
   SYS:UNZIP implemented to unpack ZIP files.  

trunk/abcl/doc/design/pathnames/abcl-jar-url.text

@@ -4 +4 @@
 Mark Evenson
 Created: 09 JAN 2010
-Modified: 08 FEB 2010
+Modified: 22 FEB 2010
 
 Notes towards sketching an implementation of "jar:" references to be
@@ -54 +54 @@
 ------
 
-As of svn r12431, all the above goals have been implemented and tested
+As of svn r12501, all the above goals have been implemented and tested
 *except* for:
-
-5.  DIRECTORY working within JAR files
 
 7.  Make jar pathnames work as a valid argument for OPEN.

trunk/abcl/src/org/armedbear/lisp/Pathname.java

@@ -39 +39 @@
 import java.io.InputStream;
 import java.io.FileInputStream;
-import java.net.JarURLConnection;
 import java.net.MalformedURLException;
 import java.net.URL;
-import java.net.URLConnection;
 import java.net.URLDecoder;
-import java.util.HashMap;
+import java.util.Enumeration;
 import java.util.StringTokenizer;
-import java.util.jar.JarEntry;
-import java.util.jar.JarFile;
 import java.util.zip.ZipEntry;
 import java.util.zip.ZipFile;
 import java.util.zip.ZipInputStream;
-import java.util.zip.ZipException;
 
 public class Pathname extends LispObject {
@@ -1247 +1242 @@
         }
     }
+
+    private static Function pathname_match_p;
+    private static LispObject matchesWildcard(LispObject pathname, LispObject wildcard) {
+        if (pathname_match_p == null) {
+            pathname_match_p
+              = (Function) PACKAGE_SYS.findAccessibleSymbol("PATHNAME-MATCH-P")
+                .getSymbolFunction();
+            if (pathname_match_p == null) {
+                Debug.assertTrue(false);
+            }
+        }
+        return pathname_match_p.execute(pathname, wildcard);
+    }
+
     // ### list-directory directory
     private static final Primitive LIST_DIRECTORY = new pf_list_directory();
@@ -1259 +1268 @@
                 pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
             }
+
+            LispObject result = NIL;
             if (pathname.isJar()) {
-                return error(new FileError("Unimplemented directory listing of JAR files.", pathname));
-            }
-            LispObject result = NIL;
+                String directory = pathname.asEntryPath();
+                Debug.assertTrue(directory != null);  // We should only be listing directories
+
+                if (pathname.device.cdr() instanceof Cons) {
+                    return error(new FileError("Unimplemented directory listing of JAR within JAR.", pathname));
+                }
+
+                if (directory.length() == 0) {
+                    directory = "/*";
+                } else {
+                    if (directory.endsWith("/")) {
+                        directory = "/" + directory + "*";
+                    } else {
+                        directory = "/" + directory + "/*";
+                    }
+                }
+                SimpleString wildcard = new SimpleString(directory);
+                SimpleString wildcardDirectory = new SimpleString(directory + "/");
+
+                ZipFile jar = ZipCache.get(pathname.device.car());
+                LispObject matches;
+                for (Enumeration<? extends ZipEntry> entries = jar.entries(); 
+                     entries.hasMoreElements();) {
+                    ZipEntry entry = entries.nextElement();
+                    String entryName = "/" + entry.getName();
+
+                    if (entryName.endsWith("/")) {
+                        matches = matchesWildcard(new SimpleString(entryName),
+                                                  wildcardDirectory);
+                    } else {
+                        matches = matchesWildcard(new SimpleString(entryName), 
+                                                  wildcard);
+                    }
+                    if (!matches.equals(NIL)) {
+                        String namestring = new String(pathname.getNamestring());
+                        namestring = namestring.substring(0, namestring.lastIndexOf("!/") + 2)
+                                 + entry.getName();
+                        Pathname p = new Pathname(namestring);
+                        result = new Cons(p, result);
+                    }
+                }
+                return result;
+            }
+
             String s = pathname.getNamestring();
             if (s != null) {
@@ -1287 +1339 @@
                         Debug.trace(e);
                     }
+                }
+            }
+            return result;
+        }
+    }
+
+    // ### match-wild-jar-pathname wild-jar-pathname
+    private static final Primitive LIST_JAR_DIRECTORY = new pf_match_wild_jar_pathname();
+    private static class pf_match_wild_jar_pathname extends Primitive {
+        pf_match_wild_jar_pathname() {
+            super("match-wild-jar-pathname", PACKAGE_SYS, false, "wild-jar-pathname");
+        }
+        @Override
+        public LispObject execute(LispObject arg) {
+            Pathname pathname = coerceToPathname(arg);
+            if (pathname instanceof LogicalPathname) {
+                pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
+            }
+            if (!pathname.isJar()) {
+                return new FileError("Not a jar pathname.", pathname);
+            }
+            if (!pathname.isWild()) {
+                return new FileError("Not a wild pathname.", pathname);
+            }
+            Pathname jarPathname = new Pathname(pathname);
+            jarPathname.directory = NIL;
+            jarPathname.name = NIL;
+            jarPathname.type = NIL;
+            jarPathname.invalidateNamestring();
+            // will propagate an appropiate Lisp error if jarPathname
+            // doesn't exist.
+            LispObject jarTruename = truename(jarPathname, true); 
+
+            LispObject result = NIL;
+            String wild = "/" + pathname.asEntryPath();
+
+            if (pathname.device.cdr() instanceof Cons) {
+                return error(new FileError("Unimplemented directory listing of JAR within JAR.", pathname));
+            }
+            
+            final SimpleString wildcard = new SimpleString(wild);
+
+            ZipFile jar = ZipCache.get(pathname.device.car());
+
+            for (Enumeration<? extends ZipEntry> entries = jar.entries(); entries.hasMoreElements();) {
+                ZipEntry entry = entries.nextElement();
+                String entryName = "/" + entry.getName();
+                
+                LispObject matches = matchesWildcard(new SimpleString(entryName), wildcard);
+
+                if (!matches.equals(NIL)) {
+                    String namestring = new String(pathname.getNamestring());
+                    namestring = namestring.substring(0, namestring.lastIndexOf("!/") + 2)
+                        + entry.getName();
+                    Pathname p = new Pathname(namestring);
+                    result = new Cons(p, result);
                 }
             }

trunk/abcl/src/org/armedbear/lisp/directory.lisp

@@ -54 +54 @@
    (entries (list-directory newpath)))
     (if (not wild)
-  entries (mapcan (lambda (entry)
-                          (let* ((pathname (pathname entry))
-                                 (directory (pathname-directory pathname))
-                                 (rest-wild (cdr wild)))
-                            (unless (pathname-name pathname)
-            (when (pathname-match-p (first (last directory)) (if (eql (car wild) :wild) "*" (car wild)))
-        (when rest-wild
-          (setf directory (nconc directory rest-wild)))
-          (list-directories-with-wildcards
-         (make-pathname :directory directory
-            :defaults newpath))))))
-                        entries))))
+  entries 
+        (mapcan (lambda (entry)
+                  (let* ((pathname (pathname entry))
+                         (directory (pathname-directory pathname))
+                         (rest-wild (cdr wild)))
+                    (unless (pathname-name pathname)
+                      (when (pathname-match-p (first (last directory)) 
+                                              (if (eql (car wild) :wild) "*" (car wild)))
+                        (when rest-wild
+                          (setf directory (nconc directory rest-wild)))
+                        (list-directories-with-wildcards
+                         (make-pathname :directory directory
+                                        :defaults newpath))))))
+                entries))))
 
 
@@ -74 +76 @@
     (if (or (position #\* (namestring pathname))
       (wild-pathname-p pathname))
-        (let ((namestring (directory-namestring pathname)))
-          (when (and namestring (> (length namestring) 0))
-            (when (featurep :windows)
-              (let ((device (pathname-device pathname)))
-                (when device
-                  (setq namestring (concatenate 'string device ":" namestring)))))
-            (let ((entries (list-directories-with-wildcards namestring))
-                  (matching-entries ()))
-              (dolist (entry entries)
-                (cond ((file-directory-p entry)
-                       (when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
-                         (push entry matching-entries)))
-                      ((pathname-match-p (file-namestring entry) (file-namestring pathname))
-                       (push entry matching-entries))))
-              matching-entries)))
+        (if (pathname-jar-p pathname)
+            (match-wild-jar-pathname pathname)
+            (let ((namestring (directory-namestring pathname)))
+              (when (and namestring (> (length namestring) 0))
+                (when (featurep :windows)
+                  (let ((device (pathname-device pathname)))
+                    (when device
+                      (setq namestring (concatenate 'string device ":" namestring)))))
+                (let ((entries (list-directories-with-wildcards namestring))
+                      (matching-entries ()))
+                  (dolist (entry entries)
+                    (cond ((file-directory-p entry)
+                           (when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
+                             (push entry matching-entries)))
+                          ((pathname-match-p (file-namestring entry) (file-namestring pathname))
+                           (push entry matching-entries))))
+                  matching-entries))))
         ;; Not wild.
         (let ((truename (probe-file pathname)))