fix tar extraction

skk-develop.el

@@ -27,107 +27,119 @@
 ;;; Code:
 
 (require 'skk)
+(require 'cl-lib)
 
 (eval-when-compile
   (require 'url)
   (defvar skk-exserv-list))
 
 (defvar skk-dict-collection
-  '(("SKK-JISYO.L.gz"          . euc-jp-unix)
-    ("SKK-JISYO.JIS2.gz"       . euc-jp-unix)
-    ("SKK-JISYO.JIS2004.gz"    . euc-jisx0213-unix)
-    ("SKK-JISYO.JIS3_4.gz"     . euc-jisx0213-unix)
-    ("SKK-JISYO.assoc.gz"      . euc-jp-unix)
-    ("SKK-JISYO.edict.tar.gz"  . archive)
-    ("SKK-JISYO.fullname.gz"   . euc-jisx0213-unix)
-    ("SKK-JISYO.geo.gz"        . euc-jp-unix)
-    ("SKK-JISYO.itaiji.gz"     . euc-jp-unix)
-    ("SKK-JISYO.jinmei.gz"     . euc-jp-unix)
-    ("SKK-JISYO.law.gz"        . euc-jp-unix)
-    ("SKK-JISYO.lisp.gz"       . euc-jp-unix)
-    ("SKK-JISYO.mazegaki.gz"   . euc-jp-unix)
-    ("SKK-JISYO.okinawa.gz"    . euc-jp-unix)
-    ("SKK-JISYO.propernoun.gz" . euc-jp-unix)
-    ("SKK-JISYO.pubdic+.gz"    . euc-jp-unix)
-    ("SKK-JISYO.station.gz"    . euc-jp-unix)
-    ("zipcode.tar.gz"          . archive))
-  "SKK $B<-=q$N%j%9%H!#(B
-$BCM$,(B 'archive $B$J$i(B tar $B$GE83+!#(B
-$B$=$l0J30$N%7%s%\%k$J$i!"$=$NJ8;z%3!<%I$GC10l%U%!%$%k$rE83+!#(B")
-
-;; TODO:
-;;   SKK-JISYO.office.zipcode . euc-jisx0213-unix
-;;   SKK-JISYO.zipcode        . euc-jisx0213-unix
-
-(defun skk-get-delete-files (dir)
-  "DIR $BFb$N<-=q%U%!%$%k!J%"!<%+%$%V!"C10l%U%!%$%k!"%G%#%l%/%H%j!K$r0lA]$9$k!#(B"
-  (pcase-dolist (`(,f . ,_conf) skk-dict-collection)
-    (let ((targets (list f                                       ; $B85$N(B .gz / .tar.gz
-                         (replace-regexp-in-string "\\.tar\\.gz\\'" "" f) ; $BE83+8e(B(tar)
-                         (replace-regexp-in-string "\\.gz\\'" "" f))))    ; $BE83+8e(B(gz)
-
-      ;; SKK-JISYO.edict.tar.gz $B$KIU?o$9$kFC<l$J%I%-%e%a%s%H$bBP>]$K2C$($k(B
-      (when (string= f "SKK-JISYO.edict.tar.gz")
-        (push "edict_doc.txt" targets))
-
-      (dolist (file targets)
-        (let ((path (expand-file-name file dir)))
-          (when (file-exists-p path)
-            (if (file-directory-p path)
-                (delete-directory path t)
-              (delete-file path))))))))
-
-(defun skk-get-mkdir (dir)
-  "DIR."
-  (if (file-exists-p dir)
-      (skk-get-delete-files dir)
-    (make-directory dir t)))
+  '((:file "SKK-JISYO.assoc.gz"      :coding euc-jp-unix)
+    (:file "SKK-JISYO.fullname.gz"   :coding euc-jisx0213-unix)
+    (:file "SKK-JISYO.geo.gz"        :coding euc-jp-unix)
+    (:file "SKK-JISYO.itaiji.gz"     :coding euc-jp-unix)
+    (:file "SKK-JISYO.jinmei.gz"     :coding euc-jp-unix)
+    (:file "SKK-JISYO.JIS2.gz"       :coding euc-jp-unix)
+    (:file "SKK-JISYO.JIS2004.gz"    :coding euc-jisx0213-unix)
+    (:file "SKK-JISYO.JIS3_4.gz"     :coding euc-jisx0213-unix)
+    (:file "SKK-JISYO.L.gz"          :coding euc-jp-unix)
+    (:file "SKK-JISYO.law.gz"        :coding euc-jp-unix)
+    (:file "SKK-JISYO.lisp.gz"       :coding euc-jp-unix)
+    (:file "SKK-JISYO.mazegaki.gz"   :coding euc-jp-unix)
+    (:file "SKK-JISYO.okinawa.gz"    :coding euc-jp-unix)
+    (:file "SKK-JISYO.propernoun.gz" :coding euc-jp-unix)
+    (:file "SKK-JISYO.pubdic+.gz"    :coding euc-jp-unix)
+    (:file "SKK-JISYO.station.gz"    :coding euc-jp-unix)
+    (:file "SKK-JISYO.edict.tar.gz"  :type archive :targets ("SKK-JISYO.edict"))
+    (:file "zipcode.tar.gz"          :type archive :targets ("SKK-JISYO.office.zipcode" "SKK-JISYO.zipcode")))
+  "SKK $B<-=q$N%3%l%/%7%g%sDj5A!#(B
+:file    - $B%@%&%s%m!<%I$9$k%U%!%$%kL>(B
+:coding  - $BC10l(B .gz $B%U%!%$%k$N>l9g$N%(%s%3!<%G%#%s%0(B
+:type    - 'archive $B$N>l9g$O(B tar $BE83+$r;XDj(B
+:targets - tar $BE83+$9$k%U%!%$%k$N%j%9%H(B")
+
+(defalias 'skk-get--remove-suffix
+  (if (fboundp 'string-remove-suffix)   ; Emacs 27.1 $B$GF3F~(B
+      #'string-remove-suffix
+    (lambda (suffix string)
+      (if (string-suffix-p suffix string)
+          (substring string 0 (- (length string) (length suffix)))
+        string))))
+
+(defun skk-get--strip-extension (filename)
+  (let ((name (file-name-nondirectory filename)))
+    (skk-get--remove-suffix ".tar" (skk-get--remove-suffix ".gz" name))))
+
+(defun skk-get--get-targets (entry)
+  "$B<-=q$N%3%l%/%7%g%sDj5A$N%(%s%H%j!<(B ENTRY $B$+$i!"%U%!%$%kL>$N%j%9%H$rJV$9!#(B
+:targets $B%W%m%Q%F%#$,$"$l$P$=$l$r;HMQ$7!"$J$1$l$P(B :file $B$+$i?dB,$9$k!#(B"
+  (or (plist-get entry :targets)
+      (let ((file (plist-get entry :file)))
+        (list (skk-get--strip-extension file)))))
+
+(defun skk-unpack-archive (file-path dest-dir entry)
+  "$B%"!<%+%$%VFb$N%Q%99=B$!J(B./zipcode/ $BEy!K$rL5;k$7$F!"(Bdest-dir $B$KE83+$9$k!#(B"
+  (let ((targets          (plist-get entry :targets))
+        (abs-file-path    (expand-file-name file-path))
+        (archive-contents (process-lines "tar" "-tf" (expand-file-name file-path))))
+    (dolist (target targets)
+      (let ((real-path (cl-find target archive-contents
+                                :test (lambda (tgt path) (string-suffix-p tgt path))))
+            (out-path (expand-file-name (file-name-nondirectory target) dest-dir)))
+        (if (not real-path)
+            (message "Skipping: %s not found in archive." target)
+          (message "Extracting %s as %s..." real-path out-path)
+          (with-temp-file out-path
+            (set-buffer-multibyte nil)
+            (let ((exit-code (call-process "tar" nil t nil "-xOf" abs-file-path real-path)))
+              (if (= exit-code 0)
+                  (message "Successfully extracted: %s" out-path)
+                (delete-file out-path)
+                (message "Failed to extract %s" real-path)))))))))
+
+(defun skk-unpack-gz (file-path dest-dir coding)
+  "FILE-PATH (.gz) $B$r2rE`$7!"(BDEST-DIR $BFb$K(B CODING $B$GJ]B8$9$k!#(B"
+  (let* ((file-name (file-name-nondirectory file-path))
+         (out-name  (skk-get--strip-extension file-name))
+         (out-path  (expand-file-name out-name dest-dir))
+         (auto-compression-mode t))
+    (with-temp-buffer
+      (insert-file-contents file-path)
+      (let ((coding-system-for-write coding))
+        (write-region (point-min) (point-max) out-path))
+      (message "Unpacked %s -> %s (%s)" file-name out-name coding))))
 
 (defun skk-get-download (dir)
-  "SKK$B<-=q$r%@%&%s%m!<%I$7!"(B`skk-dict-collection' $B$K4p$E$-E83+!&J]B8$9$k!#(B"
+  "SKK$B<-=q$r%@%&%s%m!<%I$7!"E83+!&J]B8$9$k!#(B
+$B4{B8$N%U%!%$%k$,$"$k>l9g$O>e=q$-$5$l$k!#(B"
+  (unless (file-directory-p dir)
+    (make-directory dir t))
   (let ((base-url "https://skk-dev.github.io/dict/"))
-    ;; ($B%U%!%$%kL>(B . $B@_Dj(B) $B$rD>@\J,2r$7$F%k!<%W(B
-    (pcase-dolist (`(,f . ,conf) skk-dict-collection)
-      (let* ((dest-name (if (eq conf 'archive)
-                            (replace-regexp-in-string "\\.tar\\.gz\\'" "" f)
-                          (replace-regexp-in-string "\\.gz\\'" "" f)))
-             (dest-path (expand-file-name dest-name dir))
-             (url (concat base-url f))
-             (tmp-gz (expand-file-name f dir))) ; $B0l;~J]B8MQ%Q%9(B
-
-        (unless (file-exists-p dest-path)
-          (message "Downloading %s..." f)
-          ;; unwind-protect $B$G%(%i!<;~$b0l;~%U%!%$%k$r3N<B$K>C5n(B
-          (unwind-protect
+    (dolist (entry skk-dict-collection)
+      (let* ((file     (plist-get entry :file))
+             (url      (concat base-url file))
+             (tmp-path (expand-file-name file dir))
+             (type     (plist-get entry :type))
+             (coding   (plist-get entry :coding))
+             (check-target (expand-file-name (car (skk-get--get-targets entry)) dir)))
+
+        (unless (file-exists-p check-target)
+          (message "Downloading %s..." file)
+          (condition-case err
               (progn
-                (url-copy-file url tmp-gz t)
-                (skk-unpack-entry tmp-gz dir conf))
-            (when (file-exists-p tmp-gz)
-              (delete-file tmp-gz))))))))
-
-(defun skk-unpack-entry (file-path dest-dir config)
-  "CONFIG $B$K4p$E$-(B 'archive $B$+J8;z%3!<%I$+$rH=Dj$7$FE83+$9$k!#(B"
-  (let ((default-directory dest-dir)
-        (file-name (file-name-nondirectory file-path)))
-    (pcase config
-      ('archive
-       (if (executable-find "tar")      ; Windows 10 $B0J9_$G$OI8=`(B
-           (call-process "tar" nil nil nil "-xf" file-path)
-         (error "tar $B%3%^%s%I$,8+$D$+$j$^$;$s(B: %s" file-name)))
-
-      (coding
-       (let ((out-file (expand-file-name (replace-regexp-in-string "\\.gz\\'" "" file-name)
-                                         dest-dir))
-             (coding-system-for-write coding))
-         (with-temp-file out-file
-           (insert-file-contents file-path)))))))
+                (url-copy-file url tmp-path t)
+                (if (eq type 'archive)
+                    (skk-unpack-archive tmp-path dir entry)
+                  (skk-unpack-gz tmp-path dir coding))
+                (when (file-exists-p tmp-path)
+                  (delete-file tmp-path)))
+            (error (message "Failed to process %s: %s" file (error-message-string err)))))))))
 
 ;;;###autoload
 (defun skk-get (dir)
   "DIR."
   (interactive (list (read-directory-name "skk-get directory: " (expand-file-name skk-get-jisyo-directory))))
   (let ((jisyo-dir (expand-file-name dir)))
-    (skk-get-mkdir jisyo-dir)
     (skk-get-download jisyo-dir))
   (message "skk-get...done")
   nil)