Add --base and --downloads parameters to cli
This commit is contained in:
parent
74acf3fa2d
commit
1097b4d0b3
|
@ -43,30 +43,36 @@
|
|||
"Actual invocation of the program. This is what you should set as :toplevel."
|
||||
(multiple-value-bind (opts free) (opts:get-opts)
|
||||
(when-opt opts :help (help))
|
||||
(let* ((input-stream (pathname (car free))))
|
||||
(when (not input-stream)
|
||||
(let* ((input-file (pathname (car free)))
|
||||
(url-base (or (getf opts :url-base) (getf opts :download-dir) "mirror/"))
|
||||
(download-dir (or (getf opts :download-dir) url-base)))
|
||||
(when (not input-file)
|
||||
(format *error-output* "No file provided.~%")
|
||||
(help 2))
|
||||
|
||||
(format
|
||||
't
|
||||
(mirror-img:mirror-img
|
||||
input-stream
|
||||
#p"mirror/")))))
|
||||
input-file
|
||||
download-dir
|
||||
:url-dir url-base)))))
|
||||
|
||||
(opts:define-opts
|
||||
(:name :help
|
||||
:description "print this help text."
|
||||
:short #\h :long "help")
|
||||
(:name :base
|
||||
(:name :url-base
|
||||
:description "path to mirror directory used in URLs"
|
||||
:short #\b :long "base")
|
||||
(:name :download-dir
|
||||
:description "directory for all mirrored files"
|
||||
:short #\b :long "base"
|
||||
:short #\d :long "downloads"
|
||||
:arg-parser (lambda (dir)
|
||||
(car (directory dir)))))
|
||||
|
||||
;; number stream → nil
|
||||
(defun help (&optional (exit-code 0) (stream *standard-output*))
|
||||
"Prints help message and dies."
|
||||
(unix-opts:describe :prefix "usage: mirror-img [-h] [-b DIR] HTML_FILE"
|
||||
(unix-opts:describe :prefix "usage: mirror-img [-h] [-d DIR] [-b BASE] HTML_FILE"
|
||||
:stream stream)
|
||||
(unix-opts:exit exit-code))
|
||||
|
|
Ŝarĝante…
Reference in New Issue