Add error-reporting to UNIX cli client
This commit is contained in:
parent
1097b4d0b3
commit
7604512684
|
@ -41,21 +41,21 @@
|
||||||
;; 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
|
||||||
|
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 (pathname (car free)))
|
(let* ((input-file (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-file)
|
||||||
(format *error-output* "No file provided.~%")
|
(error-print 1 "No HTML file provided. Use --help for more information."))
|
||||||
(help 2))
|
|
||||||
|
|
||||||
(format
|
(format
|
||||||
't
|
't
|
||||||
(mirror-img:mirror-img
|
(mirror-img:mirror-img
|
||||||
input-file
|
(pathname input-file)
|
||||||
download-dir
|
download-dir
|
||||||
:url-dir url-base)))))
|
:url-dir url-base))))))
|
||||||
|
|
||||||
(opts:define-opts
|
(opts:define-opts
|
||||||
(:name :help
|
(:name :help
|
||||||
|
@ -67,8 +67,12 @@
|
||||||
(:name :download-dir
|
(:name :download-dir
|
||||||
:description "directory for all mirrored files"
|
:description "directory for all mirrored files"
|
||||||
:short #\d :long "downloads"
|
:short #\d :long "downloads"
|
||||||
:arg-parser (lambda (dir)
|
:arg-parser
|
||||||
(car (directory dir)))))
|
(lambda (dir)
|
||||||
|
(handler-case
|
||||||
|
(ensure-directories-exist dir)
|
||||||
|
(error (c)
|
||||||
|
(error-print 11 "Could not access or create directory." c))))))
|
||||||
|
|
||||||
;; number stream → nil
|
;; number stream → nil
|
||||||
(defun help (&optional (exit-code 0) (stream *standard-output*))
|
(defun help (&optional (exit-code 0) (stream *standard-output*))
|
||||||
|
@ -76,3 +80,9 @@
|
||||||
(unix-opts:describe :prefix "usage: mirror-img [-h] [-d DIR] [-b BASE] HTML_FILE"
|
(unix-opts:describe :prefix "usage: mirror-img [-h] [-d DIR] [-b BASE] HTML_FILE"
|
||||||
:stream stream)
|
:stream stream)
|
||||||
(unix-opts:exit exit-code))
|
(unix-opts:exit exit-code))
|
||||||
|
|
||||||
|
;; number string condition → nil
|
||||||
|
(defun error-print (exit-code &optional message condition)
|
||||||
|
"Print an error-message and exit."
|
||||||
|
(format *error-output* "~@[~A~%~]~@[~A~%~]" message condition)
|
||||||
|
(unix-opts:exit exit-code))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue