主页 / coding / 问题 / 78855175
Accepted
Gwang-Jin Kim
Asked: 2024-08-10 12:01:29 +0800 CST

使用 Common Lisp 正确解压 Excel 文件

  • 772

这是关于在 MacBook 中使用 Common Lisp 创建名称带有方括号的文件会产生问题的后续问题 。我该怎么办？

我自己回答了这个问题，因为 ChatGPT 给了我答案。

但是在尝试解压一个 Excel 文件（其中包含一个名称中带有方括号的“[Content_Type].xml”文件，这导致了问题）的过程中，我意识到该zip库及其unzip功能在解压这个方括号名称时也存在问题。

unzip 函数的源代码在这里https://github.com/mcna/zip/blob/master/zip.lisp 它如下：

(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 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)))))))

让我们拿一个 excel 文件。然后使用此函数解压它。我手动创建了一个 excel 文件。然后指定了它的路径：

(defparameter *xlsx* "/Users/<user-name>/Downloads/test.xlsx")
(ql:quickload :zip)
(zip:unzip *xlsx* "/Users/<user-name>/Downloads/test_zip/")

它与我在之前的帖子中遇到的问题完全相同。

bad place for a wild pathname
   [Condition of type SB-INT:SIMPLE-FILE-ERROR]

Restarts:
 0: [RETRY] Retry SLY mREPL evaluation request.
 1: [*ABORT] Return to SLY's top level.
 2: [ABORT] abort thread (#<THREAD tid=5123 "sly-channel-1-mrepl-remote-1" RUNNING {70051404E3}>)

Backtrace:
 0: (SB-KERNEL::%FILE-ERROR #P"/Users/<user-name>/Downloads/test_zip/[Content_Types].xml" "bad place for a wild pathname")
      Locals:
        ARGUMENTS = NIL
        DATUM = "bad place for a wild pathname"
        PATHNAME = #P"/Users/<user-name>/Downloads/test_zip/[Content_Types].xml"
 1: (ENSURE-DIRECTORIES-EXIST #P"/Users/<user-name>/Downloads/test_zip/[Content_Types].xml" :VERBOSE NIL :MODE 511)
      Locals:
        #:.DEFAULTING-TEMP. = NIL
        #:.DEFAULTING-TEMP.#1 = 511
        SB-IMPL::CREATED-P = NIL
        PATHNAME = #P"/Users/<user-name>/Downloads/test_zip/[Content_Types].xml"
        SB-IMPL::PATHSPEC = #P"/Users/<user-name>/Downloads/test_zip/[Content_Types].xml"
 2: (ZIP:UNZIP "/Users/josephus/Downloads/test.xlsx" "/Users/<user-name>/Downloads/test_zip/" :IF-EXISTS :ERROR :VERBOSE NIL :FORCE-UTF-8 NIL)
      Locals:
        #:.DEFAULTING-TEMP. = NIL
        FILENAME = #P"/Users/<user-name>/Downloads/test_zip/[Content_Types].xml"
        FORCE-UTF-8 = NIL
        IF-EXISTS = :ERROR
        PATHNAME = "/Users/<user-name>/Downloads/test.xlsx"
        TARGET-DIRECTORY = "/Users/josephus/Downloads/test_zip/"
        ZIP = #S(ZIP:ZIPFILE :STREAM #<SB-SYS:FD-STREAM for "file /Users/<user-name>/Downloads/test.xlsx" {700888DB43}> :ENTRIES #<HASH-TABLE :TEST EQUAL :COUNT 11 {70088A23A3}>)
 3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (ZIP:UNZIP *XLSX* "/Users/<user-name>/Downloads/test_zip/") #<NULL-LEXENV>)
 4: (EVAL (ZIP:UNZIP *XLSX* "/Users/<user-name>/Downloads/test_zip/"))
 5: ((LAMBDA NIL :IN SLYNK-MREPL::MREPL-EVAL-1))

有人知道如何处理这个问题吗？

我询问了 chatGPT，它建议：

 (defun better-unzip (pathname target-directory &key (if-exists :error) verbose)
  "Unzip function that handles square brackets in filenames correctly."
  (zip:with-zipfile (zip pathname)
    (zip:do-zipfile-entries (name entry zip)
      (let ((filename (make-pathname :directory target-directory
                                     :name (pathname-name (parse-namestring name))
                                     :type (pathname-type (parse-namestring name)))))
        (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))
            (zip:zipfile-entry-contents entry s)))))))

然后我做了：

(better-unzip *xlsx* "/Users/<your-user-name>/Downloads/test_zip/")

但我又遇到了：

bad place for a wild pathname
   [Condition of type SB-INT:SIMPLE-FILE-ERROR]

Restarts:
 0: [RETRY] Retry SLY mREPL evaluation request.
 1: [*ABORT] Return to SLY's top level.
 2: [ABORT] abort thread (#<THREAD tid=5123 "sly-channel-1-mrepl-remote-1" RUNNING {70051404E3}>)

Backtrace:
 0: (SB-KERNEL::%FILE-ERROR #P"//Users/<user-name>/Downloads/test_zip//[Content_Types].xml" "bad place for a wild pathname")
 1: (ENSURE-DIRECTORIES-EXIST #P"//Users/<user-name>/Downloads/test_zip//[Content_Types].xml" :VERBOSE NIL :MODE 511)
 2: (BETTER-UNZIP "/Users/josephus/Downloads/test.xlsx" "/Users/<user-name>/Downloads/test_zip/" :IF-EXISTS :ERROR :VERBOSE NIL)
 3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (BETTER-UNZIP *XLSX* "/Users/<user-name>/Downloads/test_zip/") #<NULL-LEXENV>)
 4: (EVAL (BETTER-UNZIP *XLSX* "/Users/<user-name>/Downloads/test_zip/"))
 5: ((LAMBDA NIL :IN SLYNK-MREPL::MREPL-EVAL-1))
macos

3 个回答

  1. Best Answer

    此处的根本问题是您已陷入 CL 路径名规范的边缘。不幸的是，这些边缘从未远离。

    在这种情况下，问题是 SBCL 特有的，但这并不是因为SBCL 有错误：而是因为 SBCL 做了一些它被允许做的事情。

    最简短的答案几乎就是您需要使用或找到某种东西，以针对常见平台的明确定义的方式将字符串转换为路径名。实际答案可能是使用 ASDF 的UIOP，特别是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)))))))

    那么事情就会顺利进行。

    另外，不要依赖 ChatGPT：它在这里根本没用，如果有用的话。

    以下是我认为值得记录的一些细节。

    具体问题是 SBCL（我认为 SBCL 仅在当前实现中存在）对通配符路径名的概念进行了扩展。允许这样做。因此，在 SBCL 中，的结果(parse-namestring "[foo].xml")是一个通配符路径名。特别是，它是一个与"f.xml"和 匹配的通配符路径名"o.xml"。其他路径名组件中使用的这种语法也是如此，并且这种语法应该与许多 Unix shell 支持的语法以及正则表达式相似。

    现在，在 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 级别的某些东西需要解析这些路径名。如果这些路径名看起来很不正常，它会将它们解析为不正常的路径名。可能有特定的解决方法，我认为 Rainer 已经给你了，但总的来说，我认为解决这个问题的唯一方法是实现你自己的路径名解析（太糟糕了）或依靠别人为你做这件事。在这种情况下，ASDF 的人已经为你做了这件事。

    • 3

  2. 我会打电话

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

    而不是

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

  3. 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)))))))

    当 :zip 和 :uiop 快速加载时，此better-unzip功能在 MacOS 和 Linux 中有效。以下代码用于更正。

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

    我还没有测试过 Windows。除了 SBCL 之外也没有测试过其他实现。

    • 0

相关问题