cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- respected index metadata when opening a gempub file.

This commit is contained in:
cage 2021-08-26 16:08:51 +02:00
parent e2736ef3ef
commit 78de3329a8
3 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/gempub.lisp
View File

@ -71,7 +71,7 @@
(define-constant +metadata-entry-name "metadata.txt" :test #'string=)
(defun extract-metadata (zip-file)
(when (zip-info:zip-file-p zip-file)
(when (zip-info:zip-file-p zip-file :ignore-errors t)
(let ((entries (zip-info:list-entries zip-file)))
(when (find +metadata-entry-name entries :test #'String=)
(when-let ((metadata-raw (os-utils:unzip-single-file zip-file
@ -99,14 +99,15 @@
(defun sync-library (&key (notify nil))
(let ((all-known (db:all-gempub-metadata))
(all-gempub-files (remove-if-not (lambda (a) (ignore-errors (zip-info:zip-file-p a)))
(all-gempub-files (remove-if-not (lambda (a) (zip-info:zip-file-p a
:ignore-errors t))
(fs:collect-files/dirs (swconf:gempub-library-directory))))
(removed-known '())
(added-file '()))
(loop for known in all-known do
(let ((local-uri (db:row-local-uri known)))
(when (not (and (fs:file-exists-p local-uri)
(zip-info:zip-file-p local-uri)))
(zip-info:zip-file-p local-uri :ignore-errors t)))
(push local-uri removed-known)
(db:gempub-metadata-delete local-uri))))
(loop for gempub-file in (mapcar #'uri:normalize-path all-gempub-files) do

3
src/program-events.lisp
View File

@ -1130,13 +1130,12 @@
(gemini-viewer:push-url-to-history window index-path)
(refresh-gemini-message-window links raw-text ir nil)
(windows:draw window)))
((zip-info:zip-file-p local-path)
((zip-info:zip-file-p local-path :ignore-errors t)
(let ((temp-directory (fs:temporary-directory)))
(os-utils:unzip-file local-path temp-directory)
(let* ((library-entry (db:gempub-metadata-find local-path))
(index-file (and library-entry
(db:row-index-file library-entry))))
(misc:dbg "ii ~a ~a" local-path index-file)
(if index-file
(setf (url object) (fs:cat-parent-dir temp-directory index-file))
(setf (url object) temp-directory))

8
src/zip-info.lisp
View File

@ -132,7 +132,7 @@
(alexandria:define-constant +max-eocd-total-size+ 65536 :test #'=)
(defun zip-file-p (path)
(defun zip-file-p (path &key (ignore-errors nil))
(let ((file-size (file-size path))
(eocd-start nil))
(if (>= file-size +eocd-fixed-size+)
@ -164,8 +164,10 @@
(values (= (+ eocd-fixed-part-offset comment-size)
file-size)
eocd-start)))
(make-zip-error (format nil "File ~s contains no zip signature" path))))
(make-zip-error (format nil "File ~s is too short to be a zip file" path)))))
(when (not ignore-errors)
(make-zip-error (format nil "File ~s contains no zip signature" path)))))
(when (not ignore-errors)
(make-zip-error (format nil "File ~s is too short to be a zip file" path))))))
(defun start-of-central-directory (path)
(multiple-value-bind (zipp eocd-start)