Accept HTML from stdin, instead of requiring a file

This is much more handy (not to mention UNIX-y)!
This commit is contained in:
Jaidyn Ann 2024-05-31 21:34:47 -05:00
parent 7604512684
commit 25b412d307
2 changed files with 37 additions and 11 deletions

View File

@ -28,16 +28,17 @@
;;; Mirror-img ;;; Mirror-img
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
;; pathname pathname list → string ;; pathname/input-stream pathname list → string
(defun mirror-img (html-file download-dir &key (url-dir download-dir) (tags *default-tags*)) (defun mirror-img (html-source download-dir &key (url-dir download-dir) (tags *default-tags*))
"Attempt to mirror all remote HREF/SRC URLs of an HTML files tags, "Attempt to mirror all remote HREF/SRC URLs of an HTML documents tags,
downloading them to DOWNLOAD-DIR. For each remote URL that could be downloading them to DOWNLOAD-DIR. For each remote URL that could be
successfuly mirrored, the remote URLs will be replaced with the local successfuly mirrored, the remote URLs will be replaced with the local
version. The URL used will will be BASE-DIR plus the filename, where version. The URL used will will be BASE-DIR plus the filename, where
BASE-DIR defaults to DOWNLOAD-DIR. BASE-DIR defaults to DOWNLOAD-DIR.
HTML-SOURCE, the document, can be either a pathname or an input stream.
Returns a string of the modified pages HTML." Returns a string of the modified pages HTML."
(let* ((dom (let* ((dom
(lquery:$ (lquery:initialize html-file))) (lquery:$ (lquery:initialize html-source)))
(urlpathname-alist (urlpathname-alist
(mirror-linked-urls dom :tags tags :download-dir download-dir)) (mirror-linked-urls dom :tags tags :download-dir download-dir))
(urlrelative-url-alist (urlrelative-url-alist

View File

@ -38,22 +38,22 @@
;;; Mirror-img (UNIX) ;;; Mirror-img (UNIX)
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
;; NIL → NIL ;; nil → nil
(defun main () (defun main ()
"Actual invocation of the program. This is what you should set as :toplevel." "Actual invocation of the program. This is what you should set as :toplevel."
(error-print (error-print
99 "" 99 ""
(multiple-value-bind (opts free) (opts:get-opts) (multiple-value-bind (opts free) (opts:get-opts)
(when-opt opts :help (help)) (when-opt opts :help (help))
(let* ((input-file (car free)) (let* ((input-stream (choose-input-stream (car free)))
(url-base (or (getf opts :url-base) (getf opts :download-dir) "mirror/")) (url-base (or (getf opts :url-base) (getf opts :download-dir) "mirror/"))
(download-dir (or (getf opts :download-dir) url-base))) (download-dir (or (getf opts :download-dir) url-base)))
(when (not input-file) (when (not input-stream)
(error-print 1 "No HTML file provided. Use --help for more information.")) (error-print 1 "No HTML file provided. See --help for more information."))
(format (format
't 't
(mirror-img:mirror-img (mirror-img:mirror-img
(pathname input-file) input-stream
download-dir download-dir
:url-dir url-base)))))) :url-dir url-base))))))
@ -77,7 +77,10 @@
;; number stream → nil ;; number stream → nil
(defun help (&optional (exit-code 0) (stream *standard-output*)) (defun help (&optional (exit-code 0) (stream *standard-output*))
"Prints help message and dies." "Prints help message and dies."
(unix-opts:describe :prefix "usage: mirror-img [-h] [-d DIR] [-b BASE] HTML_FILE" (unix-opts:describe
:prefix (format nil "~A~%~A"
"usage: mirror-img [-h] [-d DIR] [-b BASE] HTML_FILE"
" mirror-img [-h] [-d DIR] [-b BASE]")
:stream stream) :stream stream)
(unix-opts:exit exit-code)) (unix-opts:exit exit-code))
@ -86,3 +89,25 @@
"Print an error-message and exit." "Print an error-message and exit."
(format *error-output* "~@[~A~%~]~@[~A~%~]" message condition) (format *error-output* "~@[~A~%~]~@[~A~%~]" message condition)
(unix-opts:exit exit-code)) (unix-opts:exit exit-code))
;;; Input
;;; ————————————————————————————————————————
;; list → stream
(defun choose-input-stream (file-arg)
"Select an input stream, between a file passed in free-args or stdin."
(let* ((input-file file-arg)
(input-file-p (ignore-errors (probe-file input-file)))
(stdinp (listen *standard-input*)))
(cond ((or stdinp (equal input-file "-")) ; “-” is commonly used to mean stdin.
*standard-input*)
(input-file-p (open input-file))
((and input-file (not input-file-p))
(error-print 2 "File “~A” does not exist." input-file))
('T
;; Warn the user, if were reading from stdin (without immediate input).
;; This means they mightve made a massive typo. ^ ^
(format *error-output* "Reading from standard input. Hit ^D (CTRL+D) when done.~%")
(format *error-output* "Run with --help argument for details.~%")
*standard-input*))))