From a8dca176f3efbc2bad536d1b3349229adcc45489 Mon Sep 17 00:00:00 2001 From: cage Date: Mon, 23 Aug 2021 18:20:11 +0200 Subject: [PATCH] - added a directory to store gempub, the software will sync the directory's contents with its internal metadata database. --- etc/shared.conf | 4 ++ src/db-utils.lisp | 3 +- src/db.lisp | 100 ++++++++++++++++++++++++++++++-- src/filesystem-utils.lisp | 20 +++++++ src/gempub.lisp | 43 +++++++++++++- src/package.lisp | 26 ++++++++- src/scheduled-events.lisp | 6 +- src/software-configuration.lisp | 12 ++++ src/zip-info.lisp | 50 +++++++++------- 9 files changed, 233 insertions(+), 31 deletions(-) diff --git a/etc/shared.conf b/etc/shared.conf index 7f3bcd9..3dd71a3 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -41,6 +41,10 @@ editor = "nano --locking" # (default 'no', change to 'yes' if desired) start.update.gemlog = yes +# directory to scan for gempub files + +gempub.directory.library = /home/cage/lisp/tinmop/ + # close links window when opening the selected link open-message-link-window.close-after-select = yes diff --git a/src/db-utils.lisp b/src/db-utils.lisp index 73a7d5f..08cfad1 100644 --- a/src/db-utils.lisp +++ b/src/db-utils.lisp @@ -331,7 +331,6 @@ example example (make-delete :table-name - (:col-a :col-b) (:and (:= col-a 1) (:= col-b 2))) " @@ -343,7 +342,7 @@ example example -(make-delete :table-name +(make-update :table-name (:col-a :col-b) (1 2) (:and (:= col-a 1) diff --git a/src/db.lisp b/src/db.lisp index 5eb6e09..9e37035 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -591,15 +591,15 @@ " \"local-uri\" TEXT, " " \"original-uri\" TEXT, " " title TEXT, " - " gpubVersion TEXT, " - " \"index\" TEXT, " + " \"gpub-version\" TEXT, " + " \"index-file\" TEXT, " " author TEXT, " " language TEXT, " " charset TEXT, " " description TEXT, " " published TEXT, " - " publishDate TEXT, " - " revisionDate TEXT, " + " \"publish-date\" TEXT, " + " \"revision-date\" TEXT, " " copyright TEXT, " " license TEXT, " " version TEXT, " @@ -1861,6 +1861,34 @@ row." (gen-access-message-row section :section) +(gen-access-message-row local-uri :local-uri) + +(gen-access-message-row original-uri :original-uri) + +(gen-access-message-row gpub-version :gpub-version) + +(gen-access-message-row index-file :index-file) + +(gen-access-message-row author :author) + +(gen-access-message-row language :language) + +(gen-access-message-row charset :charset) + +(gen-access-message-row publishedp :published) + +(gen-access-message-row publish-date :publish-date) + +(gen-access-message-row revision-date :revision-date) + +(gen-access-message-row copyright :copyright) + +(gen-access-message-row license :license) + +(gen-access-message-row version :version) + +(gen-access-message-row cover :cover) + (defun row-votes-count (row) (and row (db-getf row :votes-count :default 0))) @@ -3170,3 +3198,67 @@ days in the past" (defun bookmark-delete (id) (delete-by-id +table-bookmark+ id)) + +(defun gempub-metadata-add (local-uri + &optional + original-uri + title + gpub-version + index-file + author + language + charset + description + published + publish-date + revision-date + copyright + license + version + cover) + (assert (stringp local-uri)) + (with-db-current-timestamp (now) + (query (make-insert +table-gempub-metadata+ + (:local-uri + :original-uri + :title + :gpub-version + :index-file + :author + :language + :charset + :description + :published + :publish-date + :revision-date + :copyright + :license + :version + :cover + :created-at) + (local-uri + original-uri + title + gpub-version + index-file + author + language + charset + description + published + publish-date + revision-date + copyright + license + version + cover + now))))) + +(defun all-gempub-metadata () + (query (select :* (from +table-gempub-metadata+)))) + +(defun gempub-metadata-delete (local-uri) + (query (delete-from +table-gempub-metadata+ (where (:= :local-uri local-uri))))) + +(defun gempub-metadata-find (local-uri) + (query (select :* (from +table-gempub-metadata+) (where (:= :local-uri local-uri))))) diff --git a/src/filesystem-utils.lisp b/src/filesystem-utils.lisp index acf428d..9013b01 100644 --- a/src/filesystem-utils.lisp +++ b/src/filesystem-utils.lisp @@ -133,6 +133,26 @@ (setf all-paths (sort all-paths #'string<)) all-paths)) +(defun collect-files/dirs (root) + (let ((all-files '()) + (all-dirs '())) + (labels ((collect (dir) + (when (not (member dir all-files :test #'string=)) + (let* ((all-children (collect-children dir)) + (files (remove-if #'directory-exists-p all-children)) + (directories (remove-if (lambda (a) + (or (file-exists-p a) + (string= (path-last-element a) ".") + (string= (path-last-element a) ".."))) + all-children))) + (setf all-files (append all-files files)) + (setf all-dirs (append all-dirs directories)) + (loop for new-dir in directories do + (collect new-dir)))))) + (collect root) + (values all-files + all-dirs)))) + (defgeneric prepend-pwd (object)) (defmethod prepend-pwd ((object string)) diff --git a/src/gempub.lisp b/src/gempub.lisp index 640a9b6..e6715ff 100644 --- a/src/gempub.lisp +++ b/src/gempub.lisp @@ -70,10 +70,51 @@ (define-constant +metadata-entry-name "metadata.txt" :test #'string=) -(defmethod extract-metadata (zip-file) +(defun extract-metadata (zip-file) (when (zip-info:zip-file-p zip-file) (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 +metadata-entry-name))) (parse 'metadata metadata-raw)))))) + +(defun save-metadata (zip-file) + (when-let ((metadata (extract-metadata zip-file))) + (db:gempub-metadata-add zip-file + nil + (getf metadata :title) + (getf metadata :gpubVersion) + (getf metadata :index) + (getf metadata :author) + (getf metadata :language) + (getf metadata :charset) + (getf metadata :description) + (getf metadata :published) + (getf metadata :publishDate) + (getf metadata :revisionDate) + (getf metadata :copyright) + (getf metadata :license) + (getf metadata :version) + (getf metadata :cover)))) + +(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))) + (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))) + (push local-uri removed-known) + (db:gempub-metadata-delete local-uri)))) + (loop for gempub-file in all-gempub-files do + (when (not (db:gempub-metadata-find gempub-file)) + (push gempub-file added-file) + (save-metadata gempub-file))) + (when notify + (loop for removed in removed-known do + (ui:notify (format nil (_ "Removed gempub ~s from library, missing file") removed))) + (loop for added in added-file do + (ui:notify (format nil (_ "Added gempub ~s into the library") added)))))) diff --git a/src/package.lisp b/src/package.lisp index a2587dc..890d4bb 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -282,6 +282,7 @@ :add-extension :do-directory :collect-children + :collect-files/dirs :prepend-pwd :search-matching-file :regular-file-p @@ -909,6 +910,20 @@ :row-seenp :row-description :row-value + :row-local-uri + :row-original-uri + :row-gpub-version + :row-index-file + :row-author + :row-language + :row-charset + :row-publishedp + :row-publish-date + :row-revision-date + :row-copyright + :row-license + :row-version + :row-cover :next-status-tree :previous-status-tree :message-tree-root-equal @@ -1036,12 +1051,15 @@ :delete-gemlog-entry :purge-seen-gemlog-entries :bookmark-add - :bookmark-delete :bookmark-complete->id :bookmark-description-for-complete :bookmark-all-sections :bookmark-all-grouped-by-section - :bookmark-delete)) + :bookmark-delete + :gempub-metadata-add + :all-gempub-metadata + :gempub-metadata-delete + :gempub-metadata-find)) (defpackage :date-formatter (:use @@ -1176,6 +1194,7 @@ :max-report-comment-length :quote-char :max-attachments-allowed + :gempub-library-directory :color-regexps :ignore-users-regexps :win-bg @@ -2425,7 +2444,8 @@ (:shadowing-import-from :text-utils :split-lines) (:shadowing-import-from :misc :random-elt :shuffle) (:export - :extract-metadata)) + :extract-metadata + :sync-library)) (defpackage :main-window (:use diff --git a/src/scheduled-events.lisp b/src/scheduled-events.lisp index 0f4e133..0bba87d 100644 --- a/src/scheduled-events.lisp +++ b/src/scheduled-events.lisp @@ -70,10 +70,14 @@ (when (swconf:gemini-update-gemlog-at-start-p) (ui:gemlog-refresh-all))) +(gen-at-boot-function sync-gempub-library + (gempub:sync-library :notify t)) + (defun run-scheduled-events (ticks) (refresh-all-chats-messages ticks) (refresh-all-chats-data ticks) (refresh-gemlog-subscriptions ticks) (purge-gemlog-entries ticks) (purge-history) - (refresh-gemlog-posts)) + (refresh-gemlog-posts) + (sync-gempub-library)) diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index fa595fa..74dd9e3 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -504,6 +504,9 @@ command-separator gemini gemlog + gempub + library + sync favicon tree branch @@ -525,6 +528,7 @@ read unread directory-symbol + directory fetch update close-after-select @@ -834,6 +838,14 @@ +key-max-numbers-allowed-attachments+) 4)) +(defun gempub-library-directory () + (or (access:accesses *software-configuration* + +key-gempub+ + +key-directory+ + +key-library+) + (res:home-datadir))) + + (defun external-editor () (access:access *software-configuration* +key-editor+)) diff --git a/src/zip-info.lisp b/src/zip-info.lisp index a6bdc14..49c76fb 100644 --- a/src/zip-info.lisp +++ b/src/zip-info.lisp @@ -130,30 +130,40 @@ (defun make-zip-error (reason) (error 'zip-error :text reason)) +(alexandria:define-constant +max-eocd-total-size+ 65536 :test #'=) + (defun zip-file-p (path) (let ((file-size (file-size path)) (eocd-start nil)) (if (>= file-size +eocd-fixed-size+) - (with-open-zip-file (stream path) - (loop named signature-finder for position - from (- file-size +eocd-signature-size+) - downto 0 do - (file-position stream position) - (let ((maybe-signature (read-bytes->int stream +eocd-signature-size+))) - (when (= maybe-signature +eocd-signature-value+) - (setf eocd-start position) - (return-from signature-finder t)))) - (if eocd-start - (let* ((eocd-fixed-part-offset (+ eocd-start +eocd-fixed-size+)) - (eocd-offset-minus-zip-comment (- eocd-fixed-part-offset - +eocd-zip-file-comment-length+))) - (file-position stream eocd-offset-minus-zip-comment) - (let ((comment-size (read-bytes->int stream +eocd-zip-file-comment-length+))) - (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))))) + (with-open-zip-file (stream path) + (let ((buffer (make-array +max-eocd-total-size+ :element-type +byte-type+))) + (file-position stream (- file-size +max-eocd-total-size+)) + (read-sequence buffer stream) + (loop named signature-finder + for eocd-position + from (- file-size +eocd-signature-size+) downto 0 + for position + from (- +max-eocd-total-size+ +eocd-signature-size+) downto 0 + do + (let* ((maybe-signature (misc:byte->int (subseq buffer + position + (+ position + +eocd-signature-size+))))) + (when (= maybe-signature +eocd-signature-value+) + (setf eocd-start eocd-position) + (return-from signature-finder t))))) + (if eocd-start + (let* ((eocd-fixed-part-offset (+ eocd-start +eocd-fixed-size+)) + (eocd-offset-minus-zip-comment (- eocd-fixed-part-offset + +eocd-zip-file-comment-length+))) + (file-position stream eocd-offset-minus-zip-comment) + (let ((comment-size (read-bytes->int stream +eocd-zip-file-comment-length+))) + (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))))) (defun start-of-central-directory (path) (multiple-value-bind (zipp eocd-start)