Compare commits
3 Enmetoj
7604512684
...
b0edcf78a4
Author | SHA1 | Date | |
---|---|---|---|
Jaidyn Ann | b0edcf78a4 | ||
Jaidyn Ann | e765f14583 | ||
Jaidyn Ann | 25b412d307 |
|
@ -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 file’s tags,
|
"Attempt to mirror all remote HREF/SRC URLs of an HTML document’s 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 page’s HTML."
|
Returns a string of the modified page’s HTML."
|
||||||
(let* ((dom
|
(let* ((dom
|
||||||
(lquery:$ (lquery:initialize html-file)))
|
(lquery:$ (lquery:initialize html-source)))
|
||||||
(url→pathname-alist
|
(url→pathname-alist
|
||||||
(mirror-linked-urls dom :tags tags :download-dir download-dir))
|
(mirror-linked-urls dom :tags tags :download-dir download-dir))
|
||||||
(url→relative-url-alist
|
(url→relative-url-alist
|
||||||
|
|
|
@ -29,33 +29,29 @@
|
||||||
`(when (getf ,opts ,option)
|
`(when (getf ,opts ,option)
|
||||||
,body))
|
,body))
|
||||||
|
|
||||||
;; list symbol form form
|
|
||||||
(defmacro if-opt (opts option if-form &optional else-form)
|
|
||||||
`(if (getf ,opts ,option)
|
|
||||||
,if-form ,else-form))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; 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
|
(handler-case
|
||||||
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))))
|
||||||
|
(error (c)
|
||||||
|
(error-print 99 nil c))))
|
||||||
|
|
||||||
(opts:define-opts
|
(opts:define-opts
|
||||||
(:name :help
|
(:name :help
|
||||||
|
@ -74,15 +70,44 @@
|
||||||
(error (c)
|
(error (c)
|
||||||
(error-print 11 "Could not access or create directory." c))))))
|
(error-print 11 "Could not access or create directory." c))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;; Output
|
||||||
|
;;; ————————————————————————————————————————
|
||||||
;; 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))
|
||||||
|
|
||||||
;; number string condition → nil
|
;; number string condition → nil
|
||||||
(defun error-print (exit-code &optional message condition)
|
(defun error-print (exit-code &optional message condition)
|
||||||
"Print an error-message and exit."
|
"Print an error-message and exit."
|
||||||
(format *error-output* "~@[~A~%~]~@[~A~%~]" message condition)
|
(format *error-output* "~@[~A~%~]~@[Error: ~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 we’re reading from stdin (without immediate input).
|
||||||
|
;; This means they might’ve 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*))))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue