Правильная распаковка файла Excel в Common Lisp

я бы позвонил

(ensure-directories-exist #p"/Users/foo/dir/")

вместо

(ensure-directories-exist #p"/Users/foo/dir/[a].b")

Основная проблема здесь в том, что вы наткнулись на границы спецификации пути CL. К сожалению, эти края никогда не бывают очень далеко.

В данном случае проблема специфична для SBCL, но это не потому, что в SBCL есть ошибки: а потому, что SBCL делает то, что ему разрешено.

Очень краткий ответ заключается в том, что вам нужно либо использовать, либо найти что-то, что превращает строки в имена путей четко определенным способом для распространенных платформ. И практический ответ, вероятно, состоит в том, чтобы использовать UIOP ASDF и, в частности, использовать uiop:ensure-pathname всякий раз, когда вы хотите превратить строку в путь. Это позволит всему работать. Итак, если вы измените функцию unzip так:

(defun unzip (pathname target-directory &key (if-exists :error) verbose)
  ;; <Xof> "When reading[1] the value of any pathname component, conforming
  ;;       programs should be prepared for the value to be :unspecific."
  (when (set-difference (list (pathname-name target-directory)
                              (pathname-type target-directory))
                        '(nil :unspecific))
    (error "pathname not a directory, lacks trailing slash?"))
  (with-zipfile (zip pathname)
    (do-zipfile-entries (name entry zip)
      (let ((filename (merge-pathnames (uiop:ensure-pathname name)
                                       target-directory)))
        (ensure-directories-exist filename)
        (unless (char= (elt name (1- (length name))) #/)
          (ecase verbose
            ((nil))
            ((t) (write-string name) (terpri))
            (:dots (write-char #\.)))
          (force-output)
          (with-open-file
              (s filename :direction :output :if-exists if-exists
               :element-type '(unsigned-byte 8))
            (zipfile-entry-contents entry s)))))))

Тогда все будет работать.

Кроме того, не полагайтесь на

Ниже приведены некоторые подробности, которые, я думаю, стоит отметить.

Конкретная проблема заключается в том, что SBCL (и я думаю, что SBCL только среди текущих реализаций) имеет расширенное представление о том, что такое дикий путь. Разрешено это делать. Таким образом, в SBCL результатом (parse-namestring "[foo].xml") является дикий путь. В частности, это дикий путь, который соответствует "f.xml" и "o.xml". То же самое верно и для этого синтаксиса, используемого в других компонентах имен путей, и этот синтаксис должен быть знаком по синтаксису, поддерживаемому многими оболочками Unix, а также по регулярным выражениям.

Теперь, в SBCL, если вы создаете путь с помощью make-pathname и используете в качестве компонентов только строки, вы не получите дикий путь. Так, например

> (wild-pathname-p (pathname "[foo].xml"))
t
> (wild-pathname-p (make-pathname :name "[foo]" :type "xml"))
nil
> (wild-pathname-p (pathname "foo.*"))
(:wild :wild-inferiors)
> (wild-pathname-p (make-pathname :name "foo" :type "*"))

Таким образом, вы всегда можете создать путь таким образом, который не будет диким. Чтобы создать дикий путь, вам нужно использовать какое-то нестроковое значение (например, :wild). Я не знаю, есть ли способ создать объект, соответствующий [abc], кроме как получить его из другого пути: я не могу найти упоминания об этом в руководстве SBCL.

Однако это ужасно не может быть портативным. CLHS говорит в 19.2.2.3:

[...] соответствующие программы должны быть готовы встретить любое из следующих дополнительных значений в любом компоненте или любом элементе списка, который является компонентом каталога:

• Символ :wild, который соответствует чему угодно.
• Строка, содержащая специальные подстановочные знаки, зависящие от реализации.
• Любой объект, представляющий шаблон подстановочных знаков, зависящий от реализации.

[Мой акцент]

Второй случай означает, что да, путь может содержать компоненты, которые являются строками, но при этом являются дикими.

Возможно, можно утверждать, что если вы предоставите строку в качестве компонента пути для make-pathname, то это имя пути не может быть диким в этом компоненте. Я не думаю, что спецификация действительно говорит об этом, и я думаю, что это, вероятно, не может, потому что я ожидаю, что если какой-то путь p имеет дикое имя, то (make-pathname :name (pathname-name a) :type "foo")) также имеет дикое имя. Тем не менее, сверху дикое имя может быть строкой.

С другой стороны, SBCL, похоже, придерживается разумного подхода: если вы предоставляете строку для компонента в make-pathname, этот компонент никогда не будет диким. Я считаю, что это правильно.

Однако ничто из этого вам не поможет: zip-файлы (и многие другие типы файлов) содержат пути, представленные в виде строк. Что-то на уровне Lisp должно анализировать эти пути. И если эти пути выглядят дикими, он будет анализировать их как дикие пути. Могут быть конкретные обходные пути, которые, я думаю, дал вам Райнер, но в целом я думаю, что единственное решение этой проблемы — это либо реализовать собственный анализ имен путей (ужасно), либо полагаться на то, что кто-то другой сделает это за вас. И в данном случае люди из ASDF сделали это за вас.

В настоящее время я нашел это исправление (в том виде, в каком пакет zip остается неизменным).

(ql:quickload :uiop)
(ql:quickload :zip)

;;;; my correction functions only valid for SBCL

(defun path-to-string (path)
  "Convert Path to plain string expanding `~` correctly."
  (let* ((path-string (format nil "~a" path))
     (pos (position #\? path-string)))
    (if (and pos (zerop pos))
    (concatenate 'string (uiop:getenv "HOME") (subseq path-string 1))
        path-string)))

(Defun path-string-directory (path &key (sep #/))
  "Return parent directory string ending with `/`."
  (let* ((path-string (path-to-string path))
     (pos (position sep (reverse path-string))))
    (if pos
    (subseq path-string 0 (- (length path-string) (position sep (reverse path-string))))
    (uiop/os:getcwd)))) ;; current working directory

(defun path-string-last (path &key (sep #/))
  "Return last element of a path-string - directory or file."
  (let* ((path-string (path-to-string path))
     (pos (position sep (reverse path-string))))
    (if pos
    (subseq path-string (- (length path-string) (position sep (reverse path-string))))
    path-string)))

(defun path-string-name (path &key (sep #/))
  "Return name component of filename (before last dot)."
  (let ((last-part (path-string-last path :sep sep))
        (sep-type #\.))
    (subseq last-part 0 (- (length last-part) (position sep-type (reverse last-part)) 1))))

(defun path-string-type (path &key (sep #/))
  "Return type portion of filename (after last dot)."
  (let ((last-part (path-string-last path :sep sep))
        (sep-type #\.))
    (subseq last-part (- (length last-part) (position sep-type (reverse last-part))))))

(defun path-string-make (path &key (directory nil) (sep #/))
  "Return corrected path object of a path or path string by treating brackets as plain
     text."
  (make-pathname :directory (or directory (path-string-directory path :sep sep))
                 :name (path-string-name path :sep sep)
                 :type (path-string-type path :sep sep)))

#|
(defun create-test-file (path &key (text "<H1/>"))
  "If this works without error, square brackets are treated correctly by the system."
  (with-open-file (stream (ensure-directories-exist path)
                          :direction :output
                          :if-does-not-exist :create
                          :if-exists :supersede)
    (format stream "~a" text)))
|#


;;;; This is part of zip package which I need to call to correct the unzip function

(defun %zipfile-entry-contents (entry stream)
  (zip::with-latin1 ()
    (let ((s (zip::zipfile-entry-stream entry))
      header)
      (file-position s (zip::zipfile-entry-offset entry))
      (setf header (zip::make-local-header s))
      (assert (= (zip::file/signature header) #x04034b50))
      (file-position s (+ (zip::file-position s)
              (zip::file/name-length header)
              (zip::file/extra-length header)))
      (let ((in (make-instance 'zip::truncating-stream
                   :input-handle s
                   :size (zip::zipfile-entry-compressed-size entry)))
        (outbuf nil)
        out)
    (if stream
        (setf out stream)
        (setf outbuf (zip::make-byte-array (zip::zipfile-entry-size entry))
          out (zip::make-buffer-output-stream outbuf)))
    (ecase (zip::file/method header)
      (0 (zip::store in out))
      (8 (zip::inflate in out)))
    outbuf))))

(defun %%zipfile-entry-contents (entry &optional stream)
  (if (pathnamep stream)
      (with-open-file (s (path-string-make stream)
             :direction :output
             :if-exists :supersede
                         :element-type '(unsigned-byte 8))
    (%zipfile-entry-contents entry s))
      (%zipfile-entry-contents entry stream)))


(defun better-unzip (pathname target-directory &key (if-exists :error) verbose)
  ;; <Xof> "When reading[1] the value of any pathname component, conforming
  ;;       programs should be prepared for the value to be :unspecific."
  (when (set-difference (list (pathname-name target-directory)
                              (pathname-type target-directory))
                        '(nil :unspecific))
    (error "pathname not a directory, lacks trailing slash?"))
  (zip:with-zipfile (zip pathname)
    (zip:do-zipfile-entries (name entry zip)
      (let ((filename (path-string-make name :directory target-directory)))
        (ensure-directories-exist filename)
        (unless (char= (elt name (1- (length name))) #/)
          (ecase verbose
            ((nil))
            ((t) (write-string name) (terpri))
            (:dots (write-char #\.)))
          (force-output)
          (with-open-file
              (s filename :direction :output :if-exists if-exists
               :element-type '(unsigned-byte 8))
            (%%zipfile-entry-contents entry s)))))))

Эта функция better-unzip работает в MacOS и Linux при быстрой загрузке :zip и :uiop. И этот код дан для исправления.l

(defparameter *xlsx* "/path/to/your/file.xlsx")
(better-unzip *xlsx* "/path/to/your/target/dir/")

Я еще не тестировал Windows. И никаких других реализаций, кроме SBCL.