diff --git a/src/db.lisp b/src/db.lisp index 3bb4399..5eb6e09 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -131,6 +131,9 @@ (define-constant +table-bookmark+ :bookmark :test #'eq) +(define-constant +table-gempub-metadata+ :gempub-metadata + :test #'eq) + (define-constant +bookmark-gemini-type-entry+ "gemini" :test #'string=) @@ -583,6 +586,28 @@ " UNIQUE(url) ON CONFLICT FAIL" +make-close+))) +(defun make-gempub-metadata () + (query-low-level (strcat (prepare-table +table-gempub-metadata+ :autoincrementp t) + " \"local-uri\" TEXT, " + " \"original-uri\" TEXT, " + " title TEXT, " + " gpubVersion TEXT, " + " \"index\" TEXT, " + " author TEXT, " + " language TEXT, " + " charset TEXT, " + " description TEXT, " + " published TEXT, " + " publishDate TEXT, " + " revisionDate TEXT, " + " copyright TEXT, " + " license TEXT, " + " version TEXT, " + " cover TEXT, " + ;; timestamp + " \"created-at\" TEXT NOT NULL" + +make-close+))) + (defun build-all-indices () (create-table-index +table-status+ '(:folder :timeline :status-id)) (create-table-index +table-account+ '(:id :acct)) @@ -596,8 +621,8 @@ (create-table-index +table-gemini-tofu-cert+ '(:host)) (create-table-index +table-gemini-subscription+ '(:url)) (create-table-index +table-gemlog-entries+ '(:url)) - (create-table-index +table-bookmark+ '(:type :section :value))) - + (create-table-index +table-bookmark+ '(:type :section :value)) + (create-table-index +table-gempub-metadata+ '(:local-uri))) (defmacro gen-delete (suffix &rest names) `(progn @@ -625,7 +650,8 @@ +table-gemini-tofu-cert+ +table-gemini-subscription+ +table-gemlog-entries+ - +table-bookmark+)) + +table-bookmark+ + +table-gempub-metadata+)) (defun build-views ()) @@ -660,6 +686,7 @@ (make-gemini-subscription) (make-gemlog-entries) (make-bookmark) + (make-gempub-metadata) (build-all-indices) (fs:set-file-permissions (db-path) (logior fs:+s-irusr+ fs:+s-iwusr+)))) diff --git a/src/gempub.lisp b/src/gempub.lisp new file mode 100644 index 0000000..640a9b6 --- /dev/null +++ b/src/gempub.lisp @@ -0,0 +1,79 @@ +;; tinmop: an humble gemini and pleroma client +;; Copyright (C) 2021 cage + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(in-package :gempub) + +(defrule title "title" (:constant :title)) +(defrule gpubVersion "gpubVersion" (:constant :gpubVersion)) +(defrule index "index" (:constant :index)) +(defrule author "author" (:constant :author)) +(defrule language "language" (:constant :language)) +(defrule charset "charset" (:constant :charset)) +(defrule description "description" (:constant :description)) +(defrule published "published" (:constant :published)) +(defrule publishDate "publishDate" (:constant :publishDate)) +(defrule revisionDate "revisionDate" (:constant :revisionDate)) +(defrule copyright "copyright" (:constant :copyright)) +(defrule license "license" (:constant :license)) +(defrule version "version" (:constant :version)) +(defrule cover "cover" (:constant :cover)) + +(defrule blank (or #\space #\Newline #\Tab) + (:constant nil)) + +(defrule blanks (* blank) + (:constant nil)) + +(defrule key-value-separator #\:) + +(defrule value (+ (not #\Newline)) + (:text t)) + +(defrule key (or title + gpubVersion + index + author + language + charset + description + published + publishDate + revisionDate + copyright + license + version + cover)) + +(defrule entry (and key (? blanks) key-value-separator (? blanks) value blanks) + (:function (lambda (a) (list (first a) (fifth a))))) + +(defrule metadata (* entry) + (:function flatten)) + +(defgeneric parse-metadata (object)) + +(defmethod parse-metadata ((object string)) + (parse 'metadata object)) + +(define-constant +metadata-entry-name "metadata.txt" :test #'string=) + +(defmethod 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)))))) diff --git a/src/line-oriented-window.lisp b/src/line-oriented-window.lisp index 493e5ea..eadaf7e 100644 --- a/src/line-oriented-window.lisp +++ b/src/line-oriented-window.lisp @@ -1,5 +1,5 @@ ;; tinmop: an humble gemini and pleroma client -;; Copyright (C) 2020 cage +;; Copyright (C) 2020,2021 cage ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/src/os-utils.lisp b/src/os-utils.lisp index 2c10e54..b8162b1 100644 --- a/src/os-utils.lisp +++ b/src/os-utils.lisp @@ -174,5 +174,17 @@ (list "-o" zip-file "-d" destination-dir) :search t :wait t - :output *standard-output* - :error *standard-output*)))) + :output nil + :error :output)))) + +(defun unzip-single-file (zip-file file-entry) + (with-output-to-string (stream) + (let* ((process (run-external-program +unzip-bin+ + (list "-p" zip-file file-entry) + :search t + :wait t + :output stream + :error :output)) + (exit-code (sb-ext:process-exit-code process))) + (when (/= exit-code 0) + (error (format nil "File ~s extraction from ~s failed" file-entry zip-file)))))) diff --git a/src/package.lisp b/src/package.lisp index 3532995..a2587dc 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -345,7 +345,8 @@ :send-to-pipe :open-link-with-program :open-resource-with-external-program - :unzip-file)) + :unzip-file + :unzip-single-file)) (defpackage :text-utils (:use @@ -2410,6 +2411,22 @@ :open-gemini-stream-window :load-gemini-url)) +(defpackage :gempub + (:use + :cl + :alexandria + :cl-ppcre + :esrap + :config + :constants + :text-utils + :misc + :specials) + (:shadowing-import-from :text-utils :split-lines) + (:shadowing-import-from :misc :random-elt :shuffle) + (:export + :extract-metadata)) + (defpackage :main-window (:use :cl diff --git a/tinmop.asd b/tinmop.asd index 44ebf8f..7cc5fb6 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -129,6 +129,7 @@ (:file "conversations-window") (:file "chats-list-window") (:file "gemini-viewer") + (:file "gempub") (:file "main-window") (:file "ui-goodies") (:file "scheduled-events")